Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-kinds
http://hackage.haskell.org/trac/ghc/changeset/d2633652c40903973825b0fe588f6a7e6ea69c68 >--------------------------------------------------------------- commit d2633652c40903973825b0fe588f6a7e6ea69c68 Author: Simon Peyton Jones <simo...@microsoft.com> Date: Tue Oct 25 16:21:39 2011 +0100 Comments and refactoring >--------------------------------------------------------------- compiler/hsSyn/HsTypes.lhs | 2 +- compiler/typecheck/TcHsType.lhs | 23 +++++++++++-------- compiler/typecheck/TcInstDcls.lhs | 1 + compiler/typecheck/TcTyClsDecls.lhs | 41 ++++++++++++++++++++++++++++++++-- 4 files changed, 53 insertions(+), 14 deletions(-) diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index 8b44e45..c97bbfc 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -289,7 +289,7 @@ data HsTyVarBndr name | KindedTyVar name - (LHsKind name) + (LHsKind name) -- The user-supplied kind signature PostTcKind -- *** NOTA BENE *** A "monotype" in a pragma can have -- for-alls in it, (mostly to do with dictionaries). These diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index da76ff8..0d15740 100755 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -782,16 +782,17 @@ typeCtxt ty = ptext (sLit "In the type") <+> quotes (ppr ty) Note [Kind-checking kind-polymorphic types] IA0_TODO: add explicit kind polymorphism ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider: - f :: forall k f (a::k). f a -> Int + f :: forall (f::k -> *) a. f a -> Int -The renamer (or parser) already decided for us if k, f or a are type -or kind variables. It did so by clissifying them with the correct data -constructor. +Here, the [LHsTyVarBndr Name] of the forall type will be [f,a], where + a is a UserTyVar -> type variable without kind annotation + f is a KindedTyVar -> type variable with kind annotation - UserTyVar -> type variable without kind annotation - KindedTyVar -> type variable with kind annotation - UserKiVar -> kind variable (they don't need annotation, - since we only have BOX for a super kind) +If were were to allow binding sites for kind variables, thus + f :: forall @k (f :: k -> *) a. f a -> Int +then we'd also need + k is a UserKiVar -> kind variable (they don't need annotation, + since we only have BOX for a super kind) \begin{code} kcHsTyVars :: [LHsTyVarBndr Name] @@ -803,14 +804,16 @@ kcHsTyVars tvs thing_inside ; tcExtendKindEnvTvs kinded_tvs thing_inside } kcHsTyVar :: HsTyVarBndr Name -> TcM (HsTyVarBndr Name) --- Return a *kind-annotated* binder, and a tyvar with a mutable kind in it +-- Return a *kind-annotated* binder, whose PostTcKind is +-- initialised with a kind variable. +-- Typically the Kind inside the KindedTyVar will and a tyvar with a mutable kind in it -- We aren't yet sure whether the binder is a *type* variable or a *kind* variable -- See Note [Kind-checking kind-polymorphic types] kcHsTyVar tyvar = do in_scope <- getInLocalScope if False -- in_scope (hsTyVarName tyvar) then do inscope_tyvar <- tcLookupTyVar (hsTyVarName tyvar) {- pprTrace "kcHsTyVar in scope" (ppr tyvar) -} - return (UserTyVar (tyVarName inscope_tyvar) (tyVarKind inscope_tyvar)) -- JPM should return KindedTyVar ? + return (UserTyVar (tyVarName inscope_tyvar) (tyVarKind inscope_tyvar)) else {- pprTrace "kcHsTyVar not in scope" (ppr tyvar) $ -} kcHsTyVar' tyvar where kcHsTyVar' (UserTyVar name _) = UserTyVar name <$> newMetaKindVar diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index ce1c065..9e2def7 100755 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -581,6 +581,7 @@ tcFamInstDecl1 fam_tc (decl@TyData { tcdND = new_or_data, tcdCtxt = ctxt -- all the meta kind variables -- ; tcTyVarBndrsKindGen k_tvs $ \t_tvs -> do -- turn kinded into proper tyvars + ; tcFamTyPats ... $ \ final_tvs final_pats -> do -- kind check the type indexes and the context -- t_typats <- mapM tcHsKindedType k_typats ; (t_kvs, t_kipats) <- kindGeneralizeKinds t_typats -- JPM k_kipats diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 3344278..6171bae 100755 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -654,7 +654,7 @@ tcDefaultAssocDecl fam_tc clas_tvs (L loc decl) ------------------------- tcSynFamInstDecl :: TyCon -> TyClDecl Name -> TcM ([TyVar], [Type], Type) tcSynFamInstDecl fam_tc (decl@TySynonym {}) - = kcFamTyPats fam_tc decl $ \t_tvs {-k_kipats-} t_typats resKind -> + = kcFamTyPats fam_tc decl $ \stuff -> do { -- check that the family declaration is for a synonym checkTc (isSynTyCon fam_tc) (wrongKindOfFamily fam_tc) @@ -665,16 +665,28 @@ tcSynFamInstDecl fam_tc (decl@TySynonym {}) -- (2) type check type equation -- We kind generalize the kind patterns since they contain -- all the meta kind variables + ; tcFamTyPats stuff $ \ final_tvs final_pats -> do + + { -- ; tcTyVarBndrs k_tvs $ \t_tvs -> do -- turn kinded into proper tyvars -- t_typats <- mapM tcHsKindedType k_typats ; t_rhs <- tcHsKindedType k_rhs - ; (t_kvs, t_kipats) <- kindGeneralizeKinds t_typats -- JPM k_kipats + +-- ; (t_kvs, t_kipats) <- kindGeneralizeKinds t_typats -- JPM k_kipats -- NB: we don't check well-formedness of the instance here because we call -- this function from within the TcTyClsDecls fixpoint. The callers must do -- the check. - ; return (t_kvs ++ t_tvs, t_kipats {- ++ t_typats -}, t_rhs) } + ; return (final_tvs, final_pats, t_rhs) } + +tcSynFamInstDecl fam_tc (decl@TySynonym { tcdTyVars = tvs, tcdTyPats = Just pats + , tcdSynRhs = rhs }) + = do { checkTc (isSynTyCon fam_tc) (wrongKindOfFamily fam_tc) + + ; tcFamTyPats fam_tc tvs pats (kcRhsType rhs) $ \ tvs' pats' -> do + { rhs' <- tcRhsType rhs + ; return (tvs', pats', rhs') } tcSynFamInstDecl _ decl = pprPanic "tcSynFamInstDecl" (ppr decl) @@ -685,6 +697,29 @@ tcSynFamInstDecl _ decl = pprPanic "tcSynFamInstDecl" (ppr decl) -- not check whether there is a pattern for each type index; the latter -- check is only required for type synonym instances. +----------------- +Plan A +tcFamTyPats :: TyCon + -> [LHsTyVarBndr Name] -> [LHsType Name] + -> TcM () -- Kind checker + -> (final_tvs -> final_pats -> result_kind -> TcM a) + -> TcM a + +----------------- +Plan B +kcFamTyPats :: TyCon + -> [LHsTyVarBndr Name] -> [LHsType Name] + -> (([LHsTyVarBndr Name], [TcKind], [LHsType Name], TcKind) -> TcM a) + -> TcM a + +tcFamTyPats :: TyCon + -> ([LHsTyVarBndr Name], [TcKind], [LHsType Name], TcKind) + -> (final_tvs -> final_pats -> TcM a) + -> TcM a +checkFamTyFreeness! + +----------------- +-- Current kcFamTyPats :: TyCon -> TyClDecl Name -> ([KindVar] -> [Kind] -> Kind -> TcM a) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
