X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsType.lhs;h=a63c2cee907628454d2e9c1baad18f60daee5a08;hp=b7cbc1ec75179a523274e1ec3c5124238fcf8a3b;hb=432b9c9322181a3644083e3c19b7e240d90659e7;hpb=9a4ef343a46e823bcf949af8501c13cc8ca98fb1

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index b7cbc1e..a63c2ce 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -6,7 +6,7 @@
 
 \begin{code}
 module TcHsType (
-	tcHsSigType, tcHsDeriv, 
+	tcHsSigType, tcHsSigTypeNC, tcHsDeriv, 
 	tcHsInstHead, tcHsQuantifiedType,
 	UserTypeCtxt(..), 
 
@@ -25,6 +25,10 @@ module TcHsType (
 
 #include "HsVersions.h"
 
+#ifdef GHCI 	/* Only if bootstrapped */
+import {-# SOURCE #-}	TcSplice( kcSpliceType )
+#endif
+
 import HsSyn
 import RnHsSyn
 import TcRnMonad
@@ -136,14 +140,19 @@ the TyCon being defined.
 %************************************************************************
 
 \begin{code}
-tcHsSigType :: UserTypeCtxt -> LHsType Name -> TcM Type
+tcHsSigType, tcHsSigTypeNC :: UserTypeCtxt -> LHsType Name -> TcM Type
   -- Do kind checking, and hoist for-alls to the top
   -- NB: it's important that the foralls that come from the top-level
   --	 HsForAllTy in hs_ty occur *first* in the returned type.
   --     See Note [Scoped] with TcSigInfo
 tcHsSigType ctxt hs_ty 
   = addErrCtxt (pprHsSigCtxt ctxt hs_ty) $
-    do	{ kinded_ty <- kcTypeType 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 }
@@ -395,12 +404,20 @@ kc_hs_type (HsForAllTy exp tv_names context ty)
 
   	; return (HsForAllTy exp tv_names' ctxt' ty', liftedTypeKind) }
 
-kc_hs_type (HsBangTy b ty) = do
-    (ty', kind) <- kc_lhs_type ty
-    return (HsBangTy b ty', kind)
+kc_hs_type (HsBangTy b ty)
+  = do { (ty', kind) <- kc_lhs_type ty
+       ; return (HsBangTy b ty', kind) }
 
-kc_hs_type ty@(HsSpliceTy _)
-  = failWithTc (ptext (sLit "Unexpected type splice:") <+> ppr ty)
+kc_hs_type ty@(HsRecTy _)
+  = failWithTc (ptext (sLit "Unexpected record type") <+> ppr ty)
+      -- Record types (which only show up temporarily in constructor signatures) 
+      -- should have been removed by now
+
+#ifdef GHCI	/* Only if bootstrapped */
+kc_hs_type (HsSpliceTy sp) = kcSpliceType sp
+#else
+kc_hs_type ty@(HsSpliceTy _) = failWithTc (ptext (sLit "Unexpected type splice:") <+> ppr ty)
+#endif
 
 -- remove the doc nodes here, no need to worry about the location since
 -- its the same for a doc node and it's child type node
@@ -542,9 +559,12 @@ ds_type ty@(HsTyVar _)
 ds_type (HsParTy ty)		-- Remove the parentheses markers
   = dsHsType ty
 
-ds_type ty@(HsBangTy _ _)	-- No bangs should be here
+ds_type ty@(HsBangTy {})    -- No bangs should be here
   = failWithTc (ptext (sLit "Unexpected strictness annotation:") <+> ppr ty)
 
+ds_type ty@(HsRecTy {})	    -- No bangs should be here
+  = failWithTc (ptext (sLit "Unexpected record type:") <+> ppr ty)
+
 ds_type (HsKindSig ty _)
   = dsHsType ty	-- Kind checking done already