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, 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,
  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 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
  54 \end{code}
  55
  56
  57 %************************************************************************
  58 %*                                                                      *
  59 \subsection{Substitution environments}
  60 %*                                                                      *
  61 %************************************************************************
  62
  63 \begin{code}
  64
  65 noTys :: SubstResult -> Bool -> Bool
  66 noTys (DoneTy ty) no_tys = False
  67 noTys other       no_tys = no_tys
  68
  69 data SubstEnv      = SE (VarEnv SubstResult)
  70                         Bool            -- True => definitely no type substitutions in the env
  71
  72 noTypeSubst :: SubstEnv -> Bool
  73 noTypeSubst (SE _ nt) = nt
  74
  75 substEnvEnv :: SubstEnv -> VarEnv SubstResult
  76 substEnvEnv (SE env _) = env
  77
  78 type TyVarSubstEnv = SubstEnv   -- of the form (DoneTy ty) *only*
  79
  80 data SubstResult
  81   = DoneEx CoreExpr             -- Completed term
  82   | DoneId Id OccInfo           -- Completed term variable, with occurrence info; only
  83                                 -- used by the simplifier
  84   | DoneTy Type                 -- Completed type
  85   | ContEx SubstEnv CoreExpr    -- A suspended substitution
  86
  87 emptySubstEnv :: SubstEnv
  88 emptySubstEnv = SE emptyVarEnv True
  89
  90 isEmptySubstEnv :: SubstEnv -> Bool
  91 isEmptySubstEnv (SE s _) = isEmptyVarEnv s
  92
  93 lookupSubstEnv :: SubstEnv -> Var -> Maybe SubstResult
  94 lookupSubstEnv (SE s _) v = lookupVarEnv s v
  95
  96 extendSubstEnv :: SubstEnv -> Var -> SubstResult -> SubstEnv
  97 extendSubstEnv (SE s nt) v r = SE (extendVarEnv s v r) (noTys r nt)
  98
  99 mkSubstEnv :: [Var] -> [SubstResult] -> SubstEnv
 100 mkSubstEnv bs vs = extendSubstEnvList emptySubstEnv bs vs
 101
 102 extendSubstEnvList :: SubstEnv -> [Var] -> [SubstResult] -> SubstEnv
 103 extendSubstEnvList env         []     []     = env
 104 extendSubstEnvList (SE env nt) (b:bs) (r:rs) = extendSubstEnvList (SE (extendVarEnv env b r) (noTys r nt)) bs rs
 105
 106 delSubstEnv :: SubstEnv -> Var -> SubstEnv
 107 delSubstEnv (SE s nt) v = SE (delVarEnv s v) nt
 108
 109 delSubstEnvList :: SubstEnv -> [Var] -> SubstEnv
 110 delSubstEnvList (SE s nt) vs = SE (delVarEnvList s vs) nt
 111 \end{code}
 112
 113
 114 %************************************************************************
 115 %*                                                                      *
 116 \subsection{@VarEnv@s}
 117 %*                                                                      *
 118 %************************************************************************
 119
 120 \begin{code}
 121 type VarEnv elt   = UniqFM elt
 122 type IdEnv elt    = VarEnv elt
 123 type TyVarEnv elt = VarEnv elt
 124
 125 emptyVarEnv       :: VarEnv a
 126 mkVarEnv          :: [(Var, a)] -> VarEnv a
 127 zipVarEnv         :: [Var] -> [a] -> VarEnv a
 128 unitVarEnv        :: Var -> a -> VarEnv a
 129 extendVarEnv      :: VarEnv a -> Var -> a -> VarEnv a
 130 plusVarEnv        :: VarEnv a -> VarEnv a -> VarEnv a
 131 extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a
 132
 133 delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a
 134 delVarEnv         :: VarEnv a -> Var -> VarEnv a
 135 plusVarEnv_C      :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
 136 mapVarEnv         :: (a -> b) -> VarEnv a -> VarEnv b
 137 modifyVarEnv      :: (a -> a) -> VarEnv a -> Var -> VarEnv a
 138 rngVarEnv         :: VarEnv a -> [a]
 139
 140 isEmptyVarEnv     :: VarEnv a -> Bool
 141 lookupVarEnv      :: VarEnv a -> Var -> Maybe a
 142 lookupVarEnv_NF   :: VarEnv a -> Var -> a
 143 lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
 144 elemVarEnv        :: Var -> VarEnv a -> Bool
 145 foldVarEnv        :: (a -> b -> b) -> b -> VarEnv a -> b
 146 \end{code}
 147
 148 \begin{code}
 149 elemVarEnv       = elemUFM
 150 extendVarEnv     = addToUFM
 151 extendVarEnvList = addListToUFM
 152 plusVarEnv_C     = plusUFM_C
 153 delVarEnvList    = delListFromUFM
 154 delVarEnv        = delFromUFM
 155 plusVarEnv       = plusUFM
 156 lookupVarEnv     = lookupUFM
 157 lookupWithDefaultVarEnv = lookupWithDefaultUFM
 158 mapVarEnv        = mapUFM
 159 mkVarEnv         = listToUFM
 160 emptyVarEnv      = emptyUFM
 161 rngVarEnv        = eltsUFM
 162 unitVarEnv       = unitUFM
 163 isEmptyVarEnv    = isNullUFM
 164 foldVarEnv       = foldUFM
 165
 166 zipVarEnv tyvars tys       = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
 167 lookupVarEnv_NF env id     = case (lookupVarEnv env id) of { Just xx -> xx }
 168 \end{code}
 169
 170 @modifyVarEnv@: Look up a thing in the VarEnv,
 171 then mash it with the modify function, and put it back.
 172
 173 \begin{code}
 174 modifyVarEnv mangle_fn env key
 175   = case (lookupVarEnv env key) of
 176       Nothing -> env
 177       Just xx -> extendVarEnv env key (mangle_fn xx)
 178
 179 modifyVarEnv_Directly mangle_fn env key
 180   = case (lookupUFM_Directly env key) of
 181       Nothing -> env
 182       Just xx -> addToUFM_Directly env key (mangle_fn xx)
 183 \end{code}