+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module TcMatches ( tcMatchesFun, tcGRHSsPat, tcMatchesCase, tcMatchLambda,
matchCtxt, TcMatchCtxt(..),
tcStmts, tcDoStmts, tcBody,
module TcMatches ( tcMatchesFun, tcGRHSsPat, tcMatchesCase, tcMatchLambda,
matchCtxt, TcMatchCtxt(..),
tcStmts, tcDoStmts, tcBody,
-> MatchGroup Name
-> BoxyRhoType -- Expected type of function
-> TcM (HsWrapper, MatchGroup TcId) -- Returns type of body
-> MatchGroup Name
-> BoxyRhoType -- Expected type of function
-> TcM (HsWrapper, MatchGroup TcId) -- Returns type of body
= do { -- Check that they all have the same no of arguments
-- Location is in the monad, set the caller so that
-- any inter-equation error messages get some vaguely
= do { -- Check that they all have the same no of arguments
-- Location is in the monad, set the caller so that
-- any inter-equation error messages get some vaguely
doc = ptext SLIT("The equation(s) for") <+> quotes (ppr fun_name)
<+> ptext SLIT("have") <+> speakNOf n_pats (ptext SLIT("argument"))
n_pats = matchGroupArity matches
doc = ptext SLIT("The equation(s) for") <+> quotes (ppr fun_name)
<+> ptext SLIT("have") <+> speakNOf n_pats (ptext SLIT("argument"))
n_pats = matchGroupArity matches
= wrapLocM (tc_match ctxt pat_tys rhs_ty) match
where
tc_match ctxt pat_tys rhs_ty match@(Match pats maybe_rhs_sig grhss)
= wrapLocM (tc_match ctxt pat_tys rhs_ty) match
where
tc_match ctxt pat_tys rhs_ty match@(Match pats maybe_rhs_sig grhss)
do { (pats', grhss') <- tcLamPats pats pat_tys rhs_ty $
tc_grhss ctxt maybe_rhs_sig grhss
; return (Match pats' Nothing grhss') }
do { (pats', grhss') <- tcLamPats pats pat_tys rhs_ty $
tc_grhss ctxt maybe_rhs_sig grhss
; return (Match pats' Nothing grhss') }
+ -- 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
+