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