[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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) ->