X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcExpr.lhs;h=51d6f4b6032601e357acd038cc46768baef87252;hb=46934dd87e13143ec2e97f075309a9e2c0945889;hp=2eb10ef8ce7c5ad285ea11a85035fe776672c55a;hpb=0db3e625ff0717f36495b375e6008995d6ffb0a3;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 2eb10ef..51d6f4b 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -12,7 +12,7 @@
 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
-module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcInferRho, tcInferRhoNC, tcSyntaxOp ) where
+module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC, tcInferRho, tcInferRhoNC, tcSyntaxOp, addExprErrCtxt ) where
 
 #include "HsVersions.h"
 
@@ -80,7 +80,7 @@ tcPolyExpr, tcPolyExprNC
 -- to do so himself.
 
 tcPolyExpr expr res_ty 	
-  = addErrCtxt (exprCtxt expr) $
+  = addExprErrCtxt expr $
     (do {traceTc (text "tcPolyExpr") ; tcPolyExprNC expr res_ty })
 
 tcPolyExprNC expr res_ty 
@@ -1189,9 +1189,11 @@ tcRecordBinds data_con arg_tys (HsRecFields rbinds dd)
 	do { rhs' <- tcPolyExprNC rhs field_ty
 	   ; let field_id = mkUserLocal (nameOccName field_lbl)
 				        (nameUnique field_lbl)
-					field_ty loc
-		-- The field_id has the *unique* of the selector Id
-		-- but is a LocalId with the appropriate type of the RHS
+					field_ty loc 
+		-- Yuk: the field_id has the *unique* of the selector Id
+		-- 	    (so we can find it easily)
+		--      but is a LocalId with the appropriate type of the RHS
+		--	    (so the desugarer knows the type of local binder to make)
 	   ; return (Just (fld { hsRecFieldId = L loc field_id, hsRecFieldArg = rhs' })) }
       | otherwise
       = do { addErrTc (badFieldCon data_con field_lbl)
@@ -1245,7 +1247,10 @@ checkMissingFields data_con rbinds
 
 Boring and alphabetical:
 \begin{code}
-exprCtxt (L _ expr)
+addExprErrCtxt :: OutputableBndr id => LHsExpr id -> TcM a -> TcM a
+addExprErrCtxt expr = addErrCtxt (exprCtxt (unLoc expr))
+
+exprCtxt expr
   = hang (ptext (sLit "In the expression:")) 4 (ppr expr)
 
 fieldCtxt field_name