Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/4496fda259959ef61df06f53f123b00ebad57b2d >--------------------------------------------------------------- commit 4496fda259959ef61df06f53f123b00ebad57b2d Author: Simon Peyton Jones <simo...@microsoft.com> Date: Wed Jan 2 11:58:35 2013 +0000 Minor refactoring plus comments >--------------------------------------------------------------- compiler/typecheck/TcMType.lhs | 24 +++++++++++++----------- compiler/typecheck/TcTyClsDecls.lhs | 12 ++++++------ 2 files changed, 19 insertions(+), 17 deletions(-) diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index 6561b58..aaeacc7 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -542,21 +542,23 @@ zonkQuantifiedTyVars :: [TcTyVar] -> TcM [TcTyVar] -- A kind variable k may occur *after* a tyvar mentioning k in its kind zonkQuantifiedTyVars tyvars = do { let (kvs, tvs) = partition isKindVar tyvars - ; poly_kinds <- xoptM Opt_PolyKinds - ; if poly_kinds then - mapM zonkQuantifiedTyVar (kvs ++ tvs) - -- Because of the order, any kind variables - -- mentioned in the kinds of the type variables refer to - -- the now-quantified versions - else + (meta_kvs, skolem_kvs) = partition isMetaTyVar kvs + -- In the non-PolyKinds case, default the kind variables -- to *, and zonk the tyvars as usual. Notice that this -- may make zonkQuantifiedTyVars return a shorter list -- than it was passed, but that's ok - do { let (meta_kvs, skolem_kvs) = partition isMetaTyVar kvs - ; WARN ( not (null skolem_kvs), ppr skolem_kvs ) - mapM_ defaultKindVarToStar meta_kvs - ; mapM zonkQuantifiedTyVar (skolem_kvs ++ tvs) } } + ; poly_kinds <- xoptM Opt_PolyKinds + ; qkvs <- if poly_kinds + then return kvs + else WARN ( not (null skolem_kvs), ppr skolem_kvs ) + do { mapM_ defaultKindVarToStar meta_kvs + ; return skolem_kvs } -- Should be empty + + ; mapM zonkQuantifiedTyVar (qkvs ++ tvs) } + -- Because of the order, any kind variables + -- mentioned in the kinds of the type variables refer to + -- the now-quantified versions zonkQuantifiedTyVar :: TcTyVar -> TcM TcTyVar -- The quantified type variables often include meta type variables diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 35ed724..481ff6b 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -900,11 +900,11 @@ tcFamTyPats fam_tc (HsWB { hswb_cts = arg_pats, hswb_kvs = kvars, hswb_tvs = tva ; tcHsArgTys (quotes (ppr fam_tc)) arg_pats arg_kinds } ; let all_args = fam_arg_kinds ++ typats - -- Find free variables (after zonking) - ; tkvs <- zonkTyVarsAndFV (tyVarsOfTypes all_args) - - -- Turn them into skolems, so that we don't subsequently + -- Find free variables (after zonking) and turn + -- them into skolems, so that we don't subsequently -- replace a meta kind var with AnyK + -- Very like kindGeneralize + ; tkvs <- zonkTyVarsAndFV (tyVarsOfTypes all_args) ; qtkvs <- zonkQuantifiedTyVars (varSetElems tkvs) -- Zonk the patterns etc into the Type world @@ -912,7 +912,7 @@ tcFamTyPats fam_tc (HsWB { hswb_cts = arg_pats, hswb_kvs = kvars, hswb_tvs = tva ; all_args' <- zonkTcTypeToTypes ze all_args ; res_kind' <- zonkTcTypeToType ze res_kind - ; traceTc "tcFamPats" (pprTvBndrs qtkvs' $$ ppr all_args' $$ ppr res_kind') + ; traceTc "tcFamTyPats" (pprTvBndrs qtkvs' $$ ppr all_args' $$ ppr res_kind') ; tcExtendTyVarEnv qtkvs' $ thing_inside qtkvs' all_args' res_kind' } \end{code} @@ -1070,7 +1070,7 @@ tcConDecl new_or_data rep_tycon res_tmpl -- Data types -- free kind variables of the type, for kindGeneralize to work on -- Generalise the kind variables (returning quantifed TcKindVars) - -- and quanify the type variables (substiting their kinds) + -- and quantify the type variables (substiting their kinds) ; kvs <- kindGeneralize (tyVarsOfType pretend_con_ty) (map getName tvs) ; tvs <- zonkQuantifiedTyVars tvs _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc