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,
  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 extendVarEnv_C    :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
 131 plusVarEnv        :: VarEnv a -> VarEnv a -> VarEnv a
 132 extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a
 133
 134 delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a
 135 delVarEnv         :: VarEnv a -> Var -> VarEnv a
 136 plusVarEnv_C      :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
 137 mapVarEnv         :: (a -> b) -> VarEnv a -> VarEnv b
 138 modifyVarEnv      :: (a -> a) -> VarEnv a -> Var -> VarEnv a
 139 rngVarEnv         :: VarEnv a -> [a]
 140
 141 isEmptyVarEnv     :: VarEnv a -> Bool
 142 lookupVarEnv      :: VarEnv a -> Var -> Maybe a
 143 lookupVarEnv_NF   :: VarEnv a -> Var -> a
 144 lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
 145 elemVarEnv        :: Var -> VarEnv a -> Bool
 146 foldVarEnv        :: (a -> b -> b) -> b -> VarEnv a -> b
 147 \end{code}
 148
 149 \begin{code}
 150 elemVarEnv       = elemUFM
 151 extendVarEnv     = addToUFM
 152 extendVarEnv_C   = addToUFM_C
 153 extendVarEnvList = addListToUFM
 154 plusVarEnv_C     = plusUFM_C
 155 delVarEnvList    = delListFromUFM
 156 delVarEnv        = delFromUFM
 157 plusVarEnv       = plusUFM
 158 lookupVarEnv     = lookupUFM
 159 lookupWithDefaultVarEnv = lookupWithDefaultUFM
 160 mapVarEnv        = mapUFM
 161 mkVarEnv         = listToUFM
 162 emptyVarEnv      = emptyUFM
 163 rngVarEnv        = eltsUFM
 164 unitVarEnv       = unitUFM
 165 isEmptyVarEnv    = isNullUFM
 166 foldVarEnv       = foldUFM
 167
 168 zipVarEnv tyvars tys       = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
 169 lookupVarEnv_NF env id     = case (lookupVarEnv env id) of { Just xx -> xx }
 170 \end{code}
 171
 172 @modifyVarEnv@: Look up a thing in the VarEnv,
 173 then mash it with the modify function, and put it back.
 174
 175 \begin{code}
 176 modifyVarEnv mangle_fn env key
 177   = case (lookupVarEnv env key) of
 178       Nothing -> env
 179       Just xx -> extendVarEnv env key (mangle_fn xx)
 180
 181 modifyVarEnv_Directly mangle_fn env key
 182   = case (lookupUFM_Directly env key) of
 183       Nothing -> env
 184       Just xx -> addToUFM_Directly env key (mangle_fn xx)
 185 \end{code}