X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcMatches.lhs;h=68e1398972480836cb973866a99dcaefdb141f1b;hp=7f5dfadc70da65ba81f3c63d0e1abc04cb7a4e06;hb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8;hpb=27ca67931713c36f5ed248de88298416892e5649

diff --git a/compiler/typecheck/TcMatches.lhs b/compiler/typecheck/TcMatches.lhs
index 7f5dfad..68e1398 100644
--- a/compiler/typecheck/TcMatches.lhs
+++ b/compiler/typecheck/TcMatches.lhs
@@ -1,7 +1,9 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section[TcMatches]{Typecheck some @Matches@}
+
+TcMatches: Typecheck some @Matches@
 
 \begin{code}
 module TcMatches ( tcMatchesFun, tcGRHSsPat, tcMatchesCase, tcMatchLambda,
@@ -14,36 +16,24 @@ module TcMatches ( tcMatchesFun, tcGRHSsPat, tcMatchesCase, tcMatchLambda,
 
 import {-# SOURCE #-}	TcExpr( tcSyntaxOp, tcInferRho, tcMonoExpr, tcPolyExpr )
 
-import HsSyn		( HsExpr(..), LHsExpr, MatchGroup(..),
-			  Match(..), LMatch, GRHSs(..), GRHS(..), 
-			  Stmt(..), LStmt, HsMatchContext(..),
-			  HsStmtContext(..), 
-			  pprMatch, isIrrefutableHsPat, mkHsCoerce,
-			  mkLHsCoerce, pprMatchContext, pprStmtContext,  
-			  noSyntaxExpr, matchGroupArity, pprMatches,
-			  ExprCoFn )
-
+import HsSyn
 import TcRnMonad
-import TcGadt		( Refinement, emptyRefinement, refineResType )
-import Inst		( newMethodFromName )
-import TcEnv		( TcId, tcLookupLocalIds, tcLookupId, tcExtendIdEnv )
-import TcPat		( tcLamPats, tcLamPat )
-import TcMType		( newFlexiTyVarTy, newFlexiTyVarTys ) 
-import TcType		( TcType, TcRhoType, 
-			  BoxySigmaType, BoxyRhoType, 
-			  mkFunTys, mkFunTy, mkAppTy, mkTyConApp,
-			  liftedTypeKind )
-import TcBinds		( tcLocalBinds )
-import TcUnify		( boxySplitAppTy, boxySplitTyConApp, boxySplitListTy,
-			  subFunTys, tcSubExp, withBox )
-import TcSimplify	( bindInstsOfLocalFuns )
-import Name		( Name )
-import TysWiredIn	( stringTy, boolTy, parrTyCon, listTyCon, mkListTy, mkPArrTy )
-import PrelNames	( bindMName, returnMName, mfixName, thenMName, failMName )
-import Id		( idType, mkLocalId )
-import TyCon		( TyCon )
+import TcGadt
+import Inst
+import TcEnv
+import TcPat
+import TcMType
+import TcType
+import TcBinds
+import TcUnify
+import TcSimplify
+import Name
+import TysWiredIn
+import PrelNames
+import Id
+import TyCon
 import Outputable
-import SrcLoc		( Located(..), getLoc )
+import SrcLoc
 \end{code}
 
 %************************************************************************
@@ -61,7 +51,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 +92,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
@@ -260,7 +250,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 +467,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)