Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/e949162653b65d8e48573e84583c6509be2f24ed >--------------------------------------------------------------- commit e949162653b65d8e48573e84583c6509be2f24ed Author: Simon Peyton Jones <[email protected]> Date: Tue Aug 14 17:06:00 2012 +0100 Fix Trac #7128, by zonking kind varaibles more assiduously when typechecking a class declaration >--------------------------------------------------------------- compiler/typecheck/TcHsSyn.lhs | 2 +- compiler/typecheck/TcTyClsDecls.lhs | 19 +++++++++++++++---- 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index d1a82b2..1ddcd31 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -29,7 +29,7 @@ module TcHsSyn ( zonkTopDecls, zonkTopExpr, zonkTopLExpr, zonkTopBndrs, zonkTyBndrsX, emptyZonkEnv, mkEmptyZonkEnv, mkTyVarZonkEnv, - zonkTcTypeToType, zonkTcTypeToTypes + zonkTcTypeToType, zonkTcTypeToTypes, zonkTyVarOcc, ) where #include "HsVersions.h" diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 5784788..40210bc 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -568,12 +568,15 @@ tcTyClDecl1 _parent calc_isrec ; ctxt' <- tcHsContext ctxt ; ctxt' <- zonkTcTypeToTypes emptyZonkEnv ctxt' - -- Squeeze out any kind unification variables - + -- Squeeze out any kind unification variables ; fds' <- mapM (addLocM tc_fundep) fundeps ; (sig_stuff, gen_dm_env) <- tcClassSigs class_name sigs meths + ; env <- getLclTypeEnv + ; traceTc "tcClassDecl" (ppr fundeps $$ ppr tvs' $$ ppr fds' $$ ppr env) ; return (tvs', ctxt', fds', sig_stuff, gen_dm_env) } + + ; clas <- fixM $ \ clas -> do { let -- This little knot is just so we can get -- hold of the name of the class TyCon, which we @@ -602,9 +605,17 @@ tcTyClDecl1 _parent calc_isrec -- tying the the type and class declaration type checking knot. } where - tc_fundep (tvs1, tvs2) = do { tvs1' <- mapM tcLookupTyVar tvs1 ; - ; tvs2' <- mapM tcLookupTyVar tvs2 ; + tc_fundep (tvs1, tvs2) = do { tvs1' <- mapM tc_fd_tyvar tvs1 ; + ; tvs2' <- mapM tc_fd_tyvar tvs2 ; ; return (tvs1', tvs2') } + tc_fd_tyvar name -- Scoped kind variables are bound to unification variables + -- which are now fixed, so we can zonk + = do { tv <- tcLookupTyVar name + ; ty <- zonkTyVarOcc emptyZonkEnv tv + -- Squeeze out any kind unification variables + ; case getTyVar_maybe ty of + Just tv' -> return tv' + Nothing -> pprPanic "tc_fd_tyvar" (ppr name $$ ppr tv $$ ppr ty) } tcTyClDecl1 _ _ (ForeignType {tcdLName = L _ tc_name, tcdExtName = tc_ext_name}) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
