ghc/compiler/basicTypes/VarEnv.lhs

   1
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section{@VarEnvs@: Variable environments}
   5
   6 \begin{code}
   7 module VarEnv (
   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,
  15         mapVarEnv, zipVarEnv,
  16         modifyVarEnv, modifyVarEnv_Directly,
  17         isEmptyVarEnv, foldVarEnv,
  18         lookupVarEnv_Directly,
  19         filterVarEnv_Directly,
  20
  21         -- InScopeSet
  22         InScopeSet, emptyInScopeSet, mkInScopeSet, delInScopeSet,
  23         extendInScopeSet, extendInScopeSetList, modifyInScopeSet,
  24         getInScopeVars, lookupInScope, elemInScopeSet, uniqAway,
  25
  26         -- TidyEnvs
  27         TidyEnv, emptyTidyEnv
  28     ) where
  29
  30 #include "HsVersions.h"
  31
  32 import OccName    ( TidyOccEnv, emptyTidyOccEnv )
  33 import Var        ( Var, setVarUnique )
  34 import VarSet
  35 import UniqFM
  36 import Unique     ( Unique, deriveUnique, getUnique )
  37 import Util       ( zipEqual )
  38 import CmdLineOpts      ( opt_PprStyle_Debug )
  39 import Outputable
  40 import FastTypes
  41 \end{code}
  42
  43
  44 %************************************************************************
  45 %*                                                                      *
  46                 In-scope sets
  47 %*                                                                      *
  48 %************************************************************************
  49
  50 \begin{code}
  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
  55
  56 instance Outputable InScopeSet where
  57   ppr (InScope s i) = ptext SLIT("InScope") <+> ppr s
  58
  59 emptyInScopeSet :: InScopeSet
  60 emptyInScopeSet = InScope emptyVarSet 1#
  61
  62 getInScopeVars ::  InScopeSet -> VarEnv Var
  63 getInScopeVars (InScope vs _) = vs
  64
  65 mkInScopeSet :: VarEnv Var -> InScopeSet
  66 mkInScopeSet in_scope = InScope in_scope 1#
  67
  68 extendInScopeSet :: InScopeSet -> Var -> InScopeSet
  69 extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# 1#)
  70
  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))
  75
  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#)
  80
  81 delInScopeSet :: InScopeSet -> Var -> InScopeSet
  82 delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
  83
  84 elemInScopeSet :: Var -> InScopeSet -> Bool
  85 elemInScopeSet v (InScope in_scope n) = v `elemVarEnv` in_scope
  86
  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
  94   = go v
  95   where
  96     go v = case lookupVarEnv in_scope v of
  97                 Just v' | v == v'   -> Just v'  -- Reached a fixed point
  98                         | otherwise -> go v'
  99                 Nothing             -> Nothing
 100 \end{code}
 101
 102 \begin{code}
 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
 110   | otherwise                  = try 1#
 111   where
 112     orig_unique = getUnique var
 113     try k
 114 #ifdef DEBUG
 115           | k ># 1000#
 116           = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
 117 #endif
 118           | uniq `elemVarSetByKey` set = try (k +# 1#)
 119 #ifdef DEBUG
 120           | opt_PprStyle_Debug && k ># 3#
 121           = pprTrace "uniqAway:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
 122             setVarUnique var uniq
 123 #endif
 124           | otherwise = setVarUnique var uniq
 125           where
 126             uniq = deriveUnique orig_unique (iBox (n *# k))
 127 \end{code}
 128
 129
 130 %************************************************************************
 131 %*                                                                      *
 132                 Tidying
 133 %*                                                                      *
 134 %************************************************************************
 135
 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.
 138
 139 \begin{code}
 140 type TidyEnv = (TidyOccEnv, VarEnv Var)
 141
 142 emptyTidyEnv :: TidyEnv
 143 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
 144 \end{code}
 145
 146
 147 %************************************************************************
 148 %*                                                                      *
 149 \subsection{@VarEnv@s}
 150 %*                                                                      *
 151 %************************************************************************
 152
 153 \begin{code}
 154 type VarEnv elt   = UniqFM elt
 155 type IdEnv elt    = VarEnv elt
 156 type TyVarEnv elt = VarEnv elt
 157
 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
 166
 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]
 175
 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
 182 \end{code}
 183
 184 \begin{code}
 185 elemVarEnv       = elemUFM
 186 extendVarEnv     = addToUFM
 187 extendVarEnv_C   = addToUFM_C
 188 extendVarEnvList = addListToUFM
 189 plusVarEnv_C     = plusUFM_C
 190 delVarEnvList    = delListFromUFM
 191 delVarEnv        = delFromUFM
 192 plusVarEnv       = plusUFM
 193 lookupVarEnv     = lookupUFM
 194 lookupWithDefaultVarEnv = lookupWithDefaultUFM
 195 mapVarEnv        = mapUFM
 196 mkVarEnv         = listToUFM
 197 emptyVarEnv      = emptyUFM
 198 varEnvElts       = eltsUFM
 199 unitVarEnv       = unitUFM
 200 isEmptyVarEnv    = isNullUFM
 201 foldVarEnv       = foldUFM
 202 lookupVarEnv_Directly = lookupUFM_Directly
 203 filterVarEnv_Directly = filterUFM_Directly
 204
 205 zipVarEnv tyvars tys       = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
 206 lookupVarEnv_NF env id     = case (lookupVarEnv env id) of { Just xx -> xx }
 207 \end{code}
 208
 209 @modifyVarEnv@: Look up a thing in the VarEnv,
 210 then mash it with the modify function, and put it back.
 211
 212 \begin{code}
 213 modifyVarEnv mangle_fn env key
 214   = case (lookupVarEnv env key) of
 215       Nothing -> env
 216       Just xx -> extendVarEnv env key (mangle_fn xx)
 217
 218 modifyVarEnv_Directly mangle_fn env key
 219   = case (lookupUFM_Directly env key) of
 220       Nothing -> env
 221       Just xx -> addToUFM_Directly env key (mangle_fn xx)
 222 \end{code}