X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsType.lhs;h=c8c0efcde421860318aa1561609a634647e133ca;hp=b7cbc1ec75179a523274e1ec3c5124238fcf8a3b;hb=389cca214f33a29646e08d57e3dca862140007b2;hpb=97a8fe8780307e95829034117efa98d2e27109cd

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index b7cbc1e..c8c0efc 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 }
@@ -399,8 +408,11 @@ 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)
+#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