Smarter HsType pretty-print for promoted datacons
[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, TyCoVarEnv,
9
10 -- ** Manipulating these environments
11 emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly,
12 elemVarEnv, disjointVarEnv,
13 extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnv_Directly,
14 extendVarEnvList,
15 plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C,
16 plusVarEnvList, alterVarEnv,
17 delVarEnvList, delVarEnv, delVarEnv_Directly,
18 minusVarEnv, intersectsVarEnv,
19 lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
20 mapVarEnv, zipVarEnv,
21 modifyVarEnv, modifyVarEnv_Directly,
22 isEmptyVarEnv,
23 elemVarEnvByKey, lookupVarEnv_Directly,
24 filterVarEnv, filterVarEnv_Directly, restrictVarEnv,
25 partitionVarEnv,
26
27 -- * Deterministic Var environments (maps)
28 DVarEnv, DIdEnv, DTyVarEnv,
29
30 -- ** Manipulating these environments
31 emptyDVarEnv, mkDVarEnv,
32 dVarEnvElts,
33 extendDVarEnv, extendDVarEnv_C,
34 extendDVarEnvList,
35 lookupDVarEnv, elemDVarEnv,
36 isEmptyDVarEnv, foldDVarEnv,
37 mapDVarEnv, filterDVarEnv,
38 modifyDVarEnv,
39 alterDVarEnv,
40 plusDVarEnv, plusDVarEnv_C,
41 unitDVarEnv,
42 delDVarEnv,
43 delDVarEnvList,
44 minusDVarEnv,
45 partitionDVarEnv,
46 anyDVarEnv,
47
48 -- * The InScopeSet type
49 InScopeSet,
50
51 -- ** Operations on InScopeSets
52 emptyInScopeSet, mkInScopeSet, delInScopeSet,
53 extendInScopeSet, extendInScopeSetList, extendInScopeSetSet,
54 getInScopeVars, lookupInScope, lookupInScope_Directly,
55 unionInScope, elemInScopeSet, uniqAway,
56 varSetInScope,
57
58 -- * The RnEnv2 type
59 RnEnv2,
60
61 -- ** Operations on RnEnv2s
62 mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var,
63 rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe,
64 rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap,
65 delBndrL, delBndrR, delBndrsL, delBndrsR,
66 addRnInScopeSet,
67 rnEtaL, rnEtaR,
68 rnInScope, rnInScopeSet, lookupRnInScope,
69 rnEnvL, rnEnvR,
70
71 -- * TidyEnv and its operation
72 TidyEnv,
73 emptyTidyEnv
74 ) where
75
76 import GhcPrelude
77
78 import OccName
79 import Var
80 import VarSet
81 import UniqSet
82 import UniqFM
83 import UniqDFM
84 import Unique
85 import Util
86 import Maybes
87 import Outputable
88
89 {-
90 ************************************************************************
91 * *
92 In-scope sets
93 * *
94 ************************************************************************
95 -}
96
97 -- | A set of variables that are in scope at some point
98 -- "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 provides
99 -- the motivation for this abstraction.
100 data InScopeSet = InScope VarSet {-# UNPACK #-} !Int
101 -- We store a VarSet here, but we use this for lookups rather than
102 -- just membership tests. Typically the InScopeSet contains the
103 -- canonical version of the variable (e.g. with an informative
104 -- unfolding), so this lookup is useful.
105 --
106 -- The Int is a kind of hash-value used by uniqAway
107 -- For example, it might be the size of the set
108 -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
109
110 instance Outputable InScopeSet where
111 ppr (InScope s _) =
112 text "InScope" <+>
113 braces (fsep (map (ppr . Var.varName) (nonDetEltsUniqSet s)))
114 -- It's OK to use nonDetEltsUniqSet here because it's
115 -- only for pretty printing
116 -- In-scope sets get big, and with -dppr-debug
117 -- the output is overwhelming
118
119 emptyInScopeSet :: InScopeSet
120 emptyInScopeSet = InScope emptyVarSet 1
121
122 getInScopeVars :: InScopeSet -> VarSet
123 getInScopeVars (InScope vs _) = vs
124
125 mkInScopeSet :: VarSet -> InScopeSet
126 mkInScopeSet in_scope = InScope in_scope 1
127
128 extendInScopeSet :: InScopeSet -> Var -> InScopeSet
129 extendInScopeSet (InScope in_scope n) v
130 = InScope (extendVarSet in_scope v) (n + 1)
131
132 extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
133 extendInScopeSetList (InScope in_scope n) vs
134 = InScope (foldl' (\s v -> extendVarSet s v) in_scope vs)
135 (n + length vs)
136
137 extendInScopeSetSet :: InScopeSet -> VarSet -> InScopeSet
138 extendInScopeSetSet (InScope in_scope n) vs
139 = InScope (in_scope `unionVarSet` vs) (n + sizeUniqSet vs)
140
141 delInScopeSet :: InScopeSet -> Var -> InScopeSet
142 delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarSet` v) n
143
144 elemInScopeSet :: Var -> InScopeSet -> Bool
145 elemInScopeSet v (InScope in_scope _) = v `elemVarSet` in_scope
146
147 -- | Look up a variable the 'InScopeSet'. This lets you map from
148 -- the variable's identity (unique) to its full value.
149 lookupInScope :: InScopeSet -> Var -> Maybe Var
150 lookupInScope (InScope in_scope _) v = lookupVarSet in_scope v
151
152 lookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var
153 lookupInScope_Directly (InScope in_scope _) uniq
154 = lookupVarSet_Directly in_scope uniq
155
156 unionInScope :: InScopeSet -> InScopeSet -> InScopeSet
157 unionInScope (InScope s1 _) (InScope s2 n2)
158 = InScope (s1 `unionVarSet` s2) n2
159
160 varSetInScope :: VarSet -> InScopeSet -> Bool
161 varSetInScope vars (InScope s1 _) = vars `subVarSet` s1
162
163 -- | @uniqAway in_scope v@ finds a unique that is not used in the
164 -- in-scope set, and gives that to v.
165 uniqAway :: InScopeSet -> Var -> Var
166 -- It starts with v's current unique, of course, in the hope that it won't
167 -- have to change, and thereafter uses a combination of that and the hash-code
168 -- found in the in-scope set
169 uniqAway in_scope var
170 | var `elemInScopeSet` in_scope = uniqAway' in_scope var -- Make a new one
171 | otherwise = var -- Nothing to do
172
173 uniqAway' :: InScopeSet -> Var -> Var
174 -- This one *always* makes up a new variable
175 uniqAway' (InScope set n) var
176 = try 1
177 where
178 orig_unique = getUnique var
179 try k
180 | debugIsOn && (k > 1000)
181 = pprPanic "uniqAway loop:" msg
182 | uniq `elemVarSetByKey` set = try (k + 1)
183 | k > 3
184 = pprTraceDebug "uniqAway:" msg
185 setVarUnique var uniq
186 | otherwise = setVarUnique var uniq
187 where
188 msg = ppr k <+> text "tries" <+> ppr var <+> int n
189 uniq = deriveUnique orig_unique (n * k)
190
191 {-
192 ************************************************************************
193 * *
194 Dual renaming
195 * *
196 ************************************************************************
197 -}
198
199 -- | Rename Environment 2
200 --
201 -- When we are comparing (or matching) types or terms, we are faced with
202 -- \"going under\" corresponding binders. E.g. when comparing:
203 --
204 -- > \x. e1 ~ \y. e2
205 --
206 -- Basically we want to rename [@x@ -> @y@] or [@y@ -> @x@], but there are lots of
207 -- things we must be careful of. In particular, @x@ might be free in @e2@, or
208 -- y in @e1@. So the idea is that we come up with a fresh binder that is free
209 -- in neither, and rename @x@ and @y@ respectively. That means we must maintain:
210 --
211 -- 1. A renaming for the left-hand expression
212 --
213 -- 2. A renaming for the right-hand expressions
214 --
215 -- 3. An in-scope set
216 --
217 -- Furthermore, when matching, we want to be able to have an 'occurs check',
218 -- to prevent:
219 --
220 -- > \x. f ~ \y. y
221 --
222 -- matching with [@f@ -> @y@]. So for each expression we want to know that set of
223 -- locally-bound variables. That is precisely the domain of the mappings 1.
224 -- and 2., but we must ensure that we always extend the mappings as we go in.
225 --
226 -- All of this information is bundled up in the 'RnEnv2'
227 data RnEnv2
228 = RV2 { envL :: VarEnv Var -- Renaming for Left term
229 , envR :: VarEnv Var -- Renaming for Right term
230 , in_scope :: InScopeSet } -- In scope in left or right terms
231
232 -- The renamings envL and envR are *guaranteed* to contain a binding
233 -- for every variable bound as we go into the term, even if it is not
234 -- renamed. That way we can ask what variables are locally bound
235 -- (inRnEnvL, inRnEnvR)
236
237 mkRnEnv2 :: InScopeSet -> RnEnv2
238 mkRnEnv2 vars = RV2 { envL = emptyVarEnv
239 , envR = emptyVarEnv
240 , in_scope = vars }
241
242 addRnInScopeSet :: RnEnv2 -> VarSet -> RnEnv2
243 addRnInScopeSet env vs
244 | isEmptyVarSet vs = env
245 | otherwise = env { in_scope = extendInScopeSetSet (in_scope env) vs }
246
247 rnInScope :: Var -> RnEnv2 -> Bool
248 rnInScope x env = x `elemInScopeSet` in_scope env
249
250 rnInScopeSet :: RnEnv2 -> InScopeSet
251 rnInScopeSet = in_scope
252
253 -- | Retrieve the left mapping
254 rnEnvL :: RnEnv2 -> VarEnv Var
255 rnEnvL = envL
256
257 -- | Retrieve the right mapping
258 rnEnvR :: RnEnv2 -> VarEnv Var
259 rnEnvR = envR
260
261 rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
262 -- ^ Applies 'rnBndr2' to several variables: the two variable lists must be of equal length
263 rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR
264
265 rnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2
266 -- ^ @rnBndr2 env bL bR@ goes under a binder @bL@ in the Left term,
267 -- and binder @bR@ in the Right term.
268 -- It finds a new binder, @new_b@,
269 -- and returns an environment mapping @bL -> new_b@ and @bR -> new_b@
270 rnBndr2 env bL bR = fst $ rnBndr2_var env bL bR
271
272 rnBndr2_var :: RnEnv2 -> Var -> Var -> (RnEnv2, Var)
273 -- ^ Similar to 'rnBndr2' but returns the new variable as well as the
274 -- new environment
275 rnBndr2_var (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR
276 = (RV2 { envL = extendVarEnv envL bL new_b -- See Note
277 , envR = extendVarEnv envR bR new_b -- [Rebinding]
278 , in_scope = extendInScopeSet in_scope new_b }, new_b)
279 where
280 -- Find a new binder not in scope in either term
281 new_b | not (bL `elemInScopeSet` in_scope) = bL
282 | not (bR `elemInScopeSet` in_scope) = bR
283 | otherwise = uniqAway' in_scope bL
284
285 -- Note [Rebinding]
286 -- If the new var is the same as the old one, note that
287 -- the extendVarEnv *deletes* any current renaming
288 -- E.g. (\x. \x. ...) ~ (\y. \z. ...)
289 --
290 -- Inside \x \y { [x->y], [y->y], {y} }
291 -- \x \z { [x->x], [y->y, z->x], {y,x} }
292
293 rnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var)
294 -- ^ Similar to 'rnBndr2' but used when there's a binder on the left
295 -- side only.
296 rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
297 = (RV2 { envL = extendVarEnv envL bL new_b
298 , envR = envR
299 , in_scope = extendInScopeSet in_scope new_b }, new_b)
300 where
301 new_b = uniqAway in_scope bL
302
303 rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
304 -- ^ Similar to 'rnBndr2' but used when there's a binder on the right
305 -- side only.
306 rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
307 = (RV2 { envR = extendVarEnv envR bR new_b
308 , envL = envL
309 , in_scope = extendInScopeSet in_scope new_b }, new_b)
310 where
311 new_b = uniqAway in_scope bR
312
313 rnEtaL :: RnEnv2 -> Var -> (RnEnv2, Var)
314 -- ^ Similar to 'rnBndrL' but used for eta expansion
315 -- See Note [Eta expansion]
316 rnEtaL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
317 = (RV2 { envL = extendVarEnv envL bL new_b
318 , envR = extendVarEnv envR new_b new_b -- Note [Eta expansion]
319 , in_scope = extendInScopeSet in_scope new_b }, new_b)
320 where
321 new_b = uniqAway in_scope bL
322
323 rnEtaR :: RnEnv2 -> Var -> (RnEnv2, Var)
324 -- ^ Similar to 'rnBndr2' but used for eta expansion
325 -- See Note [Eta expansion]
326 rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
327 = (RV2 { envL = extendVarEnv envL new_b new_b -- Note [Eta expansion]
328 , envR = extendVarEnv envR bR new_b
329 , in_scope = extendInScopeSet in_scope new_b }, new_b)
330 where
331 new_b = uniqAway in_scope bR
332
333 delBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2
334 delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v
335 = rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
336 delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v
337 = rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
338
339 delBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2
340 delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v
341 = rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
342 delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v
343 = rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
344
345 rnOccL, rnOccR :: RnEnv2 -> Var -> Var
346 -- ^ Look up the renaming of an occurrence in the left or right term
347 rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
348 rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
349
350 rnOccL_maybe, rnOccR_maybe :: RnEnv2 -> Var -> Maybe Var
351 -- ^ Look up the renaming of an occurrence in the left or right term
352 rnOccL_maybe (RV2 { envL = env }) v = lookupVarEnv env v
353 rnOccR_maybe (RV2 { envR = env }) v = lookupVarEnv env v
354
355 inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
356 -- ^ Tells whether a variable is locally bound
357 inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env
358 inRnEnvR (RV2 { envR = env }) v = v `elemVarEnv` env
359
360 lookupRnInScope :: RnEnv2 -> Var -> Var
361 lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v
362
363 nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2
364 -- ^ Wipe the left or right side renaming
365 nukeRnEnvL env = env { envL = emptyVarEnv }
366 nukeRnEnvR env = env { envR = emptyVarEnv }
367
368 rnSwap :: RnEnv2 -> RnEnv2
369 -- ^ swap the meaning of left and right
370 rnSwap (RV2 { envL = envL, envR = envR, in_scope = in_scope })
371 = RV2 { envL = envR, envR = envL, in_scope = in_scope }
372
373 {-
374 Note [Eta expansion]
375 ~~~~~~~~~~~~~~~~~~~~
376 When matching
377 (\x.M) ~ N
378 we rename x to x' with, where x' is not in scope in
379 either term. Then we want to behave as if we'd seen
380 (\x'.M) ~ (\x'.N x')
381 Since x' isn't in scope in N, the form (\x'. N x') doesn't
382 capture any variables in N. But we must nevertheless extend
383 the envR with a binding [x' -> x'], to support the occurs check.
384 For example, if we don't do this, we can get silly matches like
385 forall a. (\y.a) ~ v
386 succeeding with [a -> v y], which is bogus of course.
387
388
389 ************************************************************************
390 * *
391 Tidying
392 * *
393 ************************************************************************
394 -}
395
396 -- | Tidy Environment
397 --
398 -- When tidying up print names, we keep a mapping of in-scope occ-names
399 -- (the 'TidyOccEnv') and a Var-to-Var of the current renamings
400 type TidyEnv = (TidyOccEnv, VarEnv Var)
401
402 emptyTidyEnv :: TidyEnv
403 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
404
405 {-
406 ************************************************************************
407 * *
408 \subsection{@VarEnv@s}
409 * *
410 ************************************************************************
411 -}
412
413 -- | Variable Environment
414 type VarEnv elt = UniqFM elt
415
416 -- | Identifier Environment
417 type IdEnv elt = VarEnv elt
418
419 -- | Type Variable Environment
420 type TyVarEnv elt = VarEnv elt
421
422 -- | Type or Coercion Variable Environment
423 type TyCoVarEnv elt = VarEnv elt
424
425 -- | Coercion Variable Environment
426 type CoVarEnv elt = VarEnv elt
427
428 emptyVarEnv :: VarEnv a
429 mkVarEnv :: [(Var, a)] -> VarEnv a
430 mkVarEnv_Directly :: [(Unique, a)] -> VarEnv a
431 zipVarEnv :: [Var] -> [a] -> VarEnv a
432 unitVarEnv :: Var -> a -> VarEnv a
433 alterVarEnv :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a
434 extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
435 extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
436 extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b
437 extendVarEnv_Directly :: VarEnv a -> Unique -> a -> VarEnv a
438 plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
439 plusVarEnvList :: [VarEnv a] -> VarEnv a
440 extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
441
442 lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a
443 filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
444 delVarEnv_Directly :: VarEnv a -> Unique -> VarEnv a
445 partitionVarEnv :: (a -> Bool) -> VarEnv a -> (VarEnv a, VarEnv a)
446 restrictVarEnv :: VarEnv a -> VarSet -> VarEnv a
447 delVarEnvList :: VarEnv a -> [Var] -> VarEnv a
448 delVarEnv :: VarEnv a -> Var -> VarEnv a
449 minusVarEnv :: VarEnv a -> VarEnv b -> VarEnv a
450 intersectsVarEnv :: VarEnv a -> VarEnv a -> Bool
451 plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
452 plusVarEnv_CD :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a
453 plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a
454 mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
455 modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a
456
457 isEmptyVarEnv :: VarEnv a -> Bool
458 lookupVarEnv :: VarEnv a -> Var -> Maybe a
459 filterVarEnv :: (a -> Bool) -> VarEnv a -> VarEnv a
460 lookupVarEnv_NF :: VarEnv a -> Var -> a
461 lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
462 elemVarEnv :: Var -> VarEnv a -> Bool
463 elemVarEnvByKey :: Unique -> VarEnv a -> Bool
464 disjointVarEnv :: VarEnv a -> VarEnv a -> Bool
465
466 elemVarEnv = elemUFM
467 elemVarEnvByKey = elemUFM_Directly
468 disjointVarEnv = disjointUFM
469 alterVarEnv = alterUFM
470 extendVarEnv = addToUFM
471 extendVarEnv_C = addToUFM_C
472 extendVarEnv_Acc = addToUFM_Acc
473 extendVarEnv_Directly = addToUFM_Directly
474 extendVarEnvList = addListToUFM
475 plusVarEnv_C = plusUFM_C
476 plusVarEnv_CD = plusUFM_CD
477 plusMaybeVarEnv_C = plusMaybeUFM_C
478 delVarEnvList = delListFromUFM
479 delVarEnv = delFromUFM
480 minusVarEnv = minusUFM
481 intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))
482 plusVarEnv = plusUFM
483 plusVarEnvList = plusUFMList
484 lookupVarEnv = lookupUFM
485 filterVarEnv = filterUFM
486 lookupWithDefaultVarEnv = lookupWithDefaultUFM
487 mapVarEnv = mapUFM
488 mkVarEnv = listToUFM
489 mkVarEnv_Directly= listToUFM_Directly
490 emptyVarEnv = emptyUFM
491 unitVarEnv = unitUFM
492 isEmptyVarEnv = isNullUFM
493 lookupVarEnv_Directly = lookupUFM_Directly
494 filterVarEnv_Directly = filterUFM_Directly
495 delVarEnv_Directly = delFromUFM_Directly
496 partitionVarEnv = partitionUFM
497
498 restrictVarEnv env vs = filterVarEnv_Directly keep env
499 where
500 keep u _ = u `elemVarSetByKey` vs
501
502 zipVarEnv tyvars tys = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
503 lookupVarEnv_NF env id = case lookupVarEnv env id of
504 Just xx -> xx
505 Nothing -> panic "lookupVarEnv_NF: Nothing"
506
507 {-
508 @modifyVarEnv@: Look up a thing in the VarEnv,
509 then mash it with the modify function, and put it back.
510 -}
511
512 modifyVarEnv mangle_fn env key
513 = case (lookupVarEnv env key) of
514 Nothing -> env
515 Just xx -> extendVarEnv env key (mangle_fn xx)
516
517 modifyVarEnv_Directly :: (a -> a) -> UniqFM a -> Unique -> UniqFM a
518 modifyVarEnv_Directly mangle_fn env key
519 = case (lookupUFM_Directly env key) of
520 Nothing -> env
521 Just xx -> addToUFM_Directly env key (mangle_fn xx)
522
523 -- Deterministic VarEnv
524 -- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
525 -- DVarEnv.
526
527 -- | Deterministic Variable Environment
528 type DVarEnv elt = UniqDFM elt
529
530 -- | Deterministic Identifier Environment
531 type DIdEnv elt = DVarEnv elt
532
533 -- | Deterministic Type Variable Environment
534 type DTyVarEnv elt = DVarEnv elt
535
536 emptyDVarEnv :: DVarEnv a
537 emptyDVarEnv = emptyUDFM
538
539 dVarEnvElts :: DVarEnv a -> [a]
540 dVarEnvElts = eltsUDFM
541
542 mkDVarEnv :: [(Var, a)] -> DVarEnv a
543 mkDVarEnv = listToUDFM
544
545 extendDVarEnv :: DVarEnv a -> Var -> a -> DVarEnv a
546 extendDVarEnv = addToUDFM
547
548 minusDVarEnv :: DVarEnv a -> DVarEnv a' -> DVarEnv a
549 minusDVarEnv = minusUDFM
550
551 lookupDVarEnv :: DVarEnv a -> Var -> Maybe a
552 lookupDVarEnv = lookupUDFM
553
554 foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
555 foldDVarEnv = foldUDFM
556
557 mapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b
558 mapDVarEnv = mapUDFM
559
560 filterDVarEnv :: (a -> Bool) -> DVarEnv a -> DVarEnv a
561 filterDVarEnv = filterUDFM
562
563 alterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a
564 alterDVarEnv = alterUDFM
565
566 plusDVarEnv :: DVarEnv a -> DVarEnv a -> DVarEnv a
567 plusDVarEnv = plusUDFM
568
569 plusDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> DVarEnv a -> DVarEnv a
570 plusDVarEnv_C = plusUDFM_C
571
572 unitDVarEnv :: Var -> a -> DVarEnv a
573 unitDVarEnv = unitUDFM
574
575 delDVarEnv :: DVarEnv a -> Var -> DVarEnv a
576 delDVarEnv = delFromUDFM
577
578 delDVarEnvList :: DVarEnv a -> [Var] -> DVarEnv a
579 delDVarEnvList = delListFromUDFM
580
581 isEmptyDVarEnv :: DVarEnv a -> Bool
582 isEmptyDVarEnv = isNullUDFM
583
584 elemDVarEnv :: Var -> DVarEnv a -> Bool
585 elemDVarEnv = elemUDFM
586
587 extendDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> Var -> a -> DVarEnv a
588 extendDVarEnv_C = addToUDFM_C
589
590 modifyDVarEnv :: (a -> a) -> DVarEnv a -> Var -> DVarEnv a
591 modifyDVarEnv mangle_fn env key
592 = case (lookupDVarEnv env key) of
593 Nothing -> env
594 Just xx -> extendDVarEnv env key (mangle_fn xx)
595
596 partitionDVarEnv :: (a -> Bool) -> DVarEnv a -> (DVarEnv a, DVarEnv a)
597 partitionDVarEnv = partitionUDFM
598
599 extendDVarEnvList :: DVarEnv a -> [(Var, a)] -> DVarEnv a
600 extendDVarEnvList = addListToUDFM
601
602 anyDVarEnv :: (a -> Bool) -> DVarEnv a -> Bool
603 anyDVarEnv = anyUDFM