Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alfredo Di Napoli
GHC
Commits
1a6810f8
Commit
1a6810f8
authored
Feb 14, 2002
by
simonpj
Browse files
[project @ 2002-02-14 14:01:09 by simonpj]
Do tcMonoExpr instead of tcExpr, here and there
parent
da0e7b0f
Changes
5
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/typecheck/TcExpr.hi-boot
View file @
1a6810f8
_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
View file @
1a6810f8
__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
View file @
1a6810f8
__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
View file @
1a6810f8
...
...
@@ -10,7 +10,7 @@ module TcMatches ( tcMatchesFun, tcMatchesCase, tcMatchLambda,
#include "HsVersions.h"
import {-# SOURCE #-} TcExpr( tcExpr )
import {-# SOURCE #-} TcExpr( tc
Mono
Expr )
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) ->
tc
Mono
Expr 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) ->
tc
Mono
Expr exp (m any_ty) `thenNF_Tc` \ (exp', lie) ->
returnTc (ExprStmt exp' any_ty locn, lie)
else
tcExpr exp boolTy `thenNF_Tc` \ (exp', lie) ->
tc
Mono
Expr 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)
tc
Mono
Expr exp (m res_elt_ty)
else
tcExpr exp res_elt_ty
tc
Mono
Expr exp res_elt_ty
) `thenTc` \ (exp', stmt_lie) ->
thing_inside `thenTc` \ (thing, stmts_lie) ->
...
...
ghc/compiler/typecheck/TcRules.lhs
View file @
1a6810f8
...
...
@@ -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 ( tc
Mono
Expr )
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) ->
tc
Mono
Expr lhs rule_ty `thenTc` \ (lhs', lhs_lie) ->
tc
Mono
Expr rhs rule_ty `thenTc` \ (rhs', rhs_lie) ->
returnTc (ids, lhs', rhs', lhs_lie, rhs_lie)
) `thenTc` \ (ids, lhs', rhs', lhs_lie, rhs_lie) ->
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment