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(..), emptySubstEnv,
  24         mkSubstEnv, lookupSubstEnv, extendSubstEnv, extendSubstEnvList,
  25         delSubstEnv, noTypeSubst, isEmptySubstEnv
  26     ) where
  27
  28 #include "HsVersions.h"
  29
  30 import {-# SOURCE #-}   CoreSyn( CoreExpr )
  31 import {-# SOURCE #-}   TypeRep( Type )
  32
  33 import OccName  ( TidyOccEnv, emptyTidyOccEnv )
  34 import Var      ( Var, Id, IdOrTyVar )
  35 import UniqFM
  36 import Util     ( zipEqual )
  37 \end{code}
  38
  39
  40 %************************************************************************
  41 %*                                                                      *
  42 \subsection{Tidying}
  43 %*                                                                      *
  44 %************************************************************************
  45
  46 When tidying up print names, we keep a mapping of in-scope occ-names
  47 (the TidyOccEnv) and a Var-to-Var of the current renamings.
  48
  49 \begin{code}
  50 type TidyEnv = (TidyOccEnv, VarEnv IdOrTyVar)
  51 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
  52 \end{code}
  53
  54
  55 %************************************************************************
  56 %*                                                                      *
  57 \subsection{Substitution environments}
  58 %*                                                                      *
  59 %************************************************************************
  60
  61 \begin{code}
  62
  63 noTys :: SubstResult -> Bool -> Bool
  64 noTys (DoneTy ty) no_tys = False
  65 noTys other       no_tys = no_tys
  66
  67 data SubstEnv      = SE (VarEnv SubstResult)
  68                         Bool            -- True => definitely no type substitutions in the env
  69
  70 noTypeSubst :: SubstEnv -> Bool
  71 noTypeSubst (SE _ nt) = nt
  72
  73 type TyVarSubstEnv = SubstEnv   -- of the form (DoneTy ty) *only*
  74
  75 data SubstResult
  76   = DoneEx CoreExpr             -- Completed term
  77   | DoneTy Type                 -- Completed type
  78   | ContEx SubstEnv CoreExpr    -- A suspended substitution
  79
  80 emptySubstEnv :: SubstEnv
  81 emptySubstEnv = SE emptyVarEnv True
  82
  83 isEmptySubstEnv :: SubstEnv -> Bool
  84 isEmptySubstEnv (SE s _) = isEmptyVarEnv s
  85
  86 lookupSubstEnv :: SubstEnv -> Var -> Maybe SubstResult
  87 lookupSubstEnv (SE s _) v = lookupVarEnv s v
  88
  89 extendSubstEnv :: SubstEnv -> Var -> SubstResult -> SubstEnv
  90 extendSubstEnv (SE s nt) v r = SE (extendVarEnv s v r) (noTys r nt)
  91
  92 mkSubstEnv :: [IdOrTyVar] -> [SubstResult] -> SubstEnv
  93 mkSubstEnv bs vs = extendSubstEnvList emptySubstEnv bs vs
  94
  95 extendSubstEnvList :: SubstEnv -> [IdOrTyVar] -> [SubstResult] -> SubstEnv
  96 extendSubstEnvList env         []     []     = env
  97 extendSubstEnvList (SE env nt) (b:bs) (r:rs) = extendSubstEnvList (SE (extendVarEnv env b r) (noTys r nt)) bs rs
  98
  99 delSubstEnv :: SubstEnv -> IdOrTyVar -> SubstEnv
 100 delSubstEnv (SE s nt) v = SE (delVarEnv s v) nt
 101 \end{code}
 102
 103
 104 %************************************************************************
 105 %*                                                                      *
 106 \subsection{@VarEnv@s}
 107 %*                                                                      *
 108 %************************************************************************
 109
 110 \begin{code}
 111 type VarEnv elt   = UniqFM elt
 112 type IdEnv elt    = VarEnv elt
 113 type TyVarEnv elt = VarEnv elt
 114
 115 emptyVarEnv       :: VarEnv a
 116 mkVarEnv          :: [(Var, a)] -> VarEnv a
 117 zipVarEnv         :: [Var] -> [a] -> VarEnv a
 118 unitVarEnv        :: Var -> a -> VarEnv a
 119 extendVarEnv      :: VarEnv a -> Var -> a -> VarEnv a
 120 plusVarEnv        :: VarEnv a -> VarEnv a -> VarEnv a
 121 extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a
 122
 123 delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a
 124 delVarEnv         :: VarEnv a -> Var -> VarEnv a
 125 plusVarEnv_C      :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
 126 mapVarEnv         :: (a -> b) -> VarEnv a -> VarEnv b
 127 modifyVarEnv      :: (a -> a) -> VarEnv a -> Var -> VarEnv a
 128 rngVarEnv         :: VarEnv a -> [a]
 129
 130 isEmptyVarEnv     :: VarEnv a -> Bool
 131 lookupVarEnv      :: VarEnv a -> Var -> Maybe a
 132 lookupVarEnv_NF   :: VarEnv a -> Var -> a
 133 lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
 134 elemVarEnv        :: Var -> VarEnv a -> Bool
 135 foldVarEnv        :: (a -> b -> b) -> b -> VarEnv a -> b
 136 \end{code}
 137
 138 \begin{code}
 139 elemVarEnv       = elemUFM
 140 extendVarEnv     = addToUFM
 141 plusVarEnv_C     = plusUFM_C
 142 delVarEnvList    = delListFromUFM
 143 delVarEnv        = delFromUFM
 144 plusVarEnv       = plusUFM
 145 lookupVarEnv     = lookupUFM
 146 lookupWithDefaultVarEnv = lookupWithDefaultUFM
 147 mapVarEnv        = mapUFM
 148 mkVarEnv         = listToUFM
 149 emptyVarEnv      = emptyUFM
 150 rngVarEnv        = eltsUFM
 151 unitVarEnv       = unitUFM
 152 isEmptyVarEnv    = isNullUFM
 153 foldVarEnv       = foldUFM
 154
 155 zipVarEnv tyvars tys       = listToUFM (zipEqual "zipVarEnv" tyvars tys)
 156 extendVarEnvList env pairs = plusUFM env (listToUFM pairs)
 157 lookupVarEnv_NF env id     = case (lookupVarEnv env id) of { Just xx -> xx }
 158 \end{code}
 159
 160 @modifyVarEnv@: Look up a thing in the VarEnv,
 161 then mash it with the modify function, and put it back.
 162
 163 \begin{code}
 164 modifyVarEnv mangle_fn env key
 165   = case (lookupVarEnv env key) of
 166       Nothing -> env
 167       Just xx -> extendVarEnv env key (mangle_fn xx)
 168
 169 modifyVarEnv_Directly mangle_fn env key
 170   = case (lookupUFM_Directly env key) of
 171       Nothing -> env
 172       Just xx -> addToUFM_Directly env key (mangle_fn xx)
 173 \end{code}