[project @ 2000-10-16 08:24:18 by simonpj]

[ghc-hetmet.git] / ghc / compiler / basicTypes / VarEnv.lhs

diff --git a/ghc/compiler/basicTypes/VarEnv.lhs b/ghc/compiler/basicTypes/VarEnv.lhs
index a103677..03eb4e1 100644 (file)
--- a/ghc/compiler/basicTypes/VarEnv.lhs
+++ b/ghc/compiler/basicTypes/VarEnv.lhs
@@ -21,9 +21,9 @@ module VarEnv (
 
        -- SubstEnvs
        SubstEnv, TyVarSubstEnv, SubstResult(..),
-       emptySubstEnv, 
+       emptySubstEnv, substEnvEnv,
        mkSubstEnv, lookupSubstEnv, extendSubstEnv, extendSubstEnvList,
-       delSubstEnv, noTypeSubst, isEmptySubstEnv
+       delSubstEnv, delSubstEnvList, noTypeSubst, isEmptySubstEnv
     ) where
 
 #include "HsVersions.h"
@@ -31,11 +31,11 @@ module VarEnv (
 import {-# SOURCE #-}  CoreSyn( CoreExpr )
 import {-# SOURCE #-}  TypeRep( Type )
 
-import IdInfo  ( OccInfo )
-import OccName ( TidyOccEnv, emptyTidyOccEnv )
-import Var     ( Var, Id, IdOrTyVar )
-import UniqFM
-import Util    ( zipEqual )
+import BasicTypes ( OccInfo )
+import OccName   ( TidyOccEnv, emptyTidyOccEnv )
+import Var       ( Var, Id )
+import UniqFM  
+import Util      ( zipEqual )
 \end{code}
 
 
@@ -49,7 +49,7 @@ When tidying up print names, we keep a mapping of in-scope occ-names
 (the TidyOccEnv) and a Var-to-Var of the current renamings.
 
 \begin{code}
-type TidyEnv = (TidyOccEnv, VarEnv IdOrTyVar)
+type TidyEnv = (TidyOccEnv, VarEnv Var)
 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
 \end{code}
 
@@ -72,6 +72,9 @@ data SubstEnv      = SE (VarEnv SubstResult)
 noTypeSubst :: SubstEnv -> Bool
 noTypeSubst (SE _ nt) = nt
 
+substEnvEnv :: SubstEnv -> VarEnv SubstResult
+substEnvEnv (SE env _) = env
+
 type TyVarSubstEnv = SubstEnv  -- of the form (DoneTy ty) *only*
 
 data SubstResult
@@ -93,15 +96,18 @@ lookupSubstEnv (SE s _) v = lookupVarEnv s v
 extendSubstEnv :: SubstEnv -> Var -> SubstResult -> SubstEnv
 extendSubstEnv (SE s nt) v r = SE (extendVarEnv s v r) (noTys r nt)
 
-mkSubstEnv :: [IdOrTyVar] -> [SubstResult] -> SubstEnv
+mkSubstEnv :: [Var] -> [SubstResult] -> SubstEnv
 mkSubstEnv bs vs = extendSubstEnvList emptySubstEnv bs vs
 
-extendSubstEnvList :: SubstEnv -> [IdOrTyVar] -> [SubstResult] -> SubstEnv
+extendSubstEnvList :: SubstEnv -> [Var] -> [SubstResult] -> SubstEnv
 extendSubstEnvList env        []     []     = env
 extendSubstEnvList (SE env nt) (b:bs) (r:rs) = extendSubstEnvList (SE (extendVarEnv env b r) (noTys r nt)) bs rs
 
-delSubstEnv :: SubstEnv -> IdOrTyVar -> SubstEnv
+delSubstEnv :: SubstEnv -> Var -> SubstEnv
 delSubstEnv (SE s nt) v = SE (delVarEnv s v) nt
+
+delSubstEnvList :: SubstEnv -> [Var] -> SubstEnv
+delSubstEnvList (SE s nt) vs = SE (delVarEnvList s vs) nt
 \end{code}
 
 
@@ -142,6 +148,7 @@ foldVarEnv    :: (a -> b -> b) -> b -> VarEnv a -> b
 \begin{code}
 elemVarEnv       = elemUFM
 extendVarEnv    = addToUFM
+extendVarEnvList = addListToUFM
 plusVarEnv_C    = plusUFM_C
 delVarEnvList   = delListFromUFM
 delVarEnv       = delFromUFM
@@ -156,8 +163,7 @@ unitVarEnv   = unitUFM
 isEmptyVarEnv   = isNullUFM
 foldVarEnv      = foldUFM
 
-zipVarEnv tyvars tys       = listToUFM (zipEqual "zipVarEnv" tyvars tys)
-extendVarEnvList env pairs = plusUFM env (listToUFM pairs)
+zipVarEnv tyvars tys       = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
 lookupVarEnv_NF env id     = case (lookupVarEnv env id) of { Just xx -> xx }
 \end{code}