X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcMType.lhs;h=6d6d1021fbe154c0b15e64c827c2b2bd9eb15a9d;hb=0cffd31b0f25c2a31ed6eff2c0c0b1b1a8a8d507;hp=030a7f6fec642845694cc0a524307e614783d165;hpb=3e39f8485ee4bd1ef6e3e7153ea88e45bfa9218e;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 030a7f6..6d6d102 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -415,7 +415,7 @@ occurCheckErr ty containingTy
 newCoVars :: [(TcType,TcType)] -> TcM [CoVar]
 newCoVars spec
   = do	{ us <- newUniqueSupply 
-	; return [ mkCoVar (mkSysTvName uniq (fsLit "co"))
+	; return [ mkCoVar (mkSysTvName uniq (fsLit "co_kv"))
 			   (mkCoKind ty1 ty2)
 		 | ((ty1,ty2), uniq) <- spec `zip` uniqsFromSupply us] }
 
@@ -1078,12 +1078,14 @@ checkValidType ctxt ty = do
 	              ThBrackCtxt | unboxed -> UT_Ok
 	              _                     -> UT_NotOk
 
-	-- Check that the thing has kind Type, and is lifted if necessary
-    checkTc kind_ok (kindErr actual_kind)
-
 	-- Check the internal validity of the type itself
     check_type rank ubx_tup ty
 
+	-- Check that the thing has kind Type, and is lifted if necessary
+	-- Do this second, becuase we can't usefully take the kind of an 
+	-- ill-formed type such as (a~Int)
+    checkTc kind_ok (kindErr actual_kind)
+
     traceTc (text "checkValidType done" <+> ppr ty)
 
 checkValidMonoType :: Type -> TcM ()
@@ -1138,15 +1140,12 @@ check_type rank ubx_tup ty
   where
     (tvs, theta, tau) = tcSplitSigmaTy ty
    
--- Naked PredTys don't usually show up, but they can as a result of
---	{-# SPECIALISE instance Ord Char #-}
--- The Right Thing would be to fix the way that SPECIALISE instance pragmas
--- are handled, but the quick thing is just to permit PredTys here.
-check_type _ _ (PredTy sty)
-  = do	{ dflags <- getDOpts
-	; check_pred_ty dflags TypeCtxt sty }
+-- Naked PredTys should, I think, have been rejected before now
+check_type _ _ ty@(PredTy {})
+  = failWithTc (text "Predicate used as a type:" <+> ppr ty)
 
 check_type _ _ (TyVarTy _) = return ()
+
 check_type rank _ (FunTy arg_ty res_ty)
   = do	{ check_type (decRank rank) UT_NotOk arg_ty
 	; check_type rank 	    UT_Ok    res_ty }