Match(..), LMatch, GRHSs(..), GRHS(..),
Stmt(..), LStmt, HsMatchContext(..),
HsStmtContext(..),
- pprMatch, isIrrefutableHsPat, mkHsCoerce,
- mkLHsCoerce, pprMatchContext, pprStmtContext,
+ pprMatch, isIrrefutableHsPat, mkHsWrap,
+ mkLHsWrap, pprMatchContext, pprStmtContext,
noSyntaxExpr, matchGroupArity, pprMatches,
- ExprCoFn )
+ HsWrapper )
import TcRnMonad
import TcGadt ( Refinement, emptyRefinement, refineResType )
tcMatchesFun :: Name
-> MatchGroup Name
-> BoxyRhoType -- Expected type of function
- -> TcM (ExprCoFn, MatchGroup TcId) -- Returns type of body
+ -> TcM (HsWrapper, MatchGroup TcId) -- Returns type of body
tcMatchesFun fun_name matches exp_ty
= do { -- Check that they all have the same no of arguments
tcMatchesCase ctxt scrut_ty matches res_ty
= tcMatches ctxt [scrut_ty] res_ty matches
-tcMatchLambda :: MatchGroup Name -> BoxyRhoType -> TcM (ExprCoFn, MatchGroup TcId)
+tcMatchLambda :: MatchGroup Name -> BoxyRhoType -> TcM (HsWrapper, MatchGroup TcId)
tcMatchLambda match res_ty
= subFunTys doc n_pats res_ty $ \ pat_tys rhs_ty ->
tcMatches match_ctxt pat_tys rhs_ty match
= tcGRHSs ctxt grhss rhs_ty -- No result signature
-- Result type sigs are no longer supported
- tc_grhss ctxt (Just res_sig) grhss (co,rhs_ty)
+ tc_grhss ctxt (Just res_sig) grhss (co, rhs_ty)
= do { addErr (ptext SLIT("Ignoring (deprecated) result type signature")
<+> ppr res_sig)
- tcGRHSs ctxt grhss (co, inner_ty) }
+ ; tcGRHSs ctxt grhss (co, rhs_ty) }
-------------
tcGRHSs :: TcMatchCtxt -> GRHSs Name -> (Refinement, BoxyRhoType)
= do { traceTc (text "tcBody" <+> ppr res_ty <+> ppr reft)
; let (co, res_ty') = refineResType reft res_ty
; body' <- tcPolyExpr body res_ty'
- ; return (mkLHsCoerce co body') }
+ ; return (mkLHsWrap co body') }
\end{code}
-- poly_id may have a polymorphic type
-- but mono_ty is just a monomorphic type variable
; co_fn <- tcSubExp (idType poly_id) mono_ty
- ; return (mkHsCoerce co_fn (HsVar poly_id)) }
+ ; return (mkHsWrap co_fn (HsVar poly_id)) }
tcMDoStmt tc_rhs ctxt stmt res_ty thing_inside
= pprPanic "tcMDoStmt: unexpected Stmt" (ppr stmt)