Commit 1a6810f8 authored by simonpj's avatar simonpj
Browse files

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

Do tcMonoExpr instead of tcExpr, here and there
parent da0e7b0f
_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) ;;
__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) ;
__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) ;
......@@ -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) ->
......
......@@ -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) ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment