X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcMatches.lhs;h=a99f93623ca3948fe26e4c2adcb9561bf7f386c8;hb=1a6810f82a831df06775ff78530c98dfd9ea3b2d;hp=ffee33901d7d71281e798534a7197629cfb47980;hpb=246dab8d62eaeb3e239c49b69ab3ad95299c1b38;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcMatches.lhs b/ghc/compiler/typecheck/TcMatches.lhs
index ffee339..a99f936 100644
--- a/ghc/compiler/typecheck/TcMatches.lhs
+++ b/ghc/compiler/typecheck/TcMatches.lhs
@@ -10,7 +10,7 @@ module TcMatches ( tcMatchesFun, tcMatchesCase, tcMatchLambda,
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}	TcExpr( tcExpr )
+import {-# SOURCE #-}	TcExpr( tcMonoExpr )
 
 import HsSyn		( HsBinds(..), Match(..), GRHSs(..), GRHS(..),
 			  MonoBinds(..), Stmt(..), HsMatchContext(..), HsDoContext(..),
@@ -24,7 +24,7 @@ import TcMonad
 import TcMonoType	( tcAddScopedTyVars, tcHsSigType, UserTypeCtxt(..) )
 import Inst		( LIE, isEmptyLIE, plusLIE, emptyLIE, plusLIEs, lieToList )
 import TcEnv		( TcId, tcLookupLocalIds, tcExtendLocalValEnv, tcExtendGlobalTyVars )
-import TcPat		( tcPat, tcMonoPatBndr, polyPatSig )
+import TcPat		( tcPat, tcMonoPatBndr )
 import TcMType		( newTyVarTy )
 import TcType		( TcType, TcTyVar, tyVarsOfType,
 			  mkFunTy, isOverloadedTy, liftedTypeKind, openTypeKind  )
@@ -358,7 +358,7 @@ tcStmtAndThen combine do_or_lc m_ty@(m,elt_ty) stmt@(BindStmt pat exp src_loc) t
   = tcAddSrcLoc src_loc					$
     tcAddErrCtxt (stmtCtxt do_or_lc stmt)		$
     newTyVarTy liftedTypeKind				`thenNF_Tc` \ pat_ty ->
-    tcExpr exp (m pat_ty)				`thenTc` \ (exp', exp_lie) ->
+    tcMonoExpr exp (m pat_ty)				`thenTc` \ (exp', exp_lie) ->
     tcMatchPats [pat] (mkFunTy pat_ty (m elt_ty))	(\ [pat'] _ ->
 	tcPopErrCtxt 				$
 	thing_inside 				`thenTc` \ (thing, lie) ->
@@ -395,10 +395,10 @@ tcStmtAndThen combine do_or_lc m_ty@(m, res_elt_ty) stmt@(ExprStmt exp _ locn) t
   = tcSetErrCtxt (stmtCtxt do_or_lc stmt) (
 	if isDoExpr do_or_lc then
 		newTyVarTy openTypeKind 	`thenNF_Tc` \ any_ty ->
-		tcExpr exp (m any_ty)		`thenNF_Tc` \ (exp', lie) ->
+		tcMonoExpr exp (m any_ty)	`thenNF_Tc` \ (exp', lie) ->
 		returnTc (ExprStmt exp' any_ty locn, lie)
 	else
-		tcExpr exp boolTy		`thenNF_Tc` \ (exp', lie) ->
+		tcMonoExpr exp boolTy		`thenNF_Tc` \ (exp', lie) ->
 		returnTc (ExprStmt exp' boolTy locn, lie)
     )						`thenTc` \ (stmt', stmt_lie) ->
 
@@ -411,9 +411,9 @@ tcStmtAndThen combine do_or_lc m_ty@(m, res_elt_ty) stmt@(ExprStmt exp _ locn) t
 tcStmtAndThen combine do_or_lc m_ty@(m, res_elt_ty) stmt@(ResultStmt exp locn) thing_inside
   = tcSetErrCtxt (stmtCtxt do_or_lc stmt) (
 	if isDoExpr do_or_lc then
-		tcExpr exp (m res_elt_ty)
+		tcMonoExpr exp (m res_elt_ty)
 	else
-		tcExpr exp res_elt_ty
+		tcMonoExpr exp res_elt_ty
     )						`thenTc` \ (exp', stmt_lie) ->
 
     thing_inside 				`thenTc` \ (thing, stmts_lie) ->