X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcMatches.lhs;h=d9146d9041297398e858ccd900b8dc077c385902;hb=365ab3dad0f9a77e01758a14bf3817dea0ee2a31;hp=61faca8d3e28ec04fc9e2c3308ba9e231eceaa4a;hpb=3e83dfb21b2f2220dce97427fff5c19459ae68d1;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcMatches.lhs b/compiler/typecheck/TcMatches.lhs
index 61faca8..d9146d9 100644
--- a/compiler/typecheck/TcMatches.lhs
+++ b/compiler/typecheck/TcMatches.lhs
@@ -18,10 +18,10 @@ import HsSyn		( HsExpr(..), LHsExpr, MatchGroup(..),
 			  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 )
@@ -61,7 +61,7 @@ same number of arguments before using @tcMatches@ to do the work.
 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
@@ -102,7 +102,7 @@ tcMatchesCase :: TcMatchCtxt		-- Case context
 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
@@ -172,10 +172,10 @@ tcMatch 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) 
@@ -260,7 +260,7 @@ tcBody body (reft, res_ty)
   = 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}
 
 
@@ -477,7 +477,7 @@ tcMDoStmt tc_rhs ctxt (RecStmt stmts laterNames recNames _ _) res_ty thing_insid
 		-- 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)