-
Notifications
You must be signed in to change notification settings - Fork 1
/
TopEnv.lhs
213 lines (178 loc) · 8.47 KB
/
TopEnv.lhs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
% -*- LaTeX -*-
% $Id: TopEnv.lhs 2895 2009-08-20 09:43:42Z wlux $
%
% Copyright (c) 1999-2009, Wolfgang Lux
% See LICENSE for the full license.
%
\nwfilename{TopEnv.lhs}
\subsection{Top-Level Environments}\label{sec:toplevel-env}
The module \texttt{TopEnv} implements environments for qualified and
possibly ambiguous identifiers. An identifier is ambiguous if two
different entities are imported under the same name. Local definitions
shadow imported entities. Following an idea presented in
\cite{DiatchkiJonesHallgren02:ModuleSystem}, an imported identifier is
associated with a list of entities in order to handle ambiguous names
properly.
The code in this module ensures that the list of entities returned by
the functions \texttt{lookupTopEnv} and \texttt{qualLookupTopEnv}
contains exactly one element for each imported entity regardless of
how many times and from which modules it was imported. Thus, the
result of these functions is a list with exactly one element if and
only if the identifier is unambiguous.
\begin{verbatim}
> module TopEnv(TopEnv, Entity(..), emptyTopEnv, importTopEnv, qualImportTopEnv,
> bindTopEnv, globalBindTopEnv, localBindTopEnv, qualBindTopEnv,
> rebindTopEnv, globalRebindTopEnv, localRebindTopEnv,
> qualRebindTopEnv, localUnimportTopEnv, localUnbindTopEnv,
> lookupTopEnv, qualLookupTopEnv, allEntities,
> allImports, localBindings, moduleBindings) where
> import Env
> import Ident
> import Maybe
> newtype TopEnv a = TopEnv (Env QualIdent (Entities a)) deriving Show
> data Entities a = Local a | Imported [a] deriving (Eq,Show)
> instance Functor TopEnv where
> fmap f (TopEnv env) = TopEnv (fmap (fmap f) env)
> instance Functor Entities where
> fmap f (Local x) = Local (f x)
> fmap f (Imported xs) = Imported (map f xs)
> entityList :: Entities a -> [a]
> entityList (Local x) = [x]
> entityList (Imported xs) = xs
> entities :: QualIdent -> Env QualIdent (Entities a) -> Entities a
> entities x env = fromMaybe (Imported []) (lookupEnv x env)
> emptyTopEnv :: TopEnv a
> emptyTopEnv = TopEnv emptyEnv
\end{verbatim}
In general, two entities are considered equal if the names of their
original definitions match. However, in the case of algebraic data
types it is possible to hide some or all of their data constructors on
import and export, respectively. In this case we have to merge both
imports such that all data constructors which are visible through any
import path are visible in the current module. The class
\texttt{Entity} is used to handle this merge.
\begin{verbatim}
> class Entity a where
> origName :: a -> QualIdent
> merge :: a -> a -> Maybe a
> merge x y
> | origName x == origName y = Just x
> | otherwise = Nothing
\end{verbatim}
The function \texttt{importTopEnv} imports an entity from another
module into an environment. If the \texttt{qual}ified import flag is
\texttt{True}, only a binding for the qualified name is introduced
in the environment. Otherwise, both a qualified and an unqualified
import are performed.
\begin{verbatim}
> importTopEnv :: Entity a => Bool -> ModuleIdent -> Ident -> a
> -> TopEnv a -> TopEnv a
> importTopEnv qual
> | qual = qualImport
> | otherwise = \m x y -> unqualImport x y . qualImport m x y
> where unqualImport x = qualImportTopEnv (qualify x)
> qualImport m x = qualImportTopEnv (qualifyWith m x)
> qualImportTopEnv :: Entity a => QualIdent -> a -> TopEnv a -> TopEnv a
> qualImportTopEnv x y (TopEnv env) =
> TopEnv (bindEnv x (mergeImport y (entities x env)) env)
> mergeImport :: Entity a => a -> Entities a -> Entities a
> mergeImport _ (Local _) = wrong "qualImportTopEnv"
> mergeImport y (Imported ys) = Imported (mergeImports y ys)
> where mergeImports x [] = [x]
> mergeImports x (x':xs) =
> case merge x x' of
> Just x'' -> x'' : xs
> Nothing -> x' : mergeImports x xs
\end{verbatim}
The function \texttt{globalBindTopEnv} introduces a binding for a
global definition into an environment. Such entities become visible
with an unqualified and a qualified name. The function
\texttt{localBindTopEnv} introduces a binding for a local definition
and binds only the unqualified name. After renaming has been applied,
the compiler can distinguish global and local identifiers by the value
of their renaming key. This allows using \texttt{bindTopEnv} to
introduce bindings for both global and local definitions.
\begin{verbatim}
> bindTopEnv :: ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
> bindTopEnv m x
> | isRenamed x = localBindTopEnv x
> | otherwise = globalBindTopEnv m x
> globalBindTopEnv :: ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
> globalBindTopEnv m x y =
> localBindTopEnv x y . qualBindTopEnv (qualifyWith m x) y
> localBindTopEnv :: Ident -> a -> TopEnv a -> TopEnv a
> localBindTopEnv = qualBindTopEnv . qualify
> qualBindTopEnv :: QualIdent -> a -> TopEnv a -> TopEnv a
> qualBindTopEnv x y (TopEnv env) = TopEnv (bindLocal x y (entities x env) env)
> where bindLocal _ _ (Local _) = wrong "qualBindTopEnv"
> bindLocal x y (Imported _) = bindEnv x (Local y)
> rebindTopEnv :: ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
> rebindTopEnv m x
> | isRenamed x = localRebindTopEnv x
> | otherwise = globalRebindTopEnv m x
> globalRebindTopEnv :: ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
> globalRebindTopEnv m x y =
> localRebindTopEnv x y . qualRebindTopEnv (qualifyWith m x) y
> localRebindTopEnv :: Ident -> a -> TopEnv a -> TopEnv a
> localRebindTopEnv = qualRebindTopEnv . qualify
> qualRebindTopEnv :: QualIdent -> a -> TopEnv a -> TopEnv a
> qualRebindTopEnv x y (TopEnv env) =
> TopEnv (rebindLocal x y (entities x env) env)
> where rebindLocal x y (Local _) = bindEnv x (Local y)
> rebindLocal _ _ (Imported _) = wrong "qualRebindTopEnv"
> localUnimportTopEnv :: Ident -> TopEnv a -> TopEnv a
> localUnimportTopEnv x (TopEnv env) =
> TopEnv (unbindImport x' (entities x' env) env)
> where x' = qualify x
> unbindImport _ (Local _) = id
> unbindImport x (Imported _) = unbindEnv x
> localUnbindTopEnv :: Ident -> TopEnv a -> TopEnv a
> localUnbindTopEnv x (TopEnv env) =
> TopEnv (unbindLocal x' (entities x' env) env)
> where x' = qualify x
> unbindLocal x (Local _) = unbindEnv x
> unbindLocal _ (Imported _) = wrong "unbindTopEnv"
> lookupTopEnv :: Ident -> TopEnv a -> [a]
> lookupTopEnv = qualLookupTopEnv . qualify
> qualLookupTopEnv :: QualIdent -> TopEnv a -> [a]
> qualLookupTopEnv x (TopEnv env) = entityList (entities x env)
\end{verbatim}
The function \texttt{allEntities} returns a list of all entities bound
in an environment. The function \texttt{allImports} returns a list of
the names and values of all entities in an environment that were
imported from another module. The function \texttt{localBindings}
returns the list of all entities defined in the current module, and
the function \texttt{moduleBindings} returns the list of all entities
which are in scope with both an unqualified name $x$ and a qualified
name $M.x$. Since a name can be defined only once at the top-level of
a module and imports of the same entity are merged, the result lists
of both functions will contain no duplicates. Note that both functions
(actually, their helper function \texttt{unqualBindings}) make use of
the fact that the list returned by \texttt{envToList} is sorted
according to the qualified names of the entities and qualified
identifiers are ordered first by their module qualifier.
\begin{verbatim}
> allEntities :: TopEnv a -> [a]
> allEntities (TopEnv env) =
> [y' | (x,y) <- envToList env, isQualified x, y' <- entityList y]
> allImports :: TopEnv a -> [(QualIdent,a)]
> allImports (TopEnv env) =
> [(x,y) | (x,Imported ys) <- envToList env, y <- ys]
> unqualBindings :: Maybe ModuleIdent -> TopEnv a -> [(Ident,Entities a)]
> unqualBindings m (TopEnv env) =
> [(x',y) | (x,y) <- takeWhile p (dropWhile (not . p) (envToList env)),
> let x' = unqualify x]
> where p = (m ==) . fst . splitQualIdent . fst
> localBindings :: TopEnv a -> [(Ident,a)]
> localBindings env =
> [(x,y) | (x,Local y) <- unqualBindings Nothing env]
> moduleBindings :: Entity a => ModuleIdent -> TopEnv a -> [(Ident,a)]
> moduleBindings m env =
> [(x,y') | (x,y) <- unqualBindings (Just m) env, y' <- entityList y,
> origName y' `elem` map origName (lookupTopEnv x env)]
\end{verbatim}
Auxiliary functions.
\begin{verbatim}
> wrong :: String -> a
> wrong what = error ("internal error: " ++ what)
\end{verbatim}