[commit: ghc] ghc-kinds: fix expected kind in kcHsSigType from Open to Arg (aae6e1c)

[Julien Cretin]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-kinds

http://hackage.haskell.org/trac/ghc/changeset/aae6e1cc0af5b917c186cf359726e32c2437cf4d

>---------------------------------------------------------------

commit aae6e1cc0af5b917c186cf359726e32c2437cf4d
Author: Julien Cretin <ghc at ia0.eu>
Date:   Thu Sep 1 17:05:39 2011 +0200

    fix expected kind in kcHsSigType from Open to Arg

>---------------------------------------------------------------

 compiler/typecheck/TcHsType.lhs |   10 ++++++++--
 1 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index fd450c7..3d8080b 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -235,7 +235,7 @@ tc_hs_deriv _ other
 \begin{code}
 kcHsSigType, kcHsLiftedSigType :: LHsType Name -> TcM (LHsType Name)
 	-- Used for type signatures
-kcHsSigType ty 	     = addKcTypeCtxt ty $ kcTypeType ty
+kcHsSigType ty 	     = addKcTypeCtxt ty $ kcArgType ty
 kcHsLiftedSigType ty = addKcTypeCtxt ty $ kcLiftedType ty
 
 tcHsKindedType :: LHsType Name -> TcM Type
@@ -278,6 +278,11 @@ kcTypeType :: LHsType Name -> TcM (LHsType Name)
 kcTypeType ty = kc_check_lhs_type ty ekOpen
 
 ---------------------------
+kcArgType :: LHsType Name -> TcM (LHsType Name)
+-- The type ty must be an *arg* *type* (lifted or unlifted)
+kcArgType ty = kc_check_lhs_type ty ekArg
+
+---------------------------
 kcCheckLHsType :: LHsType Name -> ExpKind -> TcM (LHsType Name)
 kcCheckLHsType ty kind = addKcTypeCtxt ty $ kc_check_lhs_type ty kind
 
@@ -982,9 +987,10 @@ data EkCtxt  = EkUnk		-- Unknown context
      	     | EkArg SDoc Int   -- Function, arg posn, expected kind
 
 
-ekLifted, ekOpen :: ExpKind
+ekLifted, ekOpen, ekArg :: ExpKind
 ekLifted = EK liftedTypeKind EkUnk
 ekOpen   = EK openTypeKind   EkUnk
+ekArg    = EK argTypeKind    EkUnk
 
 unifyKinds :: SDoc -> [(LHsType Name, TcKind)] -> TcM TcKind
 unifyKinds fun act_kinds = do