2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section{@VarEnvs@: Variable environments}
8 VarEnv, IdEnv, TyVarEnv,
9 emptyVarEnv, unitVarEnv, mkVarEnv,
10 elemVarEnv, varEnvElts, varEnvKeys,
11 extendVarEnv, extendVarEnv_C, extendVarEnvList,
12 plusVarEnv, plusVarEnv_C,
13 delVarEnvList, delVarEnv,
14 lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
16 modifyVarEnv, modifyVarEnv_Directly,
17 isEmptyVarEnv, foldVarEnv,
18 elemVarEnvByKey, lookupVarEnv_Directly,
19 filterVarEnv_Directly,
22 InScopeSet, emptyInScopeSet, mkInScopeSet, delInScopeSet,
23 extendInScopeSet, extendInScopeSetList, modifyInScopeSet,
24 getInScopeVars, lookupInScope, elemInScopeSet, uniqAway,
27 -- RnEnv2 and its operations
28 RnEnv2, mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR,
29 rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, extendRnInScopeList,
30 rnInScope, lookupRnInScope,
36 #include "HsVersions.h"
38 import OccName ( TidyOccEnv, emptyTidyOccEnv )
39 import Var ( Var, setVarUnique )
42 import Unique ( Unique, deriveUnique, getUnique )
43 import Util ( zipEqual, foldl2 )
44 import Maybes ( orElse )
45 import StaticFlags( opt_PprStyle_Debug )
51 %************************************************************************
55 %************************************************************************
58 data InScopeSet = InScope (VarEnv Var) FastInt
59 -- The Int# is a kind of hash-value used by uniqAway
60 -- For example, it might be the size of the set
61 -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
63 instance Outputable InScopeSet where
64 ppr (InScope s i) = ptext SLIT("InScope") <+> ppr s
66 emptyInScopeSet :: InScopeSet
67 emptyInScopeSet = InScope emptyVarSet 1#
69 getInScopeVars :: InScopeSet -> VarEnv Var
70 getInScopeVars (InScope vs _) = vs
72 mkInScopeSet :: VarEnv Var -> InScopeSet
73 mkInScopeSet in_scope = InScope in_scope 1#
75 extendInScopeSet :: InScopeSet -> Var -> InScopeSet
76 extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# 1#)
78 extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
79 extendInScopeSetList (InScope in_scope n) vs
80 = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
81 (n +# iUnbox (length vs))
83 modifyInScopeSet :: InScopeSet -> Var -> Var -> InScopeSet
84 -- Exploit the fact that the in-scope "set" is really a map
85 -- Make old_v map to new_v
86 modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_scope old_v new_v) (n +# 1#)
88 delInScopeSet :: InScopeSet -> Var -> InScopeSet
89 delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
91 mapInScopeSet :: (Var -> Var) -> InScopeSet -> InScopeSet
92 mapInScopeSet f (InScope in_scope n) = InScope (mapVarEnv f in_scope) n
94 elemInScopeSet :: Var -> InScopeSet -> Bool
95 elemInScopeSet v (InScope in_scope n) = v `elemVarEnv` in_scope
97 lookupInScope :: InScopeSet -> Var -> Maybe Var
98 -- It's important to look for a fixed point
99 -- When we see (case x of y { I# v -> ... })
100 -- we add [x -> y] to the in-scope set (Simplify.simplCaseBinder).
101 -- When we lookup up an occurrence of x, we map to y, but then
102 -- we want to look up y in case it has acquired more evaluation information by now.
103 lookupInScope (InScope in_scope n) v
106 go v = case lookupVarEnv in_scope v of
107 Just v' | v == v' -> Just v' -- Reached a fixed point
113 uniqAway :: InScopeSet -> Var -> Var
114 -- (uniqAway in_scope v) finds a unique that is not used in the
115 -- in-scope set, and gives that to v. It starts with v's current unique, of course,
116 -- in the hope that it won't have to change it, and thereafter uses a combination
117 -- of that and the hash-code found in the in-scope set
118 uniqAway in_scope var
119 | var `elemInScopeSet` in_scope = uniqAway' in_scope var -- Make a new one
120 | otherwise = var -- Nothing to do
122 uniqAway' :: InScopeSet -> Var -> Var
123 -- This one *always* makes up a new variable
124 uniqAway' (InScope set n) var
127 orig_unique = getUnique var
131 = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
133 | uniq `elemVarSetByKey` set = try (k +# 1#)
135 | opt_PprStyle_Debug && k ># 3#
136 = pprTrace "uniqAway:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
137 setVarUnique var uniq
139 | otherwise = setVarUnique var uniq
141 uniq = deriveUnique orig_unique (iBox (n *# k))
145 %************************************************************************
149 %************************************************************************
151 When we are comparing (or matching) types or terms, we are faced with
152 "going under" corresponding binders. E.g. when comparing
155 Basically we want to rename [x->y] or [y->x], but there are lots of
156 things we must be careful of. In particular, x might be free in e2, or
157 y in e1. So the idea is that we come up with a fresh binder that is free
158 in neither, and rename x and y respectively. That means we must maintain
159 a) a renaming for the left-hand expression
160 b) a renaming for the right-hand expressions
163 Furthermore, when matching, we want to be able to have an 'occurs check',
166 matching with f->y. So for each expression we want to know that set of
167 locally-bound variables. That is precisely the domain of the mappings (a)
168 and (b), but we must ensure that we always extend the mappings as we go in.
173 = RV2 { envL :: VarEnv Var -- Renaming for Left term
174 , envR :: VarEnv Var -- Renaming for Right term
175 , in_scope :: InScopeSet } -- In scope in left or right terms
177 -- The renamings envL and envR are *guaranteed* to contain a binding
178 -- for every variable bound as we go into the term, even if it is not
179 -- renamed. That way we can ask what variables are locally bound
180 -- (inRnEnvL, inRnEnvR)
182 mkRnEnv2 :: InScopeSet -> RnEnv2
183 mkRnEnv2 vars = RV2 { envL = emptyVarEnv
187 extendRnInScopeList :: RnEnv2 -> [Var] -> RnEnv2
188 extendRnInScopeList env vs
189 = env { in_scope = extendInScopeSetList (in_scope env) vs }
191 rnInScope :: Var -> RnEnv2 -> Bool
192 rnInScope x env = x `elemInScopeSet` in_scope env
194 rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
195 -- Arg lists must be of equal length
196 rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR
198 rnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2
199 -- (rnBndr2 env bL bR) go under a binder bL in the Left term 1,
200 -- and binder bR in the Right term
201 -- It finds a new binder, new_b,
202 -- and returns an environment mapping bL->new_b and bR->new_b resp.
203 rnBndr2 (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR
204 = RV2 { envL = extendVarEnv envL bL new_b -- See Note
205 , envR = extendVarEnv envR bR new_b -- [Rebinding]
206 , in_scope = extendInScopeSet in_scope new_b }
208 -- Find a new binder not in scope in either term
209 new_b | not (bL `elemInScopeSet` in_scope) = bL
210 | not (bR `elemInScopeSet` in_scope) = bR
211 | otherwise = uniqAway' in_scope bL
214 -- If the new var is the same as the old one, note that
215 -- the extendVarEnv *deletes* any current renaming
216 -- E.g. (\x. \x. ...) ~ (\y. \z. ...)
218 -- Inside \x \y { [x->y], [y->y], {y} }
219 -- \x \z { [x->x], [y->y, z->x], {y,x} }
221 rnBndrL, rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
222 -- Used when there's a binder on one side or the other only
223 -- Useful when eta-expanding
224 rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
225 = (RV2 { envL = extendVarEnv envL bL new_b
227 , in_scope = extendInScopeSet in_scope new_b }, new_b)
229 new_b | not (bL `elemInScopeSet` in_scope) = bL
230 | otherwise = uniqAway' in_scope bL
232 rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
234 , envR = extendVarEnv envR bR new_b
235 , in_scope = extendInScopeSet in_scope new_b }, new_b)
237 new_b | not (bR `elemInScopeSet` in_scope) = bR
238 | otherwise = uniqAway' in_scope bR
240 rnOccL, rnOccR :: RnEnv2 -> Var -> Var
241 -- Look up the renaming of an occurrence in the left or right term
242 rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
243 rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
245 inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
246 -- Tells whether a variable is locally bound
247 inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env
248 inRnEnvR (RV2 { envR = env }) v = v `elemVarEnv` env
250 lookupRnInScope :: RnEnv2 -> Var -> Var
251 lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v
253 nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2
254 nukeRnEnvL env = env { envL = emptyVarEnv }
255 nukeRnEnvR env = env { envR = emptyVarEnv }
259 %************************************************************************
263 %************************************************************************
265 When tidying up print names, we keep a mapping of in-scope occ-names
266 (the TidyOccEnv) and a Var-to-Var of the current renamings.
269 type TidyEnv = (TidyOccEnv, VarEnv Var)
271 emptyTidyEnv :: TidyEnv
272 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
276 %************************************************************************
278 \subsection{@VarEnv@s}
280 %************************************************************************
283 type VarEnv elt = UniqFM elt
284 type IdEnv elt = VarEnv elt
285 type TyVarEnv elt = VarEnv elt
287 emptyVarEnv :: VarEnv a
288 mkVarEnv :: [(Var, a)] -> VarEnv a
289 zipVarEnv :: [Var] -> [a] -> VarEnv a
290 unitVarEnv :: Var -> a -> VarEnv a
291 extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
292 extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
293 plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
294 extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
296 lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a
297 filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
298 delVarEnvList :: VarEnv a -> [Var] -> VarEnv a
299 delVarEnv :: VarEnv a -> Var -> VarEnv a
300 plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
301 mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
302 modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a
303 varEnvElts :: VarEnv a -> [a]
304 varEnvKeys :: VarEnv a -> [Unique]
306 isEmptyVarEnv :: VarEnv a -> Bool
307 lookupVarEnv :: VarEnv a -> Var -> Maybe a
308 lookupVarEnv_NF :: VarEnv a -> Var -> a
309 lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
310 elemVarEnv :: Var -> VarEnv a -> Bool
311 elemVarEnvByKey :: Unique -> VarEnv a -> Bool
312 foldVarEnv :: (a -> b -> b) -> b -> VarEnv a -> b
317 elemVarEnvByKey = elemUFM_Directly
318 extendVarEnv = addToUFM
319 extendVarEnv_C = addToUFM_C
320 extendVarEnvList = addListToUFM
321 plusVarEnv_C = plusUFM_C
322 delVarEnvList = delListFromUFM
323 delVarEnv = delFromUFM
325 lookupVarEnv = lookupUFM
326 lookupWithDefaultVarEnv = lookupWithDefaultUFM
329 emptyVarEnv = emptyUFM
333 isEmptyVarEnv = isNullUFM
335 lookupVarEnv_Directly = lookupUFM_Directly
336 filterVarEnv_Directly = filterUFM_Directly
338 zipVarEnv tyvars tys = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
339 lookupVarEnv_NF env id = case (lookupVarEnv env id) of { Just xx -> xx }
342 @modifyVarEnv@: Look up a thing in the VarEnv,
343 then mash it with the modify function, and put it back.
346 modifyVarEnv mangle_fn env key
347 = case (lookupVarEnv env key) of
349 Just xx -> extendVarEnv env key (mangle_fn xx)
351 modifyVarEnv_Directly mangle_fn env key
352 = case (lookupUFM_Directly env key) of
354 Just xx -> addToUFM_Directly env key (mangle_fn xx)