Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/570cab3f6ba823417212791409bf7fc263445d15 >--------------------------------------------------------------- commit 570cab3f6ba823417212791409bf7fc263445d15 Author: Simon Peyton Jones <[email protected]> Date: Tue Oct 25 11:23:12 2011 +0100 Make GHCi :kind commane work again In generalising :kind to :kind! I managed to make it work only for types of kind *, which is a bit stupid. This fixes it. Regression test coming. >--------------------------------------------------------------- compiler/typecheck/TcMType.lhs | 17 +++++++++++------ compiler/typecheck/TcRnDriver.lhs | 3 ++- compiler/typecheck/TcType.lhs | 31 ++++++++++++++++--------------- 3 files changed, 29 insertions(+), 22 deletions(-) diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index f67df5a..c7341b8 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -835,6 +835,7 @@ checkValidType ctxt ty = do ForSigCtxt _ -> gen_rank 1 SpecInstCtxt -> gen_rank 1 ThBrackCtxt -> gen_rank 1 + GhciCtxt -> ArbitraryRank GenSigCtxt -> panic "checkValidType" -- Can't happen; GenSigCtxt not used for *user* sigs @@ -842,18 +843,22 @@ checkValidType ctxt ty = do kind_ok = case ctxt of TySynCtxt _ -> True -- Any kind will do - ThBrackCtxt -> True -- Any kind will do + ThBrackCtxt -> True -- ditto + GhciCtxt -> True -- ditto ResSigCtxt -> isSubOpenTypeKind actual_kind ExprSigCtxt -> isSubOpenTypeKind actual_kind GenPatCtxt -> isLiftedTypeKind actual_kind ForSigCtxt _ -> isLiftedTypeKind actual_kind _ -> isSubArgTypeKind actual_kind - ubx_tup = case ctxt of - TySynCtxt _ | unboxed -> UT_Ok - ExprSigCtxt | unboxed -> UT_Ok - ThBrackCtxt | unboxed -> UT_Ok - _ -> UT_NotOk + ubx_tup + | not unboxed = UT_NotOk + | otherwise = case ctxt of + TySynCtxt _ -> UT_Ok + ExprSigCtxt -> UT_Ok + ThBrackCtxt -> UT_Ok + GhciCtxt -> UT_Ok + _ -> UT_NotOk -- Check the internal validity of the type itself check_type rank ubx_tup ty diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index b021917..69ccf25 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -1438,7 +1438,8 @@ tcRnType hsc_env ictxt normalise rdr_type failIfErrsM ; -- Now kind-check the type - ty <- tcHsSigType GenSigCtxt rn_type ; + -- It can have any rank or kind + ty <- tcHsSigType GhciCtxt rn_type ; ty' <- if normalise then do { fam_envs <- tcGetFamInstEnvs diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 3f50ac6..da6d893 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -351,10 +351,10 @@ data UserTypeCtxt | DefaultDeclCtxt -- Types in a default declaration | SpecInstCtxt -- SPECIALISE instance pragma | ThBrackCtxt -- Template Haskell type brackets [t| ... |] - | GenSigCtxt -- Higher-rank or impredicative situations -- e.g. (f e) where f has a higher-rank type -- We might want to elaborate this + | GhciCtxt -- GHCi command :kind <type> -- Notes re TySynCtxt -- We allow type synonyms that aren't types; e.g. type List = [] @@ -410,20 +410,21 @@ pprTcTyVarDetails (MetaTv TcsTv _) = ptext (sLit "tcs") pprTcTyVarDetails (MetaTv SigTv _) = ptext (sLit "sig") pprUserTypeCtxt :: UserTypeCtxt -> SDoc -pprUserTypeCtxt (InfSigCtxt n) = ptext (sLit "the inferred type for") <+> quotes (ppr n) -pprUserTypeCtxt (FunSigCtxt n) = ptext (sLit "the type signature for") <+> quotes (ppr n) -pprUserTypeCtxt ExprSigCtxt = ptext (sLit "an expression type signature") -pprUserTypeCtxt (ConArgCtxt c) = ptext (sLit "the type of the constructor") <+> quotes (ppr c) -pprUserTypeCtxt (TySynCtxt c) = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c) -pprUserTypeCtxt GenPatCtxt = ptext (sLit "the type pattern of a generic definition") -pprUserTypeCtxt ThBrackCtxt = ptext (sLit "a Template Haskell quotation [t|...|]") -pprUserTypeCtxt LamPatSigCtxt = ptext (sLit "a pattern type signature") -pprUserTypeCtxt BindPatSigCtxt = ptext (sLit "a pattern type signature") -pprUserTypeCtxt ResSigCtxt = ptext (sLit "a result type signature") -pprUserTypeCtxt (ForSigCtxt n) = ptext (sLit "the foreign declaration for") <+> quotes (ppr n) -pprUserTypeCtxt DefaultDeclCtxt = ptext (sLit "a type in a `default' declaration") -pprUserTypeCtxt SpecInstCtxt = ptext (sLit "a SPECIALISE instance pragma") -pprUserTypeCtxt GenSigCtxt = ptext (sLit "a type expected by the context") +pprUserTypeCtxt (InfSigCtxt n) = ptext (sLit "the inferred type for") <+> quotes (ppr n) +pprUserTypeCtxt (FunSigCtxt n) = ptext (sLit "the type signature for") <+> quotes (ppr n) +pprUserTypeCtxt ExprSigCtxt = ptext (sLit "an expression type signature") +pprUserTypeCtxt (ConArgCtxt c) = ptext (sLit "the type of the constructor") <+> quotes (ppr c) +pprUserTypeCtxt (TySynCtxt c) = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c) +pprUserTypeCtxt GenPatCtxt = ptext (sLit "the type pattern of a generic definition") +pprUserTypeCtxt ThBrackCtxt = ptext (sLit "a Template Haskell quotation [t|...|]") +pprUserTypeCtxt LamPatSigCtxt = ptext (sLit "a pattern type signature") +pprUserTypeCtxt BindPatSigCtxt = ptext (sLit "a pattern type signature") +pprUserTypeCtxt ResSigCtxt = ptext (sLit "a result type signature") +pprUserTypeCtxt (ForSigCtxt n) = ptext (sLit "the foreign declaration for") <+> quotes (ppr n) +pprUserTypeCtxt DefaultDeclCtxt = ptext (sLit "a type in a `default' declaration") +pprUserTypeCtxt SpecInstCtxt = ptext (sLit "a SPECIALISE instance pragma") +pprUserTypeCtxt GenSigCtxt = ptext (sLit "a type expected by the context") +pprUserTypeCtxt GhciCtxt = ptext (sLit "a type in a GHCi command") \end{code} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
