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, 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 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
 106 delSubstEnvList :: SubstEnv -> [Var] -> SubstEnv
 107 delSubstEnvList (SE s nt) vs = SE (delVarEnvList s vs) nt
 108 \end{code}
 109
 110
 111 %************************************************************************
 112 %*                                                                      *
 113 \subsection{@VarEnv@s}
 114 %*                                                                      *
 115 %************************************************************************
 116
 117 \begin{code}
 118 type VarEnv elt   = UniqFM elt
 119 type IdEnv elt    = VarEnv elt
 120 type TyVarEnv elt = VarEnv elt
 121
 122 emptyVarEnv       :: VarEnv a
 123 mkVarEnv          :: [(Var, a)] -> VarEnv a
 124 zipVarEnv         :: [Var] -> [a] -> VarEnv a
 125 unitVarEnv        :: Var -> a -> VarEnv a
 126 extendVarEnv      :: VarEnv a -> Var -> a -> VarEnv a
 127 plusVarEnv        :: VarEnv a -> VarEnv a -> VarEnv a
 128 extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a
 129
 130 delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a
 131 delVarEnv         :: VarEnv a -> Var -> VarEnv a
 132 plusVarEnv_C      :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
 133 mapVarEnv         :: (a -> b) -> VarEnv a -> VarEnv b
 134 modifyVarEnv      :: (a -> a) -> VarEnv a -> Var -> VarEnv a
 135 rngVarEnv         :: VarEnv a -> [a]
 136
 137 isEmptyVarEnv     :: VarEnv a -> Bool
 138 lookupVarEnv      :: VarEnv a -> Var -> Maybe a
 139 lookupVarEnv_NF   :: VarEnv a -> Var -> a
 140 lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
 141 elemVarEnv        :: Var -> VarEnv a -> Bool
 142 foldVarEnv        :: (a -> b -> b) -> b -> VarEnv a -> b
 143 \end{code}
 144
 145 \begin{code}
 146 elemVarEnv       = elemUFM
 147 extendVarEnv     = addToUFM
 148 extendVarEnvList = addListToUFM
 149 plusVarEnv_C     = plusUFM_C
 150 delVarEnvList    = delListFromUFM
 151 delVarEnv        = delFromUFM
 152 plusVarEnv       = plusUFM
 153 lookupVarEnv     = lookupUFM
 154 lookupWithDefaultVarEnv = lookupWithDefaultUFM
 155 mapVarEnv        = mapUFM
 156 mkVarEnv         = listToUFM
 157 emptyVarEnv      = emptyUFM
 158 rngVarEnv        = eltsUFM
 159 unitVarEnv       = unitUFM
 160 isEmptyVarEnv    = isNullUFM
 161 foldVarEnv       = foldUFM
 162
 163 zipVarEnv tyvars tys       = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
 164 lookupVarEnv_NF env id     = case (lookupVarEnv env id) of { Just xx -> xx }
 165 \end{code}
 166
 167 @modifyVarEnv@: Look up a thing in the VarEnv,
 168 then mash it with the modify function, and put it back.
 169
 170 \begin{code}
 171 modifyVarEnv mangle_fn env key
 172   = case (lookupVarEnv env key) of
 173       Nothing -> env
 174       Just xx -> extendVarEnv env key (mangle_fn xx)
 175
 176 modifyVarEnv_Directly mangle_fn env key
 177   = case (lookupUFM_Directly env key) of
 178       Nothing -> env
 179       Just xx -> addToUFM_Directly env key (mangle_fn xx)
 180 \end{code}