2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[E]{Main typechecker environment}
7 #include "HsVersions.h"
12 getE_GlobalVals, getE_TCE, getE_CE,
15 growE_LVE, plusE_GVE, tvOfE,
17 lookupE_Value, lookupE_ValueQuietly,
18 lookupE_ClassOpByKey, lookupE_Binder,
22 plusGVE, nullGVE, unitGVE, -- UNUSED: rngGVE,
24 -- and to make the interface self-sufficient...
25 CE(..), Id, Name, TCE(..), TyVar, Maybe, UniqFM
30 import UniqFM -- basic env handling code
32 import AbsPrel ( PrimOp
33 IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
34 IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
36 import AbsUniType ( getClassOps, extractTyVarsFromTy,
37 getClassBigSig, getClassOpString, TyVar,
38 TyVarTemplate, ClassOp, Class, Arity(..),
40 IF_ATTACK_PRAGMAS(COMMA cmpTyVar COMMA cmpClass)
42 import Id ( getIdUniType, Id, IdInfo )
43 import Maybes ( MaybeErr(..), Maybe(..) )
44 import Name -- Name(..), etc.
45 import Outputable -- def of ppr, etc.
46 import Pretty -- to pretty-print error messages
47 import UniqSet -- this use of Sets is a HACK (WDP 94/05)
48 import Unique -- *Key stuff
53 %************************************************************************
55 \subsection{Type declarations}
57 %************************************************************************
62 = MkE TCE -- type environment
63 GVB -- "global" value bindings; no free type vars
64 LVB -- "local" value bindings; may have free type vars
65 CE -- class environment
68 mkE tce ce = MkE tce nullGVB nullLVB ce
71 nullE = MkE nullTCE nullGVB nullLVB nullCE
74 The ``local'' and ``global'' bindings, @LVB@ and @GVB@, are
75 non-exported synonyms. The important thing is that @GVB@ doesn't
76 contain any free type variables. This is used (only) in @tvOfE@,
77 which extracts free type variables from the environment. It's quite a
78 help to have this separation because there may be quite a large bunch
79 of imported things in the @GVB@, all of which are guaranteed
83 type LVB = UniqFM Id -- Locals just have a Unique
84 type GVB = UniqFM Id -- Globals might be a prelude thing; hence IdKey
86 nullLVB = (emptyUFM :: LVB)
87 nullGVB = (emptyUFM :: GVB)
90 The ``local'' and ``global'' value environments are not part of @E@ at
91 all, but is used to provide increments to the value bindings. GVE are
92 carries the implication that there are no free type variables.
95 type LVE = [(Name, Id)] -- Maps Names to Ids
96 type GVE = [(Name, Id)] -- Maps Names to Ids
100 nullGVE = ([] :: GVE)
101 unitGVE n i = ( [(n, i)] :: GVE )
102 -- UNUSED: rngGVE gve = map snd gve
106 %************************************************************************
108 \subsection{Value environment stuff}
110 %************************************************************************
112 Looking up things should mostly succeed, because the renamer should
113 have spotted all out-of-scope names. The exception is instances.
115 The ``Quietly'' version is for pragmas, where lookups very well may
116 fail. @lookup_val@ is the internal function that does the work.
119 lookupE_Value :: E -> Name -> Id
120 lookupE_ValueQuietly :: E -> Name -> Maybe Id
123 = case lookup_val e nm of
125 Failed (should_panic, msg)
126 -> if should_panic then panic msg else error msg
128 lookupE_ValueQuietly e nm
129 = case lookup_val e nm of
130 Succeeded id -> Just id
135 lookup_val (MkE _ gvb lvb ce) name
138 WiredInVal id -> Succeeded id
139 PreludeVal key _ -> case (lookupDirectlyUFM gvb key) of
140 Just id -> Succeeded id
141 Nothing -> Failed (False, prelude_err_msg)
143 ClassOpName uniq clas_name _ tag -> id_from_env uniq
145 -- You might think that top-level ids are guaranteed to have no
146 -- free tyvars, so look only in gvb; but you'd be wrong! When
147 -- type-checking the RHS of recursive top-level defns, the name
148 -- of the thing is bound to a *monomorphic* type, which is later
149 -- generalised. So we have to look in the LVE too.
151 OtherTopId uniq _ -> id_from_env uniq
153 -- Short names could be in either GVB or LVB
154 Short uniq _ -> id_from_env uniq
156 funny_name -> pprPanic "lookup_val: funny Name" (ppr PprDebug funny_name)
158 prelude_err_msg = "ERROR: in looking up a built-in Prelude value!\n(This can happen if you use `-fno-implicit-prelude'\nor you hide the system's Prelude.hi in some way.)"
161 = case (lookupDirectlyUFM lvb uniq) of
162 Just id -> Succeeded id
164 case (lookupDirectlyUFM gvb uniq) of
165 Just id -> Succeeded id
166 Nothing -> Failed (True, -- should panic
167 ("lookupE_Value: unbound name: "++(ppShow 80 (ppr PprShowAll name))))
170 For Prelude things that we reach out and grab, we have only an @Unique@.
172 lookupE_ClassOpByKey :: E -> Unique{-ClassKey-} -> FAST_STRING -> Id
174 lookupE_ClassOpByKey (MkE _ gvb lvb ce) clas_key op_str
176 clas = lookupCE ce (PreludeClass clas_key bottom)
177 bottom = pprPanic ("lookupE_ClassOpByKey: "++(_UNPK_ op_str))
178 (ppAbove (pprUnique clas_key) (ppr PprShowAll (rngCE ce)))
180 (clas_tyvar_tmpl, scs, sc_sel_ids, ops, op_sel_ids, defm_ids)
181 = getClassBigSig clas
183 case [ op_sel_id | (op, op_sel_id) <- ops `zip` op_sel_ids,
184 op_str == getClassOpString op ] of
186 -- Seems a rather horrible way to do it (ToDo)
189 @lookupE_Binder@ is like @lookupE_Value@, but it is used for {\em
190 binding} occurrences of a variable, rather than {\em uses}. The
191 difference is that there should always be an entry in the LVE for
192 binding occurrences. Just a sanity check now, really.
195 lookupE_Binder :: E -> Name -> Id
196 lookupE_Binder (MkE _ _ lvb _) name
197 = case (lookupDirectlyUFM lvb (name2uniq name)) of
199 Nothing -> pprPanic "lookupE_Binder: unbound name: " (ppr PprShowAll name)
203 getE_GlobalVals :: E -> [Id]
204 getE_GlobalVals (MkE tce gvb lvb ce)
206 result = eltsUFM gvb ++ eltsUFM lvb
208 -- pprTrace "Global Ids:" (ppr PprShowAll result)
211 plusE_GVE :: E -> GVE -> E
212 plusE_GVE (MkE tce gvb lvb ce) gve
214 new_stuff = listToUFM_Directly [(name2idkey n, i) | (n,i) <- gve ]
216 MkE tce (plusUFM gvb new_stuff) lvb ce
218 name2idkey (PreludeVal k _) = k
219 name2idkey (OtherTopId u _) = u
220 name2idkey (ClassOpName u _ _ _) = u
222 growE_LVE :: E -> LVE -> E
223 growE_LVE (MkE tce gvb lvb ce) lve
225 new_stuff = listToUFM_Directly [(name2uniq n, i) | (n,i) <- lve ]
227 MkE tce gvb (plusUFM lvb new_stuff) ce
229 -- ToDo: move this elsewhere??
230 name2uniq (Short u _) = u
231 name2uniq (OtherTopId u _) = u
232 name2uniq (ClassOpName u _ _ _) = panic "growE_LVE:name2uniq"
235 Return the free type variables of an LVE; there are no duplicates in
236 the result---hence all the @Set@ bozo-ery. The free tyvars can only
237 occur in the LVB part.
240 tvOfE :: E -> [TyVar]
241 tvOfE (MkE tce gvb lvb ce)
242 = uniqSetToList (mkUniqSet (
243 foldr ((++) . extractTyVarsFromTy . getIdUniType) [] (eltsUFM lvb)
247 %************************************************************************
250 \subsection{Type and class environments}
252 %************************************************************************
256 getE_TCE (MkE tce gvb lvb ce) = tce
259 getE_CE (MkE tce gvb lvb ce) = ce
261 plusE_TCE :: E -> TCE -> E
262 plusE_TCE (MkE tce gvb lvb ce) tce'
263 = MkE (plusTCE tce' tce) gvb lvb ce
265 plusE_CE :: E -> CE -> E
266 plusE_CE (MkE tce gvb lvb ce) ce'
267 = MkE tce gvb lvb (plusCE ce ce')