[commit: ghc] master: Allow partial applications of a type synonym in :kind in GHCi (Trac #7586) (46e204f)
Simon Peyton Jones
simonpj at microsoft.com
Tue Apr 16 17:41:30 CEST 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch : master
https://github.com/ghc/ghc/commit/46e204f7e0dc08a84a64ecc2fdaa9e3abef8438f
>---------------------------------------------------------------
commit 46e204f7e0dc08a84a64ecc2fdaa9e3abef8438f
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Tue Apr 16 16:40:48 2013 +0100
Allow partial applications of a type synonym in :kind in GHCi (Trac #7586)
Documentation is done too
>---------------------------------------------------------------
compiler/typecheck/TcValidity.lhs | 64 ++++++++++++++++++++++-----------------
docs/users_guide/ghci.xml | 18 ++++++++++-
2 files changed, 53 insertions(+), 29 deletions(-)
diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index d036c04..ee0d9ec 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)
- }
+ 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
- | isUnboxedTupleTyCon 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
@@ -308,20 +330,6 @@ check_type ctxt rank ty@(TyConApp tc tys)
-- 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 93ab62b..9e8abbb 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>
More information about the ghc-commits
mailing list