X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcGadt.lhs;h=5bad13e0a4bf0e043be38a0fef55da50e9d1289d;hb=f515d87a510f9cd3d416d83e95e6e0f0298f7d18;hp=4129df5a1af44074cebf69b93f56c806028bd62c;hpb=1166c7d62f3fa9acd2084c90df6585cbbf868ceb;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcGadt.lhs b/compiler/typecheck/TcGadt.lhs index 4129df5..5bad13e 100644 --- a/compiler/typecheck/TcGadt.lhs +++ b/compiler/typecheck/TcGadt.lhs @@ -30,11 +30,11 @@ import ErrUtils import Maybes import Control.Monad import Outputable +import TcType #ifdef DEBUG import Unique import UniqFM -import TcType #endif \end{code} @@ -47,6 +47,8 @@ import TcType \begin{code} data Refinement = Reft InScopeSet InternalReft + +type InternalReft = TyVarEnv (Coercion, Type) -- INVARIANT: a->(co,ty) then co :: (a:=:ty) -- Not necessarily idemopotent @@ -139,7 +141,7 @@ gadtRefine (Reft in_scope env1) ex_tvs co_vars -- Precondition: fvs( co_vars ) # env1 -- That is, the kinds of the co_vars are a --- fixed point of the incoming refinement +-- fixed point of the incoming refinement = ASSERT2( not $ any (`elemVarEnv` env1) (varSetElems $ tyVarsOfTypes $ map tyVarKind co_vars), ppr env1 $$ ppr co_vars $$ ppr (map tyVarKind co_vars) ) @@ -157,9 +159,11 @@ gadtRefine (Reft in_scope env1) where tv_set = mkVarSet ex_tvs in_scope' = foldr extend in_scope co_vars + + -- For each co_var, add it *and* the tyvars it mentions, to in_scope extend co_var in_scope - = extendInScopeSetSet (extendInScopeSet in_scope co_var) - (tyVarsOfType (tyVarKind co_var)) + = extendInScopeSetSet in_scope $ + extendVarSet (tyVarsOfType (tyVarKind co_var)) co_var do_one reft co_var = unify reft (TyVarTy co_var) ty1 ty2 where @@ -252,11 +256,6 @@ tryToBind tv_set tv | tv `elemVarSet` tv_set = BindMe %************************************************************************ \begin{code} -type InternalReft = TyVarEnv (Coercion, Type) - --- INVARIANT: a->(co,ty) then co :: (a:=:ty) --- Not necessarily idemopotent - #ifdef DEBUG badReftElts :: InternalReft -> [(Unique, (Coercion,Type))] -- Return the BAD elements of the refinement