X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcExpr.lhs;h=e6ab82b2636a4765b478facf57835c98c64904fa;hp=4eb7b10450d06ff119314f4e509406b56d472a05;hb=e6d057711f4d6d6ff6342c39fa2b9e44d25447f1;hpb=f80b81f8b56ebd0fa0f7f82494a5090e9ab64256

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 4eb7b10..e6ab82b 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -21,8 +21,8 @@ import qualified DsMeta
 #endif
 
 import HsSyn		( HsExpr(..), LHsExpr, ArithSeqInfo(..), recBindFields,
-			  HsMatchContext(..), HsRecordBinds, mkHsCoerce,
-			  mkHsApp )
+			  HsMatchContext(..), HsRecordBinds, mkHsWrap,
+			  mkHsApp, mkLHsWrap )
 import TcHsSyn		( hsLitType )
 import TcRnMonad
 import TcUnify		( tcInfer, tcSubExp, tcFunResTy, tcGen, boxyUnify, subFunTys, zapToMonotype, stripBoxyType,
@@ -52,7 +52,7 @@ import TcType		( TcType, TcSigmaType, TcRhoType, TvSubst,
 import {- Kind parts of -} 
        Type		( argTypeKind )
 
-import Id		( Id, idType, recordSelectorFieldLabel,
+import Id		( idType, recordSelectorFieldLabel,
 			  isRecordSelector, isNaughtyRecordSelector,
 			  isDataConId_maybe )
 import DataCon		( DataCon, dataConFieldLabels, dataConStrictMarks,
@@ -76,7 +76,7 @@ import PrimOp		( tagToEnumKey )
 import DynFlags
 import StaticFlags	( opt_NoMethodSharing )
 import HscTypes		( TyThing(..) )
-import SrcLoc		( Located(..), unLoc, getLoc )
+import SrcLoc		( Located(..), unLoc )
 import Util
 import ListSetOps	( assocMaybe )
 import Maybes		( catMaybes )
@@ -114,7 +114,7 @@ tcPolyExprNC expr res_ty
   = do	{ (gen_fn, expr') <- tcGen res_ty emptyVarSet (tcPolyExprNC expr)
 		-- Note the recursive call to tcPolyExpr, because the
 		-- type may have multiple layers of for-alls
-	; return (L (getLoc expr') (mkHsCoerce gen_fn (unLoc expr'))) }
+	; return (mkLHsWrap gen_fn expr') }
 
   | otherwise
   = tcMonoExpr expr res_ty
@@ -190,7 +190,7 @@ tcExpr (HsIPVar ip) res_ty
 	; co_fn <- tcSubExp ip_ty res_ty
 	; (ip', inst) <- newIPDict (IPOccOrigin ip) ip ip_ty
 	; extendLIE inst
-	; return (mkHsCoerce co_fn (HsIPVar ip')) }
+	; return (mkHsWrap co_fn (HsIPVar ip')) }
 
 tcExpr (HsApp e1 e2) res_ty 
   = go e1 [e2]
@@ -204,13 +204,13 @@ tcExpr (HsApp e1 e2) res_ty
 
 tcExpr (HsLam match) res_ty
   = do	{ (co_fn, match') <- tcMatchLambda match res_ty
-	; return (mkHsCoerce co_fn (HsLam match')) }
+	; return (mkHsWrap co_fn (HsLam match')) }
 
 tcExpr in_expr@(ExprWithTySig expr sig_ty) res_ty
  = do	{ sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
 	; expr' <- tcPolyExpr expr sig_tc_ty
 	; co_fn <- tcSubExp sig_tc_ty res_ty
-	; return (mkHsCoerce co_fn (ExprWithTySigOut expr' sig_ty)) }
+	; return (mkHsWrap co_fn (ExprWithTySigOut expr' sig_ty)) }
 
 tcExpr (HsType ty) res_ty
   = failWithTc (text "Can't handle type argument:" <+> ppr ty)
@@ -256,7 +256,7 @@ tcExpr in_expr@(SectionL arg1 lop@(L loc op)) res_ty
 tcExpr in_expr@(SectionR lop@(L loc op) arg2) res_ty
   = do	{ (co_fn, (op', arg2')) <- subFunTys doc 1 res_ty $ \ [arg1_ty'] res_ty' ->
 				   tcApp op 2 (tc_args arg1_ty') res_ty'
-	; return (mkHsCoerce co_fn (SectionR (L loc op') arg2')) }
+	; return (mkHsWrap co_fn (SectionR (L loc op') arg2')) }
   where
     doc = ptext SLIT("The section") <+> quotes (ppr in_expr)
 		<+> ptext SLIT("takes one argument")
@@ -496,7 +496,7 @@ tcExpr expr@(RecordUpd record_expr rbinds _ _) res_ty
     instStupidTheta RecordUpdOrigin theta'	`thenM_`
 
 	-- Phew!
-    returnM (mkHsCoerce co_fn (RecordUpd record_expr' rbinds' record_ty result_record_ty))
+    returnM (mkHsWrap co_fn (RecordUpd record_expr' rbinds' record_ty result_record_ty))
 \end{code}
 
 
@@ -686,7 +686,7 @@ tcIdApp fun_name n_args arg_checker res_ty
 	-- tcFun work nicely for OpApp and Sections too
 	; fun' <- instFun orig fun res_subst tv_theta_prs
 	; co_fn' <- wrapFunResCoercion fun_arg_tys' co_fn
-	; return (mkHsCoerce co_fn' fun', args') }
+	; return (mkHsWrap co_fn' fun', args') }
 \end{code}
 
 Note [Silly type synonyms in smart-app]
@@ -729,7 +729,7 @@ tcId orig fun_name res_ty
 
 	-- And pack up the results
 	; fun' <- instFun orig fun res_subst tv_theta_prs 
-	; return (mkHsCoerce co_fn fun') }
+	; return (mkHsWrap co_fn fun') }
 
 -- 	Note [Push result type in]
 --
@@ -794,7 +794,7 @@ instFun orig fun subst tv_theta_prs
 
     go _ fun ((tys, theta) : prs)
 	= do { co_fn <- instCall orig tys theta
-	     ; go False (HsCoerce co_fn fun) prs }
+	     ; go False (HsWrap co_fn fun) prs }
 
 	-- 	Hack Alert (want_method_inst)!
 	-- See Note [No method sharing]
@@ -951,7 +951,7 @@ lookupFun orig id_name
 		-> do { thLocalId orig id ty lvl
 		      ; case mb_co of
 			  Nothing -> return (HsVar id, ty)	-- Wobbly, or no free vars
-			  Just co -> return (mkHsCoerce co (HsVar id), ty) }	
+			  Just co -> return (mkHsWrap co (HsVar id), ty) }	
 
     	    other -> failWithTc (ppr other <+> ptext SLIT("used where a value identifer was expected"))
     }