[project @ 2004-12-30 22:14:59 by simonpj]

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

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index f2f06c8..d4bc995 100644 (file)
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -67,11 +67,11 @@ module Type (
        TvSubstEnv, emptyTvSubst,
        mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst,
        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,
@@ -1026,6 +1026,18 @@ type TvSubstEnv = TyVarEnv Type
        -- So you have to look at the context to know if it's idempotent or
        -- apply-once or whatever
 
+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
+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, becuause the right arg wins
+  where
+    subst1 = TvSubst in_scope env1
+
 emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
 isEmptyTvSubst :: TvSubst -> Bool
 isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env