X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcMatches.lhs;h=485aacb1d21edbbb76307cea10b005ee7410b2fe;hp=68e1398972480836cb973866a99dcaefdb141f1b;hb=b99310f05faee2abec850da4349fcd5c0498f7ca;hpb=ca002f96c4ff5e7a2d4a4742d98bccd431e9db15

diff --git a/compiler/typecheck/TcMatches.lhs b/compiler/typecheck/TcMatches.lhs
index 68e1398..485aacb 100644
--- a/compiler/typecheck/TcMatches.lhs
+++ b/compiler/typecheck/TcMatches.lhs
@@ -153,7 +153,7 @@ tcMatch ctxt pat_tys rhs_ty match
   = wrapLocM (tc_match ctxt pat_tys rhs_ty) match
   where
     tc_match ctxt pat_tys rhs_ty match@(Match pats maybe_rhs_sig grhss)
-      = addErrCtxt (matchCtxt (mc_what ctxt) match)	$	
+      = add_match_ctxt match $
         do { (pats', grhss') <- tcLamPats pats pat_tys rhs_ty $
     			        tc_grhss ctxt maybe_rhs_sig grhss
 	   ; return (Match pats' Nothing grhss') }
@@ -167,6 +167,13 @@ tcMatch ctxt pat_tys rhs_ty match
 			<+> ppr res_sig)
     	   ; tcGRHSs ctxt grhss (co, rhs_ty) }
 
+	-- For (\x -> e), tcExpr has already said "In the expresssion \x->e"
+	-- so we don't want to add "In the lambda abstraction \x->e"
+    add_match_ctxt match thing_inside
+	= case mc_what ctxt of
+	    LambdaExpr -> thing_inside
+	    m_ctxt     -> addErrCtxt (matchCtxt m_ctxt match) thing_inside
+
 -------------
 tcGRHSs :: TcMatchCtxt -> GRHSs Name -> (Refinement, BoxyRhoType) 
 	-> TcM (GRHSs TcId)