From: simonpj <unknown>
Date: Thu, 14 Feb 2002 14:01:10 +0000 (+0000)
Subject: [project @ 2002-02-14 14:01:09 by simonpj]
X-Git-Tag: Approximately_9120_patches~55
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=1a6810f82a831df06775ff78530c98dfd9ea3b2d;p=ghc-hetmet.git

[project @ 2002-02-14 14:01:09 by simonpj]
Do tcMonoExpr instead of tcExpr, here and there
---

diff --git a/ghc/compiler/typecheck/TcExpr.hi-boot b/ghc/compiler/typecheck/TcExpr.hi-boot
index 7db92e0..ffa855a 100644
--- a/ghc/compiler/typecheck/TcExpr.hi-boot
+++ b/ghc/compiler/typecheck/TcExpr.hi-boot
@@ -1,10 +1,14 @@
 _interface_ TcExpr 1
 _exports_
-TcExpr tcExpr ;
+TcExpr tcExpr tcMonoExpr ;
 _declarations_
 1 tcExpr _:_ _forall_ [s] => 
 	  RnHsSyn.RenamedHsExpr
        -> TcType.TcType
        -> TcMonad.TcM s (TcHsSyn.TcExpr, Inst.LIE) ;;
+1 tcMonoExpr _:_ _forall_ [s] => 
+	  RnHsSyn.RenamedHsExpr
+       -> TcType.TcType
+       -> TcMonad.TcM s (TcHsSyn.TcExpr, Inst.LIE) ;;
 
 
diff --git a/ghc/compiler/typecheck/TcExpr.hi-boot-5 b/ghc/compiler/typecheck/TcExpr.hi-boot-5
index 75e2ce9..6cafd02 100644
--- a/ghc/compiler/typecheck/TcExpr.hi-boot-5
+++ b/ghc/compiler/typecheck/TcExpr.hi-boot-5
@@ -1,6 +1,10 @@
 __interface TcExpr 1 0 where
-__export TcExpr tcExpr ;
+__export TcExpr tcExpr tcMonoExpr ;
 1 tcExpr :: 
 	  RnHsSyn.RenamedHsExpr
        -> TcType.TcType
        -> TcMonad.TcM (TcHsSyn.TcExpr, Inst.LIE) ;
+1 tcMonoExpr :: 
+	  RnHsSyn.RenamedHsExpr
+       -> TcType.TcType
+       -> TcMonad.TcM (TcHsSyn.TcExpr, Inst.LIE) ;
diff --git a/ghc/compiler/typecheck/TcExpr.hi-boot-6 b/ghc/compiler/typecheck/TcExpr.hi-boot-6
index 75e2ce9..6cafd02 100644
--- a/ghc/compiler/typecheck/TcExpr.hi-boot-6
+++ b/ghc/compiler/typecheck/TcExpr.hi-boot-6
@@ -1,6 +1,10 @@
 __interface TcExpr 1 0 where
-__export TcExpr tcExpr ;
+__export TcExpr tcExpr tcMonoExpr ;
 1 tcExpr :: 
 	  RnHsSyn.RenamedHsExpr
        -> TcType.TcType
        -> TcMonad.TcM (TcHsSyn.TcExpr, Inst.LIE) ;
+1 tcMonoExpr :: 
+	  RnHsSyn.RenamedHsExpr
+       -> TcType.TcType
+       -> TcMonad.TcM (TcHsSyn.TcExpr, Inst.LIE) ;
diff --git a/ghc/compiler/typecheck/TcMatches.lhs b/ghc/compiler/typecheck/TcMatches.lhs
index 57a5d94..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(..),
@@ -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) ->
diff --git a/ghc/compiler/typecheck/TcRules.lhs b/ghc/compiler/typecheck/TcRules.lhs
index 9f55b02..dcd93bc 100644
--- a/ghc/compiler/typecheck/TcRules.lhs
+++ b/ghc/compiler/typecheck/TcRules.lhs
@@ -18,8 +18,8 @@ import TcMType		( newTyVarTy )
 import TcType		( tyVarsOfTypes, openTypeKind )
 import TcIfaceSig	( tcCoreExpr, tcCoreLamBndrs, tcVar )
 import TcMonoType	( tcHsSigType, UserTypeCtxt(..), tcAddScopedTyVars )
-import TcExpr		( tcExpr )
-import TcEnv		( RecTcEnv, tcExtendLocalValEnv, tcLookupId )
+import TcExpr		( tcMonoExpr )
+import TcEnv		( tcExtendLocalValEnv, tcLookupId )
 import Inst		( LIE, plusLIEs, emptyLIE, instToId )
 import Id		( idName, idType, mkLocalId )
 import Outputable
@@ -67,8 +67,8 @@ tcSourceRule (HsRule name act vars lhs rhs src_loc)
 	tcExtendLocalValEnv [(idName id, id) | id <- ids]	$
 	
 		-- Now LHS and RHS
-	tcExpr lhs rule_ty					`thenTc` \ (lhs', lhs_lie) ->
-	tcExpr rhs rule_ty					`thenTc` \ (rhs', rhs_lie) ->
+	tcMonoExpr lhs rule_ty					`thenTc` \ (lhs', lhs_lie) ->
+	tcMonoExpr rhs rule_ty					`thenTc` \ (rhs', rhs_lie) ->
 	
 	returnTc (ids, lhs', rhs', lhs_lie, rhs_lie)
     )						`thenTc` \ (ids, lhs', rhs', lhs_lie, rhs_lie) ->