[project @ 2002-02-14 14:01:09 by simonpj]

Do tcMonoExpr instead of tcExpr, here and there

ghc/compiler/typecheck/TcExpr.hi-boot

 _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) ;;
 
 

ghc/compiler/typecheck/TcExpr.hi-boot-5

 __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) ;

ghc/compiler/typecheck/TcExpr.hi-boot-6

 __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) ;

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) ->

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) ->