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.

3 files changed, 29 insertions, 22 deletions

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index f67df5a054..c7341b891e 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 b021917f05..69ccf25ebd 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 3f50ac6369..da6d8936db 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}