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, rngVarEnv,
11 extendVarEnv, extendVarEnv_C, extendVarEnvList,
12 plusVarEnv, plusVarEnv_C,
13 delVarEnvList, delVarEnv,
14 lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
16 modifyVarEnv, modifyVarEnv_Directly,
17 isEmptyVarEnv, foldVarEnv,
20 TidyEnv, emptyTidyEnv,
23 SubstEnv, TyVarSubstEnv, SubstResult(..),
24 emptySubstEnv, substEnvEnv, elemSubstEnv,
25 mkSubstEnv, lookupSubstEnv, extendSubstEnv, extendSubstEnvList,
26 delSubstEnv, delSubstEnvList, noTypeSubst, isEmptySubstEnv
29 #include "HsVersions.h"
31 import {-# SOURCE #-} CoreSyn( CoreExpr )
32 import {-# SOURCE #-} TypeRep( Type )
34 import BasicTypes ( OccInfo )
35 import OccName ( TidyOccEnv, emptyTidyOccEnv )
36 import Var ( Var, Id )
38 import Util ( zipEqual )
42 %************************************************************************
46 %************************************************************************
48 When tidying up print names, we keep a mapping of in-scope occ-names
49 (the TidyOccEnv) and a Var-to-Var of the current renamings.
52 type TidyEnv = (TidyOccEnv, VarEnv Var)
54 emptyTidyEnv :: TidyEnv
55 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
59 %************************************************************************
61 \subsection{Substitution environments}
63 %************************************************************************
67 noTys :: SubstResult -> Bool -> Bool
68 noTys (DoneTy ty) no_tys = False
69 noTys other no_tys = no_tys
71 data SubstEnv = SE (VarEnv SubstResult)
72 Bool -- True => definitely no type substitutions in the env
74 noTypeSubst :: SubstEnv -> Bool
75 noTypeSubst (SE _ nt) = nt
77 substEnvEnv :: SubstEnv -> VarEnv SubstResult
78 substEnvEnv (SE env _) = env
80 type TyVarSubstEnv = SubstEnv -- of the form (DoneTy ty) *only*
83 = DoneEx CoreExpr -- Completed term
84 | DoneId Id OccInfo -- Completed term variable, with occurrence info; only
85 -- used by the simplifier
86 | DoneTy Type -- Completed type
87 | ContEx SubstEnv CoreExpr -- A suspended substitution
89 emptySubstEnv :: SubstEnv
90 emptySubstEnv = SE emptyVarEnv True
92 isEmptySubstEnv :: SubstEnv -> Bool
93 isEmptySubstEnv (SE s _) = isEmptyVarEnv s
95 lookupSubstEnv :: SubstEnv -> Var -> Maybe SubstResult
96 lookupSubstEnv (SE s _) v = lookupVarEnv s v
98 elemSubstEnv :: Var -> SubstEnv -> Bool
99 elemSubstEnv v (SE s _) = elemVarEnv v s
101 extendSubstEnv :: SubstEnv -> Var -> SubstResult -> SubstEnv
102 extendSubstEnv (SE s nt) v r = SE (extendVarEnv s v r) (noTys r nt)
104 mkSubstEnv :: [Var] -> [SubstResult] -> SubstEnv
105 mkSubstEnv bs vs = extendSubstEnvList emptySubstEnv bs vs
107 extendSubstEnvList :: SubstEnv -> [Var] -> [SubstResult] -> SubstEnv
108 extendSubstEnvList env [] [] = env
109 extendSubstEnvList (SE env nt) (b:bs) (r:rs) = extendSubstEnvList (SE (extendVarEnv env b r) (noTys r nt)) bs rs
111 delSubstEnv :: SubstEnv -> Var -> SubstEnv
112 delSubstEnv (SE s nt) v = SE (delVarEnv s v) nt
114 delSubstEnvList :: SubstEnv -> [Var] -> SubstEnv
115 delSubstEnvList (SE s nt) vs = SE (delVarEnvList s vs) nt
119 %************************************************************************
121 \subsection{@VarEnv@s}
123 %************************************************************************
126 type VarEnv elt = UniqFM elt
127 type IdEnv elt = VarEnv elt
128 type TyVarEnv elt = VarEnv elt
130 emptyVarEnv :: VarEnv a
131 mkVarEnv :: [(Var, a)] -> VarEnv a
132 zipVarEnv :: [Var] -> [a] -> VarEnv a
133 unitVarEnv :: Var -> a -> VarEnv a
134 extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
135 extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
136 plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
137 extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
139 delVarEnvList :: VarEnv a -> [Var] -> VarEnv a
140 delVarEnv :: VarEnv a -> Var -> VarEnv a
141 plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
142 mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
143 modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a
144 rngVarEnv :: VarEnv a -> [a]
146 isEmptyVarEnv :: VarEnv a -> Bool
147 lookupVarEnv :: VarEnv a -> Var -> Maybe a
148 lookupVarEnv_NF :: VarEnv a -> Var -> a
149 lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
150 elemVarEnv :: Var -> VarEnv a -> Bool
151 foldVarEnv :: (a -> b -> b) -> b -> VarEnv a -> b
156 extendVarEnv = addToUFM
157 extendVarEnv_C = addToUFM_C
158 extendVarEnvList = addListToUFM
159 plusVarEnv_C = plusUFM_C
160 delVarEnvList = delListFromUFM
161 delVarEnv = delFromUFM
163 lookupVarEnv = lookupUFM
164 lookupWithDefaultVarEnv = lookupWithDefaultUFM
167 emptyVarEnv = emptyUFM
170 isEmptyVarEnv = isNullUFM
173 zipVarEnv tyvars tys = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
174 lookupVarEnv_NF env id = case (lookupVarEnv env id) of { Just xx -> xx }
177 @modifyVarEnv@: Look up a thing in the VarEnv,
178 then mash it with the modify function, and put it back.
181 modifyVarEnv mangle_fn env key
182 = case (lookupVarEnv env key) of
184 Just xx -> extendVarEnv env key (mangle_fn xx)
186 modifyVarEnv_Directly mangle_fn env key
187 = case (lookupUFM_Directly env key) of
189 Just xx -> addToUFM_Directly env key (mangle_fn xx)