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, rngVarEnv,
  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
  19         -- TidyEnvs
  20         TidyEnv, emptyTidyEnv,
  21
  22         -- SubstEnvs
  23         SubstEnv, TyVarSubstEnv, SubstResult(..),
  24         emptySubstEnv, substEnvEnv, elemSubstEnv,
  25         mkSubstEnv, lookupSubstEnv, extendSubstEnv, extendSubstEnvList,
  26         delSubstEnv, delSubstEnvList, noTypeSubst, isEmptySubstEnv
  27     ) where
  28
  29 #include "HsVersions.h"
  30
  31 import {-# SOURCE #-}   CoreSyn( CoreExpr )
  32 import {-# SOURCE #-}   TypeRep( Type )
  33
  34 import BasicTypes ( OccInfo )
  35 import OccName    ( TidyOccEnv, emptyTidyOccEnv )
  36 import Var        ( Var, Id )
  37 import UniqFM
  38 import Util       ( zipEqual )
  39 \end{code}
  40
  41
  42 %************************************************************************
  43 %*                                                                      *
  44 \subsection{Tidying}
  45 %*                                                                      *
  46 %************************************************************************
  47
  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.
  50
  51 \begin{code}
  52 type TidyEnv = (TidyOccEnv, VarEnv Var)
  53
  54 emptyTidyEnv :: TidyEnv
  55 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
  56 \end{code}
  57
  58
  59 %************************************************************************
  60 %*                                                                      *
  61 \subsection{Substitution environments}
  62 %*                                                                      *
  63 %************************************************************************
  64
  65 \begin{code}
  66
  67 noTys :: SubstResult -> Bool -> Bool
  68 noTys (DoneTy ty) no_tys = False
  69 noTys other       no_tys = no_tys
  70
  71 data SubstEnv      = SE (VarEnv SubstResult)
  72                         Bool            -- True => definitely no type substitutions in the env
  73
  74 noTypeSubst :: SubstEnv -> Bool
  75 noTypeSubst (SE _ nt) = nt
  76
  77 substEnvEnv :: SubstEnv -> VarEnv SubstResult
  78 substEnvEnv (SE env _) = env
  79
  80 type TyVarSubstEnv = SubstEnv   -- of the form (DoneTy ty) *only*
  81
  82 data SubstResult
  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
  88
  89 emptySubstEnv :: SubstEnv
  90 emptySubstEnv = SE emptyVarEnv True
  91
  92 isEmptySubstEnv :: SubstEnv -> Bool
  93 isEmptySubstEnv (SE s _) = isEmptyVarEnv s
  94
  95 lookupSubstEnv :: SubstEnv -> Var -> Maybe SubstResult
  96 lookupSubstEnv (SE s _) v = lookupVarEnv s v
  97
  98 elemSubstEnv :: Var -> SubstEnv -> Bool
  99 elemSubstEnv v (SE s _) = elemVarEnv v s
 100
 101 extendSubstEnv :: SubstEnv -> Var -> SubstResult -> SubstEnv
 102 extendSubstEnv (SE s nt) v r = SE (extendVarEnv s v r) (noTys r nt)
 103
 104 mkSubstEnv :: [Var] -> [SubstResult] -> SubstEnv
 105 mkSubstEnv bs vs = extendSubstEnvList emptySubstEnv bs vs
 106
 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
 110
 111 delSubstEnv :: SubstEnv -> Var -> SubstEnv
 112 delSubstEnv (SE s nt) v = SE (delVarEnv s v) nt
 113
 114 delSubstEnvList :: SubstEnv -> [Var] -> SubstEnv
 115 delSubstEnvList (SE s nt) vs = SE (delVarEnvList s vs) nt
 116 \end{code}
 117
 118
 119 %************************************************************************
 120 %*                                                                      *
 121 \subsection{@VarEnv@s}
 122 %*                                                                      *
 123 %************************************************************************
 124
 125 \begin{code}
 126 type VarEnv elt   = UniqFM elt
 127 type IdEnv elt    = VarEnv elt
 128 type TyVarEnv elt = VarEnv elt
 129
 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
 138
 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]
 145
 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
 152 \end{code}
 153
 154 \begin{code}
 155 elemVarEnv       = elemUFM
 156 extendVarEnv     = addToUFM
 157 extendVarEnv_C   = addToUFM_C
 158 extendVarEnvList = addListToUFM
 159 plusVarEnv_C     = plusUFM_C
 160 delVarEnvList    = delListFromUFM
 161 delVarEnv        = delFromUFM
 162 plusVarEnv       = plusUFM
 163 lookupVarEnv     = lookupUFM
 164 lookupWithDefaultVarEnv = lookupWithDefaultUFM
 165 mapVarEnv        = mapUFM
 166 mkVarEnv         = listToUFM
 167 emptyVarEnv      = emptyUFM
 168 rngVarEnv        = eltsUFM
 169 unitVarEnv       = unitUFM
 170 isEmptyVarEnv    = isNullUFM
 171 foldVarEnv       = foldUFM
 172
 173 zipVarEnv tyvars tys       = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
 174 lookupVarEnv_NF env id     = case (lookupVarEnv env id) of { Just xx -> xx }
 175 \end{code}
 176
 177 @modifyVarEnv@: Look up a thing in the VarEnv,
 178 then mash it with the modify function, and put it back.
 179
 180 \begin{code}
 181 modifyVarEnv mangle_fn env key
 182   = case (lookupVarEnv env key) of
 183       Nothing -> env
 184       Just xx -> extendVarEnv env key (mangle_fn xx)
 185
 186 modifyVarEnv_Directly mangle_fn env key
 187   = case (lookupUFM_Directly env key) of
 188       Nothing -> env
 189       Just xx -> addToUFM_Directly env key (mangle_fn xx)
 190 \end{code}