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