From 46e204f7e0dc08a84a64ecc2fdaa9e3abef8438f Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Tue, 16 Apr 2013 16:40:48 +0100
Subject: [PATCH] Allow partial applications of a type synonym in :kind in GHCi
 (Trac #7586)

Documentation is done too
---
 compiler/typecheck/TcValidity.lhs | 68 +++++++++++++++++--------------
 docs/users_guide/ghci.xml         | 18 +++++++-
 2 files changed, 55 insertions(+), 31 deletions(-)

diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index d036c04dbf6a..ee0d9ecacae4 100644
--- a/compiler/typecheck/TcValidity.lhs
+++ b/compiler/typecheck/TcValidity.lhs
@@ -276,16 +276,26 @@ check_type ctxt rank (AppTy ty1 ty2)
         ; check_arg_type ctxt rank ty2 }
 
 check_type ctxt rank ty@(TyConApp tc tys)
-  | isSynTyCon tc
-  = do  {       -- Check that the synonym has enough args
-                -- This applies equally to open and closed synonyms
-                -- It's OK to have an *over-applied* type synonym
-                --      data Tree a b = ...
-                --      type Foo a = Tree [a]
-                --      f :: Foo a b -> ...
-          checkTc (tyConArity tc <= length tys) arity_msg
-
-        -- See Note [Liberal type synonyms]
+  | isSynTyCon tc          = check_syn_tc_app ctxt rank ty tc tys
+  | isUnboxedTupleTyCon tc = check_ubx_tuple  ctxt      ty    tys
+  | otherwise              = mapM_ (check_arg_type ctxt rank) tys
+
+check_type _ _ (LitTy {}) = return ()
+
+check_type _ _ ty = pprPanic "check_type" (ppr ty)
+
+----------------------------------------
+check_syn_tc_app :: UserTypeCtxt -> Rank -> KindOrType 
+                 -> TyCon -> [KindOrType] -> TcM ()
+check_syn_tc_app ctxt rank ty tc tys
+  | tc_arity <= n_args   -- Saturated
+       -- Check that the synonym has enough args
+       -- This applies equally to open and closed synonyms
+       -- It's OK to have an *over-applied* type synonym
+       --      data Tree a b = ...
+       --      type Foo a = Tree [a]
+       --      f :: Foo a b -> ...
+  = do  { -- See Note [Liberal type synonyms]
         ; liberal <- xoptM Opt_LiberalTypeSynonyms
         ; if not liberal || isSynFamilyTyCon tc then
                 -- For H98 and synonym families, do check the type args
@@ -294,12 +304,24 @@ check_type ctxt rank ty@(TyConApp tc tys)
           else  -- In the liberal case (only for closed syns), expand then check
           case tcView ty of   
              Just ty' -> check_type ctxt rank ty' 
-             Nothing  -> pprPanic "check_tau_type" (ppr ty)
-    }
-    
-  | isUnboxedTupleTyCon tc
+             Nothing  -> pprPanic "check_tau_type" (ppr ty)  }
+
+  | GhciCtxt <- ctxt  -- Accept under-saturated type synonyms in 
+                      -- GHCi :kind commands; see Trac #7586
+  = mapM_ (check_mono_type ctxt synArgMonoType) tys
+
+  | otherwise
+  = failWithTc (arityErr "Type synonym" (tyConName tc) tc_arity n_args)
+  where
+    n_args = length tys
+    tc_arity  = tyConArity tc
+         
+----------------------------------------
+check_ubx_tuple :: UserTypeCtxt -> KindOrType 
+                -> [KindOrType] -> TcM ()
+check_ubx_tuple ctxt ty tys
   = do  { ub_tuples_allowed <- xoptM Opt_UnboxedTuples
-        ; checkTc ub_tuples_allowed ubx_tup_msg
+        ; checkTc ub_tuples_allowed (ubxArgTyErr ty)
 
         ; impred <- xoptM Opt_ImpredicativeTypes        
         ; let rank' = if impred then ArbitraryRank else tyConArgMonoType
@@ -307,21 +329,7 @@ check_type ctxt rank ty@(TyConApp tc tys)
                 -- However, args are allowed to be unlifted, or
                 -- more unboxed tuples, so can't use check_arg_ty
         ; mapM_ (check_type ctxt rank') tys }
-
-  | otherwise
-  = mapM_ (check_arg_type ctxt rank) tys
-
-  where
-    n_args    = length tys
-    tc_arity  = tyConArity tc
-
-    arity_msg   = arityErr "Type synonym" (tyConName tc) tc_arity n_args
-    ubx_tup_msg = ubxArgTyErr ty
-
-check_type _ _ (LitTy {}) = return ()
-
-check_type _ _ ty = pprPanic "check_type" (ppr ty)
-
+    
 ----------------------------------------
 check_arg_type :: UserTypeCtxt -> Rank -> KindOrType -> TcM ()
 -- The sort of type that can instantiate a type variable,
diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml
index 93ab62bf2935..9e8abbb38a9f 100644
--- a/docs/users_guide/ghci.xml
+++ b/docs/users_guide/ghci.xml
@@ -2410,9 +2410,11 @@ Prelude> :. cmds.ghci
 	  and (b) all the other things mentioned in the instance
 	  are in scope (either qualified or otherwise) as a result of
 	  a <literal>:load</literal> or <literal>:module</literal> commands. </para>
+          <para>
           The command <literal>:info!</literal> works in a similar fashion
           but it removes restriction (b), showing all instances that are in
           scope and mention <replaceable>name</replaceable> in their head.
+          </para>
 	</listitem>
       </varlistentry>
 
@@ -2426,7 +2428,21 @@ Prelude> :. cmds.ghci
 	  <para>Infers and prints the kind of
 	  <replaceable>type</replaceable>. The latter can be an arbitrary
 	    type expression, including a partial application of a type constructor,
-	    such as <literal>Either Int</literal>.  If you specify the 
+	    such as <literal>Either Int</literal>.  In fact, <literal>:kind</literal>
+            even allows you to write a partial application of a type synonym (usually disallowed),
+            so that this works:
+<programlisting>
+ghci> type T a b = (a,b,a)
+ghci> :k T Int Bool
+T Int Bool :: *
+ghci> :k T
+T :: * -> * -> *
+ghci> :k T Int
+T Int :: * -> *
+</programlisting>
+            </para>
+            <para>
+            If you specify the 
             optional "<literal>!</literal>", GHC will in addition normalise the type
             by expanding out type synonyms and evaluating type-function applications,
             and display the normalised result.</para>