[project @ 2005-03-10 14:03:28 by simonmar]

[ghc-hetmet.git] / ghc / compiler / types / Type.lhs

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index f2f06c8..fe848d6 100644 (file)
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -63,15 +63,15 @@ module Type (
        seqType, seqTypes,
 
        -- Type substitutions
-       TvSubst(..),    -- Representation visible to a few friends
-       TvSubstEnv, emptyTvSubst,
-       mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst,
+       TvSubstEnv, emptyTvSubstEnv,    -- Representation widely visible
+       TvSubst(..), emptyTvSubst,      -- Representation visible to a few friends
+       mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
        getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
-       extendTvSubst, extendTvSubstList, isInScope,
+       extendTvSubst, extendTvSubstList, isInScope, composeTvSubst,
 
        -- Performing substitution on types
        substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
-       deShadowTy,
+       deShadowTy, 
 
        -- Pretty-printing
        pprType, pprParendType, pprTyThingCategory,
@@ -1025,11 +1025,29 @@ type TvSubstEnv = TyVarEnv Type
        -- in the middle of matching, and unification (see Types.Unify)
        -- So you have to look at the context to know if it's idempotent or
        -- apply-once or whatever
+emptyTvSubstEnv :: TvSubstEnv
+emptyTvSubstEnv = emptyVarEnv
+
+composeTvSubst :: InScopeSet -> TvSubstEnv -> TvSubstEnv -> TvSubstEnv
+-- (compose env1 env2)(x) is env1(env2(x)); i.e. apply env2 then env1
+-- It assumes that both are idempotent
+-- Typically, env1 is the refinement to a base substitution env2
+composeTvSubst in_scope env1 env2
+  = env1 `plusVarEnv` mapVarEnv (substTy subst1) env2
+       -- First apply env1 to the range of env2
+       -- Then combine the two, making sure that env1 loses if
+       -- both bind the same variable; that's why env1 is the
+       -- *left* argument to plusVarEnv, because the right arg wins
+  where
+    subst1 = TvSubst in_scope env1
 
 emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
 isEmptyTvSubst :: TvSubst -> Bool
 isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env
 
+mkTvSubst :: InScopeSet -> TvSubstEnv -> TvSubst
+mkTvSubst = TvSubst
+
 getTvSubstEnv :: TvSubst -> TvSubstEnv
 getTvSubstEnv (TvSubst _ env) = env
 
@@ -1039,6 +1057,9 @@ getTvInScope (TvSubst in_scope _) = in_scope
 isInScope :: Var -> TvSubst -> Bool
 isInScope v (TvSubst in_scope _) = v `elemInScopeSet` in_scope
 
+notElemTvSubst :: TyVar -> TvSubst -> Bool
+notElemTvSubst tv (TvSubst _ env) = not (tv `elemVarEnv` env)
+
 setTvSubstEnv :: TvSubst -> TvSubstEnv -> TvSubst
 setTvSubstEnv (TvSubst in_scope _) env = TvSubst in_scope env
 
@@ -1052,16 +1073,15 @@ extendTvSubstList :: TvSubst -> [TyVar] -> [Type] -> TvSubst
 extendTvSubstList (TvSubst in_scope env) tvs tys 
   = TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
 
--- mkTvSubst and zipTvSubst generate the in-scope set from
+-- mkOpenTvSubst and zipOpenTvSubst generate the in-scope set from
 -- the types given; but it's just a thunk so with a bit of luck
 -- it'll never be evaluated
 
-mkTvSubst :: TvSubstEnv -> TvSubst
-mkTvSubst env 
-  = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
+mkOpenTvSubst :: TvSubstEnv -> TvSubst
+mkOpenTvSubst env = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
 
-zipTvSubst :: [TyVar] -> [Type] -> TvSubst
-zipTvSubst tyvars tys 
+zipOpenTvSubst :: [TyVar] -> [Type] -> TvSubst
+zipOpenTvSubst tyvars tys 
   = TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys)
 
 -- mkTopTvSubst is called when doing top-level substitutions.
@@ -1114,7 +1134,7 @@ instance Outputable TvSubst where
 
 \begin{code}
 substTyWith :: [TyVar] -> [Type] -> Type -> Type
-substTyWith tvs tys = substTy (zipTvSubst tvs tys)
+substTyWith tvs tys = substTy (zipOpenTvSubst tvs tys)
 
 substTy :: TvSubst -> Type  -> Type
 substTy subst ty | isEmptyTvSubst subst = ty
@@ -1190,5 +1210,3 @@ substTyVarBndr subst@(TvSubst in_scope env) old_var
     new_var = uniqAway in_scope old_var
        -- The uniqAway part makes sure the new variable is not already in scope
 \end{code}
-
-