From bb551326b9a88fd389d6068b8aceda5310c1beb4 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Sat, 16 Apr 2005 22:45:17 +0000
Subject: [PATCH] [project @ 2005-04-16 22:45:17 by simonpj] Improve location
 info for kind errors; may make some tests change their
 output

---
 ghc/compiler/typecheck/TcHsType.lhs |   17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/ghc/compiler/typecheck/TcHsType.lhs b/ghc/compiler/typecheck/TcHsType.lhs
index fb9f0db..6686899 100644
--- a/ghc/compiler/typecheck/TcHsType.lhs
+++ b/ghc/compiler/typecheck/TcHsType.lhs
@@ -39,9 +39,8 @@ import TcUnify		( unifyFunKind, checkExpectedKind )
 import TcType		( Type, PredType(..), ThetaType, 
 			  MetaDetails(Flexi), hoistForAllTys,
 			  TcType, TcTyVar, TcKind, TcThetaType, TcTauType,
-		 	  mkFunTy, 
-			  mkSigmaTy, mkPredTy, mkGenTyConApp, mkTyConApp, mkAppTys, 
-			  typeKind )
+		 	  mkFunTy, mkSigmaTy, mkPredTy, mkGenTyConApp, 
+			  mkTyConApp, mkAppTys, typeKind )
 import Kind 		( Kind, isLiftedTypeKind, liftedTypeKind, ubxTupleKind, 
 			  openTypeKind, argTypeKind, splitKindFunTys )
 import Id		( idName )
@@ -238,9 +237,13 @@ kcCheckHsType :: LHsType Name -> TcKind -> TcM (LHsType Name)
 -- with OpenTypeKind, because it gives better error messages
 kcCheckHsType (L span ty) exp_kind 
   = setSrcSpan span				$
-    kc_hs_type ty				`thenM` \ (ty', act_kind) ->
-    checkExpectedKind ty act_kind exp_kind	`thenM_`
-    returnM (L span ty')
+    do	{ (ty', act_kind) <- addErrCtxt (typeCtxt ty) $
+		    	     kc_hs_type ty
+		-- Add the context round the inner check only
+		-- because checkExpectedKind already mentions
+		-- 'ty' by name in any error message
+	; checkExpectedKind ty act_kind exp_kind
+	; return (L span ty') }
 \end{code}
 
 	Here comes the main function
@@ -576,6 +579,8 @@ gadtSigCtxt ty
 badGadtDecl ty
   = hang (ptext SLIT("Malformed constructor signature:"))
        2 (ppr ty)
+
+typeCtxt ty = ptext SLIT("In the type") <+> quotes (ppr ty)
 \end{code}
 
 %************************************************************************
-- 
1.7.10.4