X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FType.lhs;h=8ff78fbccfa5f2c082fcb1b7d39b8d1c6e4a13ab;hb=ca9e79e1c70a26b12ea4b63f3a1c5a804462c1a5;hp=fa5f46aa841069f416ee7b398fc685a761ca5738;hpb=e7d92690ebabf8b5f308e528db9e296ff24ec0bb;p=ghc-hetmet.git

diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index fa5f46a..8ff78fb 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -105,7 +105,7 @@ module Type (
 	getTvSubstEnv, setTvSubstEnv, zapTvSubstEnv, getTvInScope, 
         extendTvInScope, extendTvInScopeList,
  	extendTvSubst, extendTvSubstList, isInScope, composeTvSubst, zipTyEnv,
-        isEmptyTvSubst,
+        isEmptyTvSubst, unionTvSubst,
 
 	-- ** Performing substitution on types
 	substTy, substTys, substTyWith, substTysWith, substTheta, 
@@ -1320,6 +1320,13 @@ extendTvSubstList :: TvSubst -> [TyVar] -> [Type] -> TvSubst
 extendTvSubstList (TvSubst in_scope env) tvs tys 
   = TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
 
+unionTvSubst :: TvSubst -> TvSubst -> TvSubst
+-- Works when the ranges are disjoint
+unionTvSubst (TvSubst in_scope1 env1) (TvSubst in_scope2 env2)
+  = ASSERT( not (env1 `intersectsVarEnv` env2) )
+    TvSubst (in_scope1 `unionInScope` in_scope2)
+            (env1      `plusVarEnv`   env2)
+
 -- 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