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,
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 lookupVarEnv_Directly,
19 filterVarEnv_Directly,
22 InScopeSet, emptyInScopeSet, mkInScopeSet, delInScopeSet,
23 extendInScopeSet, extendInScopeSetList, modifyInScopeSet,
24 getInScopeVars, lookupInScope, elemInScopeSet, uniqAway,
30 #include "HsVersions.h"
32 import OccName ( TidyOccEnv, emptyTidyOccEnv )
33 import Var ( Var, setVarUnique )
36 import Unique ( Unique, deriveUnique, getUnique )
37 import Util ( zipEqual )
38 import CmdLineOpts ( opt_PprStyle_Debug )
44 %************************************************************************
48 %************************************************************************
51 data InScopeSet = InScope (VarEnv Var) FastInt
52 -- The Int# is a kind of hash-value used by uniqAway
53 -- For example, it might be the size of the set
54 -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
56 instance Outputable InScopeSet where
57 ppr (InScope s i) = ptext SLIT("InScope") <+> ppr s
59 emptyInScopeSet :: InScopeSet
60 emptyInScopeSet = InScope emptyVarSet 1#
62 getInScopeVars :: InScopeSet -> VarEnv Var
63 getInScopeVars (InScope vs _) = vs
65 mkInScopeSet :: VarEnv Var -> InScopeSet
66 mkInScopeSet in_scope = InScope in_scope 1#
68 extendInScopeSet :: InScopeSet -> Var -> InScopeSet
69 extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# 1#)
71 extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
72 extendInScopeSetList (InScope in_scope n) vs
73 = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
74 (n +# iUnbox (length vs))
76 modifyInScopeSet :: InScopeSet -> Var -> Var -> InScopeSet
77 -- Exploit the fact that the in-scope "set" is really a map
78 -- Make old_v map to new_v
79 modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_scope old_v new_v) (n +# 1#)
81 delInScopeSet :: InScopeSet -> Var -> InScopeSet
82 delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
84 elemInScopeSet :: Var -> InScopeSet -> Bool
85 elemInScopeSet v (InScope in_scope n) = v `elemVarEnv` in_scope
87 lookupInScope :: InScopeSet -> Var -> Maybe Var
88 -- It's important to look for a fixed point
89 -- When we see (case x of y { I# v -> ... })
90 -- we add [x -> y] to the in-scope set (Simplify.simplCaseBinder).
91 -- When we lookup up an occurrence of x, we map to y, but then
92 -- we want to look up y in case it has acquired more evaluation information by now.
93 lookupInScope (InScope in_scope n) v
96 go v = case lookupVarEnv in_scope v of
97 Just v' | v == v' -> Just v' -- Reached a fixed point
103 uniqAway :: InScopeSet -> Var -> Var
104 -- (uniqAway in_scope v) finds a unique that is not used in the
105 -- in-scope set, and gives that to v. It starts with v's current unique, of course,
106 -- in the hope that it won't have to change it, and thereafter uses a combination
107 -- of that and the hash-code found in the in-scope set
108 uniqAway (InScope set n) var
109 | not (var `elemVarSet` set) = var -- Nothing to do
112 orig_unique = getUnique var
116 = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
118 | uniq `elemVarSetByKey` set = try (k +# 1#)
120 | opt_PprStyle_Debug && k ># 3#
121 = pprTrace "uniqAway:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
122 setVarUnique var uniq
124 | otherwise = setVarUnique var uniq
126 uniq = deriveUnique orig_unique (iBox (n *# k))
130 %************************************************************************
134 %************************************************************************
136 When tidying up print names, we keep a mapping of in-scope occ-names
137 (the TidyOccEnv) and a Var-to-Var of the current renamings.
140 type TidyEnv = (TidyOccEnv, VarEnv Var)
142 emptyTidyEnv :: TidyEnv
143 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
147 %************************************************************************
149 \subsection{@VarEnv@s}
151 %************************************************************************
154 type VarEnv elt = UniqFM elt
155 type IdEnv elt = VarEnv elt
156 type TyVarEnv elt = VarEnv elt
158 emptyVarEnv :: VarEnv a
159 mkVarEnv :: [(Var, a)] -> VarEnv a
160 zipVarEnv :: [Var] -> [a] -> VarEnv a
161 unitVarEnv :: Var -> a -> VarEnv a
162 extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
163 extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
164 plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
165 extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
167 lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a
168 filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
169 delVarEnvList :: VarEnv a -> [Var] -> VarEnv a
170 delVarEnv :: VarEnv a -> Var -> VarEnv a
171 plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
172 mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
173 modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a
174 varEnvElts :: VarEnv a -> [a]
176 isEmptyVarEnv :: VarEnv a -> Bool
177 lookupVarEnv :: VarEnv a -> Var -> Maybe a
178 lookupVarEnv_NF :: VarEnv a -> Var -> a
179 lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
180 elemVarEnv :: Var -> VarEnv a -> Bool
181 foldVarEnv :: (a -> b -> b) -> b -> VarEnv a -> b
186 extendVarEnv = addToUFM
187 extendVarEnv_C = addToUFM_C
188 extendVarEnvList = addListToUFM
189 plusVarEnv_C = plusUFM_C
190 delVarEnvList = delListFromUFM
191 delVarEnv = delFromUFM
193 lookupVarEnv = lookupUFM
194 lookupWithDefaultVarEnv = lookupWithDefaultUFM
197 emptyVarEnv = emptyUFM
200 isEmptyVarEnv = isNullUFM
202 lookupVarEnv_Directly = lookupUFM_Directly
203 filterVarEnv_Directly = filterUFM_Directly
205 zipVarEnv tyvars tys = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
206 lookupVarEnv_NF env id = case (lookupVarEnv env id) of { Just xx -> xx }
209 @modifyVarEnv@: Look up a thing in the VarEnv,
210 then mash it with the modify function, and put it back.
213 modifyVarEnv mangle_fn env key
214 = case (lookupVarEnv env key) of
216 Just xx -> extendVarEnv env key (mangle_fn xx)
218 modifyVarEnv_Directly mangle_fn env key
219 = case (lookupUFM_Directly env key) of
221 Just xx -> addToUFM_Directly env key (mangle_fn xx)