Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-kinds
http://hackage.haskell.org/trac/ghc/changeset/d9d9cd473af33da0f829009957e6f242399c5e5e >--------------------------------------------------------------- commit d9d9cd473af33da0f829009957e6f242399c5e5e Author: Julien Cretin <g...@ia0.eu> Date: Mon Sep 12 18:21:02 2011 +0200 remove use of kindKeys in lintKind >--------------------------------------------------------------- compiler/TODO | 7 +------ compiler/coreSyn/CoreLint.lhs | 24 +++++++++++++++--------- compiler/typecheck/TcRnDriver.lhs | 2 +- 3 files changed, 17 insertions(+), 16 deletions(-) diff --git a/compiler/TODO b/compiler/TODO index 41514b1..164841a 100644 --- a/compiler/TODO +++ b/compiler/TODO @@ -1,9 +1,7 @@ ## TODO FIRST * tcTyClGroup - kind check to find out generalized_env type check (kind check and desugar) using generalized_env at once - forget about record selectors, and rebuild them when needed (only one place apparently) * kind substitution in types, substTyVarBndr look at CoreSubst, substIdBndr @@ -20,10 +18,7 @@ - or it zonks to a kind variable: alpha -> k7 When we kind generalize, we gather the free kind variables and quantify over them. - -## TODO after merge with no-pred-ty - -* Get rid of (~), make it polymorphic and behave like any other TyCon. +* Get rid special cases for Any and (~), make them polymorphic and behave like any other TyCon. ## TODO NEXT diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index f6d283e..fc7121b 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -624,17 +624,23 @@ lintInCo co ------------------- lintKind :: Kind -> LintM () -- Check well-formedness of kinds: *, *->*, Either * (* -> *), etc -lintKind (TyConApp tc []) - | getUnique tc `elem` kindKeys - = return () lintKind (FunTy k1 k2) = lintKind k1 >> lintKind k2 -lintKind kind@(TyConApp tc kis) -- T k1 .. kn - | not (getUnique tc `elem` (tySuperKindTyConKey : funTyConKey : kindKeys)) - = let tc_kind = tyConKind tc in - case isPromotableKind tc_kind of - Just n | n == length kis -> mapM_ lintKind kis - _ -> addErrL (hang (ptext (sLit "Malformed kind:")) 2 (quotes (ppr kind))) + +lintKind kind@(TyConApp tc kis) + | isSuperKind tc_kind -- handles *, #, Constraint, etc. + , null kis + = return () + + | Just n <- isPromotableKind tc_kind -- handles promoted TyCons + , n == length kis + = mapM_ lintKind kis + + | otherwise + = addErrL (hang (ptext (sLit "Malformed kind:")) 2 (quotes (ppr kind))) + where + tc_kind = tyConKind tc + lintKind (TyVarTy kv) = checkTyCoVarInScope kv lintKind kind = addErrL (hang (ptext (sLit "Malformed kind:")) 2 (quotes (ppr kind))) diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 66cf840..41d4ccc 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -875,7 +875,7 @@ tcTopSrcDecls boot_details traceTc "Tc2" empty ; tcg_env <- tcTyAndClassDecls boot_details tycl_decls ; - aux_binds <- return $ mkRecSelBinds [tc | ATyCon tc <- nameEnvElts (tcg_type_env tcg_env)] ; + let { aux_binds = mkRecSelBinds [tc | ATyCon tc <- nameEnvElts (tcg_type_env tcg_env)] } ; -- If there are any errors, tcTyAndClassDecls fails here setGblEnv tcg_env $ do { _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
