8051721f33399883a28599d95a0e83a4cd423d4f
[ghc.git] / compiler / basicTypes / VarEnv.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 -}
5
6 module VarEnv (
7 -- * Var, Id and TyVar environments (maps)
8 VarEnv, IdEnv, TyVarEnv, CoVarEnv,
9
10 -- ** Manipulating these environments
11 emptyVarEnv, unitVarEnv, mkVarEnv,
12 elemVarEnv, varEnvElts, varEnvKeys,
13 extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList,
14 plusVarEnv, plusVarEnv_C, plusVarEnv_CD, alterVarEnv,
15 delVarEnvList, delVarEnv,
16 minusVarEnv, intersectsVarEnv,
17 lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
18 mapVarEnv, zipVarEnv,
19 modifyVarEnv, modifyVarEnv_Directly,
20 isEmptyVarEnv, foldVarEnv,
21 elemVarEnvByKey, lookupVarEnv_Directly,
22 filterVarEnv, filterVarEnv_Directly, restrictVarEnv,
23 partitionVarEnv,
24
25 -- * Deterministic Var environments (maps)
26 DVarEnv,
27
28 -- ** Manipulating these environments
29 emptyDVarEnv,
30 extendDVarEnv,
31 lookupDVarEnv,
32 foldDVarEnv,
33
34 -- * The InScopeSet type
35 InScopeSet,
36
37 -- ** Operations on InScopeSets
38 emptyInScopeSet, mkInScopeSet, delInScopeSet,
39 extendInScopeSet, extendInScopeSetList, extendInScopeSetSet,
40 getInScopeVars, lookupInScope, lookupInScope_Directly,
41 unionInScope, elemInScopeSet, uniqAway,
42
43 -- * The RnEnv2 type
44 RnEnv2,
45
46 -- ** Operations on RnEnv2s
47 mkRnEnv2, rnBndr2, rnBndrs2,
48 rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe,
49 rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR,
50 delBndrL, delBndrR, delBndrsL, delBndrsR,
51 addRnInScopeSet,
52 rnEtaL, rnEtaR,
53 rnInScope, rnInScopeSet, lookupRnInScope,
54
55 -- * TidyEnv and its operation
56 TidyEnv,
57 emptyTidyEnv
58 ) where
59
60 import OccName
61 import Var
62 import VarSet
63 import UniqFM
64 import UniqDFM
65 import Unique
66 import Util
67 import Maybes
68 import Outputable
69 import StaticFlags
70 import FastString
71
72 {-
73 ************************************************************************
74 * *
75 In-scope sets
76 * *
77 ************************************************************************
78 -}
79
80 -- | A set of variables that are in scope at some point
81 data InScopeSet = InScope (VarEnv Var) {-# UNPACK #-} !Int
82 -- The (VarEnv Var) is just a VarSet. But we write it like
83 -- this to remind ourselves that you can look up a Var in
84 -- the InScopeSet. Typically the InScopeSet contains the
85 -- canonical version of the variable (e.g. with an informative
86 -- unfolding), so this lookup is useful.
87 --
88 -- INVARIANT: the VarEnv maps (the Unique of) a variable to
89 -- a variable with the same Uniqua. (This was not
90 -- the case in the past, when we had a grevious hack
91 -- mapping var1 to var2.
92 --
93 -- The Int is a kind of hash-value used by uniqAway
94 -- For example, it might be the size of the set
95 -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
96
97 instance Outputable InScopeSet where
98 ppr (InScope s _) = ptext (sLit "InScope") <+> ppr s
99
100 emptyInScopeSet :: InScopeSet
101 emptyInScopeSet = InScope emptyVarSet 1
102
103 getInScopeVars :: InScopeSet -> VarEnv Var
104 getInScopeVars (InScope vs _) = vs
105
106 mkInScopeSet :: VarEnv Var -> InScopeSet
107 mkInScopeSet in_scope = InScope in_scope 1
108
109 extendInScopeSet :: InScopeSet -> Var -> InScopeSet
110 extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n + 1)
111
112 extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
113 extendInScopeSetList (InScope in_scope n) vs
114 = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
115 (n + length vs)
116
117 extendInScopeSetSet :: InScopeSet -> VarEnv Var -> InScopeSet
118 extendInScopeSetSet (InScope in_scope n) vs
119 = InScope (in_scope `plusVarEnv` vs) (n + sizeUFM vs)
120
121 delInScopeSet :: InScopeSet -> Var -> InScopeSet
122 delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
123
124 elemInScopeSet :: Var -> InScopeSet -> Bool
125 elemInScopeSet v (InScope in_scope _) = v `elemVarEnv` in_scope
126
127 -- | Look up a variable the 'InScopeSet'. This lets you map from
128 -- the variable's identity (unique) to its full value.
129 lookupInScope :: InScopeSet -> Var -> Maybe Var
130 lookupInScope (InScope in_scope _) v = lookupVarEnv in_scope v
131
132 lookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var
133 lookupInScope_Directly (InScope in_scope _) uniq
134 = lookupVarEnv_Directly in_scope uniq
135
136 unionInScope :: InScopeSet -> InScopeSet -> InScopeSet
137 unionInScope (InScope s1 _) (InScope s2 n2)
138 = InScope (s1 `plusVarEnv` s2) n2
139
140 -- | @uniqAway in_scope v@ finds a unique that is not used in the
141 -- in-scope set, and gives that to v.
142 uniqAway :: InScopeSet -> Var -> Var
143 -- It starts with v's current unique, of course, in the hope that it won't
144 -- have to change, and thereafter uses a combination of that and the hash-code
145 -- found in the in-scope set
146 uniqAway in_scope var
147 | var `elemInScopeSet` in_scope = uniqAway' in_scope var -- Make a new one
148 | otherwise = var -- Nothing to do
149
150 uniqAway' :: InScopeSet -> Var -> Var
151 -- This one *always* makes up a new variable
152 uniqAway' (InScope set n) var
153 = try 1
154 where
155 orig_unique = getUnique var
156 try k
157 | debugIsOn && (k > 1000)
158 = pprPanic "uniqAway loop:" (ppr k <+> text "tries" <+> ppr var <+> int n)
159 | uniq `elemVarSetByKey` set = try (k + 1)
160 | debugIsOn && opt_PprStyle_Debug && (k > 3)
161 = pprTrace "uniqAway:" (ppr k <+> text "tries" <+> ppr var <+> int n)
162 setVarUnique var uniq
163 | otherwise = setVarUnique var uniq
164 where
165 uniq = deriveUnique orig_unique (n * k)
166
167 {-
168 ************************************************************************
169 * *
170 Dual renaming
171 * *
172 ************************************************************************
173 -}
174
175 -- | When we are comparing (or matching) types or terms, we are faced with
176 -- \"going under\" corresponding binders. E.g. when comparing:
177 --
178 -- > \x. e1 ~ \y. e2
179 --
180 -- Basically we want to rename [@x@ -> @y@] or [@y@ -> @x@], but there are lots of
181 -- things we must be careful of. In particular, @x@ might be free in @e2@, or
182 -- y in @e1@. So the idea is that we come up with a fresh binder that is free
183 -- in neither, and rename @x@ and @y@ respectively. That means we must maintain:
184 --
185 -- 1. A renaming for the left-hand expression
186 --
187 -- 2. A renaming for the right-hand expressions
188 --
189 -- 3. An in-scope set
190 --
191 -- Furthermore, when matching, we want to be able to have an 'occurs check',
192 -- to prevent:
193 --
194 -- > \x. f ~ \y. y
195 --
196 -- matching with [@f@ -> @y@]. So for each expression we want to know that set of
197 -- locally-bound variables. That is precisely the domain of the mappings 1.
198 -- and 2., but we must ensure that we always extend the mappings as we go in.
199 --
200 -- All of this information is bundled up in the 'RnEnv2'
201 data RnEnv2
202 = RV2 { envL :: VarEnv Var -- Renaming for Left term
203 , envR :: VarEnv Var -- Renaming for Right term
204 , in_scope :: InScopeSet } -- In scope in left or right terms
205
206 -- The renamings envL and envR are *guaranteed* to contain a binding
207 -- for every variable bound as we go into the term, even if it is not
208 -- renamed. That way we can ask what variables are locally bound
209 -- (inRnEnvL, inRnEnvR)
210
211 mkRnEnv2 :: InScopeSet -> RnEnv2
212 mkRnEnv2 vars = RV2 { envL = emptyVarEnv
213 , envR = emptyVarEnv
214 , in_scope = vars }
215
216 addRnInScopeSet :: RnEnv2 -> VarEnv Var -> RnEnv2
217 addRnInScopeSet env vs
218 | isEmptyVarEnv vs = env
219 | otherwise = env { in_scope = extendInScopeSetSet (in_scope env) vs }
220
221 rnInScope :: Var -> RnEnv2 -> Bool
222 rnInScope x env = x `elemInScopeSet` in_scope env
223
224 rnInScopeSet :: RnEnv2 -> InScopeSet
225 rnInScopeSet = in_scope
226
227 rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
228 -- ^ Applies 'rnBndr2' to several variables: the two variable lists must be of equal length
229 rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR
230
231 rnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2
232 -- ^ @rnBndr2 env bL bR@ goes under a binder @bL@ in the Left term,
233 -- and binder @bR@ in the Right term.
234 -- It finds a new binder, @new_b@,
235 -- and returns an environment mapping @bL -> new_b@ and @bR -> new_b@
236 rnBndr2 (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR
237 = RV2 { envL = extendVarEnv envL bL new_b -- See Note
238 , envR = extendVarEnv envR bR new_b -- [Rebinding]
239 , in_scope = extendInScopeSet in_scope new_b }
240 where
241 -- Find a new binder not in scope in either term
242 new_b | not (bL `elemInScopeSet` in_scope) = bL
243 | not (bR `elemInScopeSet` in_scope) = bR
244 | otherwise = uniqAway' in_scope bL
245
246 -- Note [Rebinding]
247 -- If the new var is the same as the old one, note that
248 -- the extendVarEnv *deletes* any current renaming
249 -- E.g. (\x. \x. ...) ~ (\y. \z. ...)
250 --
251 -- Inside \x \y { [x->y], [y->y], {y} }
252 -- \x \z { [x->x], [y->y, z->x], {y,x} }
253
254 rnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var)
255 -- ^ Similar to 'rnBndr2' but used when there's a binder on the left
256 -- side only.
257 rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
258 = (RV2 { envL = extendVarEnv envL bL new_b
259 , envR = envR
260 , in_scope = extendInScopeSet in_scope new_b }, new_b)
261 where
262 new_b = uniqAway in_scope bL
263
264 rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
265 -- ^ Similar to 'rnBndr2' but used when there's a binder on the right
266 -- side only.
267 rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
268 = (RV2 { envR = extendVarEnv envR bR new_b
269 , envL = envL
270 , in_scope = extendInScopeSet in_scope new_b }, new_b)
271 where
272 new_b = uniqAway in_scope bR
273
274 rnEtaL :: RnEnv2 -> Var -> (RnEnv2, Var)
275 -- ^ Similar to 'rnBndrL' but used for eta expansion
276 -- See Note [Eta expansion]
277 rnEtaL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
278 = (RV2 { envL = extendVarEnv envL bL new_b
279 , envR = extendVarEnv envR new_b new_b -- Note [Eta expansion]
280 , in_scope = extendInScopeSet in_scope new_b }, new_b)
281 where
282 new_b = uniqAway in_scope bL
283
284 rnEtaR :: RnEnv2 -> Var -> (RnEnv2, Var)
285 -- ^ Similar to 'rnBndr2' but used for eta expansion
286 -- See Note [Eta expansion]
287 rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
288 = (RV2 { envL = extendVarEnv envL new_b new_b -- Note [Eta expansion]
289 , envR = extendVarEnv envR bR new_b
290 , in_scope = extendInScopeSet in_scope new_b }, new_b)
291 where
292 new_b = uniqAway in_scope bR
293
294 delBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2
295 delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v
296 = rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
297 delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v
298 = rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
299
300 delBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2
301 delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v
302 = rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
303 delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v
304 = rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
305
306 rnOccL, rnOccR :: RnEnv2 -> Var -> Var
307 -- ^ Look up the renaming of an occurrence in the left or right term
308 rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
309 rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
310
311 rnOccL_maybe, rnOccR_maybe :: RnEnv2 -> Var -> Maybe Var
312 -- ^ Look up the renaming of an occurrence in the left or right term
313 rnOccL_maybe (RV2 { envL = env }) v = lookupVarEnv env v
314 rnOccR_maybe (RV2 { envR = env }) v = lookupVarEnv env v
315
316 inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
317 -- ^ Tells whether a variable is locally bound
318 inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env
319 inRnEnvR (RV2 { envR = env }) v = v `elemVarEnv` env
320
321 lookupRnInScope :: RnEnv2 -> Var -> Var
322 lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v
323
324 nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2
325 -- ^ Wipe the left or right side renaming
326 nukeRnEnvL env = env { envL = emptyVarEnv }
327 nukeRnEnvR env = env { envR = emptyVarEnv }
328
329 {-
330 Note [Eta expansion]
331 ~~~~~~~~~~~~~~~~~~~~
332 When matching
333 (\x.M) ~ N
334 we rename x to x' with, where x' is not in scope in
335 either term. Then we want to behave as if we'd seen
336 (\x'.M) ~ (\x'.N x')
337 Since x' isn't in scope in N, the form (\x'. N x') doesn't
338 capture any variables in N. But we must nevertheless extend
339 the envR with a binding [x' -> x'], to support the occurs check.
340 For example, if we don't do this, we can get silly matches like
341 forall a. (\y.a) ~ v
342 succeeding with [a -> v y], which is bogus of course.
343
344
345 ************************************************************************
346 * *
347 Tidying
348 * *
349 ************************************************************************
350 -}
351
352 -- | When tidying up print names, we keep a mapping of in-scope occ-names
353 -- (the 'TidyOccEnv') and a Var-to-Var of the current renamings
354 type TidyEnv = (TidyOccEnv, VarEnv Var)
355
356 emptyTidyEnv :: TidyEnv
357 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
358
359 {-
360 ************************************************************************
361 * *
362 \subsection{@VarEnv@s}
363 * *
364 ************************************************************************
365 -}
366
367 type VarEnv elt = UniqFM elt
368 type IdEnv elt = VarEnv elt
369 type TyVarEnv elt = VarEnv elt
370 type CoVarEnv elt = VarEnv elt
371
372 emptyVarEnv :: VarEnv a
373 mkVarEnv :: [(Var, a)] -> VarEnv a
374 zipVarEnv :: [Var] -> [a] -> VarEnv a
375 unitVarEnv :: Var -> a -> VarEnv a
376 alterVarEnv :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a
377 extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
378 extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
379 extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b
380 plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
381 extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
382
383 lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a
384 filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
385 partitionVarEnv :: (a -> Bool) -> VarEnv a -> (VarEnv a, VarEnv a)
386 restrictVarEnv :: VarEnv a -> VarSet -> VarEnv a
387 delVarEnvList :: VarEnv a -> [Var] -> VarEnv a
388 delVarEnv :: VarEnv a -> Var -> VarEnv a
389 minusVarEnv :: VarEnv a -> VarEnv b -> VarEnv a
390 intersectsVarEnv :: VarEnv a -> VarEnv a -> Bool
391 plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
392 plusVarEnv_CD :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a
393 mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
394 modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a
395 varEnvElts :: VarEnv a -> [a]
396 varEnvKeys :: VarEnv a -> [Unique]
397
398 isEmptyVarEnv :: VarEnv a -> Bool
399 lookupVarEnv :: VarEnv a -> Var -> Maybe a
400 filterVarEnv :: (a -> Bool) -> VarEnv a -> VarEnv a
401 lookupVarEnv_NF :: VarEnv a -> Var -> a
402 lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
403 elemVarEnv :: Var -> VarEnv a -> Bool
404 elemVarEnvByKey :: Unique -> VarEnv a -> Bool
405 foldVarEnv :: (a -> b -> b) -> b -> VarEnv a -> b
406
407 elemVarEnv = elemUFM
408 elemVarEnvByKey = elemUFM_Directly
409 alterVarEnv = alterUFM
410 extendVarEnv = addToUFM
411 extendVarEnv_C = addToUFM_C
412 extendVarEnv_Acc = addToUFM_Acc
413 extendVarEnvList = addListToUFM
414 plusVarEnv_C = plusUFM_C
415 plusVarEnv_CD = plusUFM_CD
416 delVarEnvList = delListFromUFM
417 delVarEnv = delFromUFM
418 minusVarEnv = minusUFM
419 intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))
420 plusVarEnv = plusUFM
421 lookupVarEnv = lookupUFM
422 filterVarEnv = filterUFM
423 lookupWithDefaultVarEnv = lookupWithDefaultUFM
424 mapVarEnv = mapUFM
425 mkVarEnv = listToUFM
426 emptyVarEnv = emptyUFM
427 varEnvElts = eltsUFM
428 varEnvKeys = keysUFM
429 unitVarEnv = unitUFM
430 isEmptyVarEnv = isNullUFM
431 foldVarEnv = foldUFM
432 lookupVarEnv_Directly = lookupUFM_Directly
433 filterVarEnv_Directly = filterUFM_Directly
434 partitionVarEnv = partitionUFM
435
436 restrictVarEnv env vs = filterVarEnv_Directly keep env
437 where
438 keep u _ = u `elemVarSetByKey` vs
439
440 zipVarEnv tyvars tys = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
441 lookupVarEnv_NF env id = case lookupVarEnv env id of
442 Just xx -> xx
443 Nothing -> panic "lookupVarEnv_NF: Nothing"
444
445 {-
446 @modifyVarEnv@: Look up a thing in the VarEnv,
447 then mash it with the modify function, and put it back.
448 -}
449
450 modifyVarEnv mangle_fn env key
451 = case (lookupVarEnv env key) of
452 Nothing -> env
453 Just xx -> extendVarEnv env key (mangle_fn xx)
454
455 modifyVarEnv_Directly :: (a -> a) -> UniqFM a -> Unique -> UniqFM a
456 modifyVarEnv_Directly mangle_fn env key
457 = case (lookupUFM_Directly env key) of
458 Nothing -> env
459 Just xx -> addToUFM_Directly env key (mangle_fn xx)
460
461 -- Deterministic VarEnv
462 -- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
463 -- DVarEnv.
464
465 type DVarEnv elt = UniqDFM elt
466
467 emptyDVarEnv :: DVarEnv a
468 emptyDVarEnv = emptyUDFM
469
470 extendDVarEnv :: DVarEnv a -> Var -> a -> DVarEnv a
471 extendDVarEnv = addToUDFM
472
473 lookupDVarEnv :: DVarEnv a -> Var -> Maybe a
474 lookupDVarEnv = lookupUDFM
475
476 foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
477 foldDVarEnv = foldUDFM