Commit 570cab3f authored by Simon Peyton Jones's avatar Simon Peyton Jones

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.
parent 03d45973
......@@ -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
......
......@@ -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
......
......@@ -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}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment