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

On branch  : ghc-kinds

http://hackage.haskell.org/trac/ghc/changeset/2a4494b5147651d33e2f021f35b83c6a88906426

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

commit 2a4494b5147651d33e2f021f35b83c6a88906426
Author: Jose Pedro Magalhaes <[email protected]>
Date:   Mon Nov 14 09:50:01 2011 +0000

    Temporary commit: changes to tcHsSigTypeNC

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

 compiler/typecheck/TcHsType.lhs |   25 ++++++++++++++++++-------
 1 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 8f1fb54..6512f72 100755
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -74,7 +74,7 @@ import UniqSupply
 import Outputable
 import BuildTyCl ( buildPromotedDataTyCon )
 import FastString
-import Control.Monad ( unless )
+import Control.Monad ( unless, when )
 \end{code}
 
 
@@ -171,12 +171,23 @@ tcHsSigType ctxt hs_ty
     tcHsSigTypeNC ctxt hs_ty
 
 tcHsSigTypeNC ctxt hs_ty
-  = do { (kinded_ty, _kind) <- kc_lhs_type hs_ty
-         -- The kind is checked by checkValidType, and isn't necessarily
-         -- of kind * in a Template Haskell quote eg [t| Maybe |]
-       ; ty <- tcHsKindedType kinded_ty
-       ; checkValidType ctxt ty
-       ; return ty }
+  = do  { -- (kinded_ty, _kind) <- kc_lhs_type hs_ty
+          kinded_ty <- if interestingCtxt ctxt
+                       -- In these cases we don't know the expected kind
+                       then fmap fst (kc_lhs_type hs_ty)
+                       -- In the remaining cases (FunSigCtxt, DefaultDeclCtxt,
+                       -- ExprSigCtxt, and ForSigCtxt), we expect kind *
+                       -- Using kcCheckLHsType we give better error messages
+                       else kcCheckLHsType hs_ty ekOpen
+          -- The kind is checked by checkValidType, and isn't necessarily
+          -- of kind * in a Template Haskell quote eg [t| Maybe |]
+        ; ty <- tcHsKindedType kinded_ty
+        ; when (interestingCtxt ctxt) $ checkValidType ctxt ty
+        ; return ty }
+  where 
+    interestingCtxt GhciCtxt    = True
+    interestingCtxt ThBrackCtxt = True
+    interestingCtxt _           = False
 
 -- Like tcHsType, but takes an expected kind
 tcCheckHsType :: LHsType Name -> Kind -> TcM Type



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to