X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FVarEnv.lhs;h=d219fe5508cc0de385eac3c6a4312c8fb6f9d5ef;hb=e98cf284e1181d6cd67ec90b8d1c4f06eca7bc81;hp=0b3d9210bcbcbf318564f25aafc9b7a81e238298;hpb=506fa77d392191e46c12b2c19387ff5b0888f6a2;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/VarEnv.lhs b/ghc/compiler/basicTypes/VarEnv.lhs
index 0b3d921..d219fe5 100644
--- a/ghc/compiler/basicTypes/VarEnv.lhs
+++ b/ghc/compiler/basicTypes/VarEnv.lhs
@@ -8,7 +8,7 @@ module VarEnv (
 	VarEnv, IdEnv, TyVarEnv,
 	emptyVarEnv, unitVarEnv, mkVarEnv,
 	elemVarEnv, rngVarEnv,
-	extendVarEnv, extendVarEnvList,
+	extendVarEnv, extendVarEnv_C, extendVarEnvList,
 	plusVarEnv, plusVarEnv_C,
 	delVarEnvList, delVarEnv,
 	lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
@@ -20,20 +20,22 @@ module VarEnv (
 	TidyEnv, emptyTidyEnv,
 
 	-- SubstEnvs
-	SubstEnv, TyVarSubstEnv, SubstResult(..), emptySubstEnv, 
+	SubstEnv, TyVarSubstEnv, SubstResult(..),
+	emptySubstEnv, substEnvEnv, elemSubstEnv,
 	mkSubstEnv, lookupSubstEnv, extendSubstEnv, extendSubstEnvList,
-	delSubstEnv, noTypeSubst, isEmptySubstEnv
+	delSubstEnv, delSubstEnvList, noTypeSubst, isEmptySubstEnv
     ) where
 
 #include "HsVersions.h"
 
 import {-# SOURCE #-}	CoreSyn( CoreExpr )
-import {-# SOURCE #-}	Type( Type )
+import {-# SOURCE #-}	TypeRep( Type )
 
-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}
 
 
@@ -47,7 +49,9 @@ 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 :: TidyEnv
 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
 \end{code}
 
@@ -70,10 +74,15 @@ 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
   = DoneEx CoreExpr		-- Completed term
+  | DoneId Id OccInfo		-- Completed term variable, with occurrence info; only 
+				-- used by the simplifier
   | DoneTy Type			-- Completed type
   | ContEx SubstEnv CoreExpr  	-- A suspended substitution
 
@@ -86,18 +95,24 @@ isEmptySubstEnv (SE s _) = isEmptyVarEnv s
 lookupSubstEnv :: SubstEnv -> Var -> Maybe SubstResult
 lookupSubstEnv (SE s _) v = lookupVarEnv s v
 
+elemSubstEnv :: Var -> SubstEnv -> Bool
+elemSubstEnv v (SE s _) = elemVarEnv v s
+
 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}
 
 
@@ -117,6 +132,7 @@ mkVarEnv	  :: [(Var, a)] -> VarEnv a
 zipVarEnv	  :: [Var] -> [a] -> VarEnv a
 unitVarEnv	  :: Var -> a -> VarEnv a
 extendVarEnv	  :: VarEnv a -> Var -> a -> VarEnv a
+extendVarEnv_C	  :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
 plusVarEnv	  :: VarEnv a -> VarEnv a -> VarEnv a
 extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a
 		  
@@ -138,6 +154,8 @@ foldVarEnv	  :: (a -> b -> b) -> b -> VarEnv a -> b
 \begin{code}
 elemVarEnv       = elemUFM
 extendVarEnv	 = addToUFM
+extendVarEnv_C	 = addToUFM_C
+extendVarEnvList = addListToUFM
 plusVarEnv_C	 = plusUFM_C
 delVarEnvList	 = delListFromUFM
 delVarEnv	 = delFromUFM
@@ -152,8 +170,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}