projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2003-12-10 17:25:12 by simonmar]
[ghc-hetmet.git]
/
ghc
/
compiler
/
typecheck
/
TcRnDriver.lhs
diff --git
a/ghc/compiler/typecheck/TcRnDriver.lhs
b/ghc/compiler/typecheck/TcRnDriver.lhs
index
92526ee
..
7b0a63d
100644
(file)
--- a/
ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/
ghc/compiler/typecheck/TcRnDriver.lhs
@@
-21,14
+21,11
@@
import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
import CmdLineOpts ( DynFlag(..), opt_PprStyle_Debug, dopt )
import DriverState ( v_MainModIs, v_MainFunIs )
import CmdLineOpts ( DynFlag(..), opt_PprStyle_Debug, dopt )
import DriverState ( v_MainModIs, v_MainFunIs )
-import HsSyn ( HsModule(..), HsBinds(..), MonoBinds(..), HsExpr(..),
- HsGroup(..), SpliceDecl(..), HsExtCore(..),
- andMonoBinds
- )
-import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl,
- findSplice, main_RDR_Unqual )
+import HsSyn
+import RdrHsSyn ( findSplice )
-import PrelNames ( runIOName, rootMainName, mAIN_Name )
+import PrelNames ( runIOName, rootMainName, mAIN_Name,
+ main_RDR_Unqual )
import RdrName ( RdrName, mkRdrUnqual, emptyGlobalRdrEnv,
plusGlobalRdrEnv )
import TcHsSyn ( zonkTopDecls )
import RdrName ( RdrName, mkRdrUnqual, emptyGlobalRdrEnv,
plusGlobalRdrEnv )
import TcHsSyn ( zonkTopDecls )
@@
-60,9
+57,9
@@
import OccName ( mkVarOcc )
import Name ( Name, isExternalName, getSrcLoc, getOccName )
import NameSet
import TyCon ( tyConHasGenerics )
import Name ( Name, isExternalName, getSrcLoc, getOccName )
import NameSet
import TyCon ( tyConHasGenerics )
+import SrcLoc ( srcLocSpan, Located(..), noLoc )
import Outputable
import Outputable
-import HscTypes ( ModIface, ModDetails(..), ModGuts(..),
- HscEnv(..), ModIface(..), ModDetails(..),
+import HscTypes ( ModGuts(..), HscEnv(..),
GhciMode(..), noDependencies,
Deprecs( NoDeprecs ), plusDeprecs,
GenAvailInfo(Avail), availsToNameSet, availName,
GhciMode(..), noDependencies,
Deprecs( NoDeprecs ), plusDeprecs,
GenAvailInfo(Avail), availsToNameSet, availName,
@@
-72,15
+69,13
@@
import HscTypes ( ModIface, ModDetails(..), ModGuts(..),
)
#ifdef GHCI
import HsSyn ( HsStmtContext(..),
)
#ifdef GHCI
import HsSyn ( HsStmtContext(..),
- Stmt(..), Pat(VarPat),
+ Stmt(..),
collectStmtsBinders, mkSimpleMatch, placeHolderType )
collectStmtsBinders, mkSimpleMatch, placeHolderType )
-import RdrHsSyn ( RdrNameHsExpr, RdrNameStmt )
import RdrName ( GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
Provenance(..), ImportSpec(..),
lookupLocalRdrEnv, extendLocalRdrEnv )
import RdrName ( GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
Provenance(..), ImportSpec(..),
lookupLocalRdrEnv, extendLocalRdrEnv )
-import RnHsSyn ( RenamedStmt )
import RnSource ( addTcgDUs )
import RnSource ( addTcgDUs )
-import TcHsSyn ( TypecheckedHsExpr, mkHsLet, zonkTopExpr, zonkTopBndrs )
+import TcHsSyn ( mkHsLet, zonkTopLExpr, zonkTopBndrs )
import TcExpr ( tcCheckRho )
import TcMType ( zonkTcType )
import TcMatches ( tcStmtsAndThen, TcStmtCtxt(..) )
import TcExpr ( tcCheckRho )
import TcMType ( zonkTcType )
import TcMatches ( tcStmtsAndThen, TcStmtCtxt(..) )
@@
-89,18
+84,17
@@
import TcType ( Type, mkForAllTys, mkFunTys, mkTyConApp, tyVarsOfType )
import TcEnv ( tcLookupTyCon, tcLookupId )
import TyCon ( DataConDetails(..) )
import Inst ( tcStdSyntaxName )
import TcEnv ( tcLookupTyCon, tcLookupId )
import TyCon ( DataConDetails(..) )
import Inst ( tcStdSyntaxName )
-import RnExpr ( rnStmts, rnExpr )
+import RnExpr ( rnStmts, rnLExpr )
import RnNames ( exportsToAvails )
import LoadIface ( loadSrcInterface )
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceExtName(..),
tyThingToIfaceDecl )
import RnNames ( exportsToAvails )
import LoadIface ( loadSrcInterface )
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceExtName(..),
tyThingToIfaceDecl )
-import IfaceEnv ( tcIfaceGlobal )
import RnEnv ( lookupOccRn, dataTcOccs, lookupFixityRn )
import Id ( Id, isImplicitId )
import MkId ( unsafeCoerceId )
import TysWiredIn ( mkListTy, unitTy )
import IdInfo ( GlobalIdDetails(..) )
import RnEnv ( lookupOccRn, dataTcOccs, lookupFixityRn )
import Id ( Id, isImplicitId )
import MkId ( unsafeCoerceId )
import TysWiredIn ( mkListTy, unitTy )
import IdInfo ( GlobalIdDetails(..) )
-import SrcLoc ( interactiveSrcLoc )
+import SrcLoc ( interactiveSrcLoc, unLoc )
import Var ( setGlobalIdDetails )
import Name ( nameOccName, nameModuleName )
import NameEnv ( delListFromNameEnv )
import Var ( setGlobalIdDetails )
import Name ( nameOccName, nameModuleName )
import NameEnv ( delListFromNameEnv )
@@
-108,13
+102,18
@@
import PrelNames ( iNTERACTIVE, ioTyConName, printName, monadNames, itName, retu
import Module ( ModuleName, lookupModuleEnvByName )
import HscTypes ( InteractiveContext(..),
HomeModInfo(..), typeEnvElts,
import Module ( ModuleName, lookupModuleEnvByName )
import HscTypes ( InteractiveContext(..),
HomeModInfo(..), typeEnvElts,
- TyThing(..), availNames, icPrintUnqual )
+ TyThing(..), availNames, icPrintUnqual,
+ ModIface(..), ModDetails(..) )
import BasicTypes ( RecFlag(..), Fixity )
import BasicTypes ( RecFlag(..), Fixity )
+import Bag ( unitBag )
import Panic ( ghcError, GhcException(..) )
#endif
import FastString ( mkFastString )
import Util ( sortLt )
import Panic ( ghcError, GhcException(..) )
#endif
import FastString ( mkFastString )
import Util ( sortLt )
+import Bag ( unionBags, snocBag )
+
+import Maybe ( isJust )
\end{code}
\end{code}
@@
-128,18
+127,21
@@
import Util ( sortLt )
\begin{code}
tcRnModule :: HscEnv
\begin{code}
tcRnModule :: HscEnv
- -> RdrNameHsModule
+ -> Located (HsModule RdrName)
-> IO (Maybe TcGblEnv)
-> IO (Maybe TcGblEnv)
-tcRnModule hsc_env
- (HsModule maybe_mod exports import_decls local_decls mod_deprec loc)
+tcRnModule hsc_env (L loc (HsModule maybe_mod exports
+ import_decls local_decls mod_deprec))
= do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
let { this_mod = case maybe_mod of
= do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
let { this_mod = case maybe_mod of
- Nothing -> mkHomeModule mAIN_Name -- 'module M where' is omitted
- Just mod -> mod } ; -- The normal case
+ Nothing -> mkHomeModule mAIN_Name
+ -- 'module M where' is omitted
+ Just (L _ mod) -> mod } ;
+ -- The normal case
- initTc hsc_env this_mod $ addSrcLoc loc $
+ initTc hsc_env this_mod $
+ addSrcSpan loc $
do { -- Deal with imports; sets tcg_rdr_env, tcg_imports
(rdr_env, imports) <- rnImports import_decls ;
updGblEnv ( \ gbl -> gbl { tcg_rdr_env = rdr_env,
do { -- Deal with imports; sets tcg_rdr_env, tcg_imports
(rdr_env, imports) <- rnImports import_decls ;
updGblEnv ( \ gbl -> gbl { tcg_rdr_env = rdr_env,
@@
-163,7
+165,7
@@
tcRnModule hsc_env
traceRn (text "rn3") ;
-- Process the export list
traceRn (text "rn3") ;
-- Process the export list
- export_avails <- exportsFromAvail maybe_mod exports ;
+ export_avails <- exportsFromAvail (isJust maybe_mod) exports ;
-- Get any supporting decls for the exports that have not already
-- been sucked in for the declarations in the body of the module.
-- Get any supporting decls for the exports that have not already
-- been sucked in for the declarations in the body of the module.
@@
-209,8
+211,8
@@
tcRnModule hsc_env
#ifdef GHCI
tcRnStmt :: HscEnv
-> InteractiveContext
#ifdef GHCI
tcRnStmt :: HscEnv
-> InteractiveContext
- -> RdrNameStmt
- -> IO (Maybe (InteractiveContext, [Name], TypecheckedHsExpr))
+ -> LStmt RdrName
+ -> IO (Maybe (InteractiveContext, [Name], LHsExpr Id))
-- The returned [Name] is the same as the input except for
-- ExprStmt, in which case the returned [Name] is [itName]
--
-- The returned [Name] is the same as the input except for
-- ExprStmt, in which case the returned [Name] is [itName]
--
@@
-290,23
+292,24
@@
Here is the grand plan, implemented in tcUserStmt
\begin{code}
---------------------------
\begin{code}
---------------------------
-tcUserStmt :: RenamedStmt -> TcM ([Id], TypecheckedHsExpr)
-tcUserStmt (ExprStmt expr _ loc)
+tcUserStmt :: LStmt Name -> TcM ([Id], LHsExpr Id)
+tcUserStmt (L _ (ExprStmt expr _))
= newUnique `thenM` \ uniq ->
let
fresh_it = itName uniq
= newUnique `thenM` \ uniq ->
let
fresh_it = itName uniq
- the_bind = FunMonoBind fresh_it False
- [ mkSimpleMatch [] expr placeHolderType loc ] loc
+ the_bind = noLoc $ FunBind (noLoc fresh_it) False
+ [ mkSimpleMatch [] expr placeHolderType ]
in
tryTcLIE_ (do { -- Try this if the other fails
traceTc (text "tcs 1b") ;
tc_stmts [
in
tryTcLIE_ (do { -- Try this if the other fails
traceTc (text "tcs 1b") ;
tc_stmts [
- LetStmt (MonoBind the_bind [] NonRecursive),
- ExprStmt (HsApp (HsVar printName) (HsVar fresh_it))
- placeHolderType loc] })
+ nlLetStmt [HsBindGroup (unitBag the_bind) [] NonRecursive],
+ nlExprStmt (nlHsApp (nlHsVar printName)
+ (nlHsVar fresh_it))
+ ] })
(do { -- Try this first
traceTc (text "tcs 1a") ;
(do { -- Try this first
traceTc (text "tcs 1a") ;
- tc_stmts [BindStmt (VarPat fresh_it) expr loc] })
+ tc_stmts [nlBindStmt (nlVarPat fresh_it) expr] })
tcUserStmt stmt = tc_stmts [stmt]
tcUserStmt stmt = tc_stmts [stmt]
@@
-317,7
+320,7
@@
tc_stmts stmts
ret_ty = mkListTy unitTy ;
io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
ret_ty = mkListTy unitTy ;
io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
- names = collectStmtsBinders stmts ;
+ names = map unLoc (collectStmtsBinders stmts) ;
stmt_ctxt = SC { sc_what = DoExpr,
sc_rhs = check_rhs,
stmt_ctxt = SC { sc_what = DoExpr,
sc_rhs = check_rhs,
@@
-338,10
+341,10
@@
tc_stmts stmts
-- then the type checker would instantiate x..z, and we wouldn't
-- get their *polymorphic* values. (And we'd get ambiguity errs
-- if they were overloaded, since they aren't applied to anything.)
-- then the type checker would instantiate x..z, and we wouldn't
-- get their *polymorphic* values. (And we'd get ambiguity errs
-- if they were overloaded, since they aren't applied to anything.)
- mk_return ret_id ids = HsApp (TyApp (HsVar ret_id) [ret_ty])
- (ExplicitList unitTy (map mk_item ids)) ;
- mk_item id = HsApp (TyApp (HsVar unsafeCoerceId) [idType id, unitTy])
- (HsVar id) ;
+ mk_return ret_id ids = nlHsApp (noLoc $ TyApp (nlHsVar ret_id) [ret_ty])
+ (noLoc $ ExplicitList unitTy (map mk_item ids)) ;
+ mk_item id = nlHsApp (noLoc $ TyApp (nlHsVar unsafeCoerceId) [idType id, unitTy])
+ (nlHsVar id) ;
io_ty = mkTyConApp ioTyCon []
} ;
io_ty = mkTyConApp ioTyCon []
} ;
@@
-355,10
+358,10
@@
tc_stmts stmts
-- where they will all be in scope
ids <- mappM tcLookupId names ;
ret_id <- tcLookupId returnIOName ; -- return @ IO
-- where they will all be in scope
ids <- mappM tcLookupId names ;
ret_id <- tcLookupId returnIOName ; -- return @ IO
- return (ids, [ResultStmt (mk_return ret_id ids) interactiveSrcLoc]) } ;
+ return (ids, [nlResultStmt (mk_return ret_id ids)]) } ;
io_ids <- mappM (tcStdSyntaxName DoOrigin io_ty) monadNames ;
io_ids <- mappM (tcStdSyntaxName DoOrigin io_ty) monadNames ;
- return (ids, HsDo DoExpr tc_stmts io_ids io_ret_ty interactiveSrcLoc)
+ return (ids, noLoc (HsDo DoExpr tc_stmts io_ids io_ret_ty))
} ;
-- Simplify the context right here, so that we fail
} ;
-- Simplify the context right here, so that we fail
@@
-372,7
+375,7
@@
tc_stmts stmts
-- Build result expression and zonk it
let { expr = mkHsLet const_binds tc_expr } ;
-- Build result expression and zonk it
let { expr = mkHsLet const_binds tc_expr } ;
- zonked_expr <- zonkTopExpr expr ;
+ zonked_expr <- zonkTopLExpr expr ;
zonked_ids <- zonkTopBndrs ids ;
return (zonked_ids, zonked_expr)
zonked_ids <- zonkTopBndrs ids ;
return (zonked_ids, zonked_expr)
@@
-387,13
+390,13
@@
tcRnExpr just finds the type of an expression
\begin{code}
tcRnExpr :: HscEnv
-> InteractiveContext
\begin{code}
tcRnExpr :: HscEnv
-> InteractiveContext
- -> RdrNameHsExpr
+ -> LHsExpr RdrName
-> IO (Maybe Type)
tcRnExpr hsc_env ictxt rdr_expr
= initTc hsc_env iNTERACTIVE $
setInteractiveContext ictxt $ do {
-> IO (Maybe Type)
tcRnExpr hsc_env ictxt rdr_expr
= initTc hsc_env iNTERACTIVE $
setInteractiveContext ictxt $ do {
- (rn_expr, fvs) <- rnExpr rdr_expr ;
+ (rn_expr, fvs) <- rnLExpr rdr_expr ;
failIfErrsM ;
-- Now typecheck the expression;
failIfErrsM ;
-- Now typecheck the expression;
@@
-497,15
+500,17
@@
tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
initTc hsc_env this_mod $ do {
initTc hsc_env this_mod $ do {
+ let { ldecls = map noLoc decls } ;
+
-- Deal with the type declarations; first bring their stuff
-- into scope, then rname them, then type check them
-- Deal with the type declarations; first bring their stuff
-- into scope, then rname them, then type check them
- (rdr_env, imports) <- importsFromLocalDecls (mkFakeGroup decls) ;
+ (rdr_env, imports) <- importsFromLocalDecls (mkFakeGroup ldecls) ;
updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv` tcg_rdr_env gbl,
tcg_imports = imports `plusImportAvails` tcg_imports gbl })
$ do {
updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv` tcg_rdr_env gbl,
tcg_imports = imports `plusImportAvails` tcg_imports gbl })
$ do {
- rn_decls <- rnTyClDecls decls ;
+ rn_decls <- rnTyClDecls ldecls ;
failIfErrsM ;
-- Dump trace of renaming part
failIfErrsM ;
-- Dump trace of renaming part
@@
-553,7
+558,7
@@
tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
mkFakeGroup decls -- Rather clumsy; lots of unused fields
= HsGroup { hs_tyclds = decls, -- This is the one we want
mkFakeGroup decls -- Rather clumsy; lots of unused fields
= HsGroup { hs_tyclds = decls, -- This is the one we want
- hs_valds = EmptyBinds, hs_fords = [],
+ hs_valds = [], hs_fords = [],
hs_instds = [], hs_fixds = [], hs_depds = [],
hs_ruleds = [], hs_defds = [] }
\end{code}
hs_instds = [], hs_fixds = [], hs_depds = [],
hs_ruleds = [], hs_defds = [] }
\end{code}
@@
-566,7
+571,7
@@
mkFakeGroup decls -- Rather clumsy; lots of unused fields
%************************************************************************
\begin{code}
%************************************************************************
\begin{code}
-tcRnSrcDecls :: [RdrNameHsDecl] -> TcM TcGblEnv
+tcRnSrcDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
-- Returns the variables free in the decls
-- Reason: solely to report unused imports and bindings
tcRnSrcDecls decls
-- Returns the variables free in the decls
-- Reason: solely to report unused imports and bindings
tcRnSrcDecls decls
@@
-592,7
+597,7
@@
tcRnSrcDecls decls
TcGblEnv { tcg_type_env = type_env, tcg_binds = binds,
tcg_rules = rules, tcg_fords = fords } = tcg_env } ;
TcGblEnv { tcg_type_env = type_env, tcg_binds = binds,
tcg_rules = rules, tcg_fords = fords } = tcg_env } ;
- (bind_ids, binds', fords', rules') <- zonkTopDecls (binds `andMonoBinds` inst_binds)
+ (bind_ids, binds', fords', rules') <- zonkTopDecls (binds `unionBags` inst_binds)
rules fords ;
let { final_type_env = extendTypeEnvWithIds type_env bind_ids } ;
rules fords ;
let { final_type_env = extendTypeEnvWithIds type_env bind_ids } ;
@@
-604,7
+609,7
@@
tcRnSrcDecls decls
tcg_binds = binds', tcg_rules = rules', tcg_fords = fords' })
}
tcg_binds = binds', tcg_rules = rules', tcg_fords = fords' })
}
-tc_rn_src_decls :: [RdrNameHsDecl] -> TcM (TcGblEnv, TcLclEnv)
+tc_rn_src_decls :: [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
-- Loops around dealing with each top level inter-splice group
-- in turn, until it's dealt with the entire module
tc_rn_src_decls ds
-- Loops around dealing with each top level inter-splice group
-- in turn, until it's dealt with the entire module
tc_rn_src_decls ds
@@
-629,14
+634,13
@@
tc_rn_src_decls ds
} ;
-- If there's a splice, we must carry on
} ;
-- If there's a splice, we must carry on
- Just (SpliceDecl splice_expr splice_loc, rest_ds) -> do {
+ Just (SpliceDecl splice_expr, rest_ds) -> do {
#ifndef GHCI
failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
#else
-- Rename the splice expression, and get its supporting decls
#ifndef GHCI
failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
#else
-- Rename the splice expression, and get its supporting decls
- (rn_splice_expr, splice_fvs) <- addSrcLoc splice_loc $
- rnExpr splice_expr ;
+ (rn_splice_expr, splice_fvs) <- rnLExpr splice_expr ;
failIfErrsM ; -- Don't typecheck if renaming failed
-- Execute the splice
failIfErrsM ; -- Don't typecheck if renaming failed
-- Execute the splice
@@
-688,6
+692,7
@@
rnTopSrcDecls group
tcg_imports = imports `plusImportAvails` tcg_imports gbl })
$ do {
tcg_imports = imports `plusImportAvails` tcg_imports gbl })
$ do {
+ traceRn (ptext SLIT("rnTopSrcDecls") <+> ppr rdr_env) ;
failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
-- Rename the source decls
failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
-- Rename the source decls
@@
-743,7
+748,7
@@
tcTopSrcDecls
-- We also typecheck any extra binds that came out
-- of the "deriving" process (deriv_binds)
traceTc (text "Tc5") ;
-- We also typecheck any extra binds that came out
-- of the "deriving" process (deriv_binds)
traceTc (text "Tc5") ;
- (tc_val_binds, lcl_env) <- tcTopBinds (val_binds `ThenBinds` deriv_binds) ;
+ (tc_val_binds, lcl_env) <- tcTopBinds (val_binds ++ deriv_binds) ;
setLclTypeEnv lcl_env $ do {
-- Second pass over class and instance declarations,
setLclTypeEnv lcl_env $ do {
-- Second pass over class and instance declarations,
@@
-762,13
+767,13
@@
tcTopSrcDecls
-- Wrap up
traceTc (text "Tc7a") ;
tcg_env <- getGblEnv ;
-- Wrap up
traceTc (text "Tc7a") ;
tcg_env <- getGblEnv ;
- let { all_binds = tc_val_binds `AndMonoBinds`
- inst_binds `AndMonoBinds`
+ let { all_binds = tc_val_binds `unionBags`
+ inst_binds `unionBags`
foe_binds ;
-- Extend the GblEnv with the (as yet un-zonked)
-- bindings, rules, foreign decls
foe_binds ;
-- Extend the GblEnv with the (as yet un-zonked)
-- bindings, rules, foreign decls
- tcg_env' = tcg_env { tcg_binds = tcg_binds tcg_env `andMonoBinds` all_binds,
+ tcg_env' = tcg_env { tcg_binds = tcg_binds tcg_env `unionBags` all_binds,
tcg_rules = tcg_rules tcg_env ++ rules,
tcg_fords = tcg_fords tcg_env ++ foe_decls ++ fi_decls } } ;
return (tcg_env', lcl_env)
tcg_rules = tcg_rules tcg_env ++ rules,
tcg_fords = tcg_fords tcg_env ++ foe_decls ++ fi_decls } } ;
return (tcg_env', lcl_env)
@@
-811,7
+816,8
@@
getModuleExports mod
vanillaProv :: ModuleName -> Provenance
-- We're building a GlobalRdrEnv as if the user imported
-- all the specified modules into the global interactive module
vanillaProv :: ModuleName -> Provenance
-- We're building a GlobalRdrEnv as if the user imported
-- all the specified modules into the global interactive module
-vanillaProv mod = Imported [ImportSpec mod mod False interactiveSrcLoc] False
+vanillaProv mod = Imported [ImportSpec mod mod False
+ (srcLocSpan interactiveSrcLoc)] False
\end{code}
\begin{code}
\end{code}
\begin{code}
@@
-921,17
+927,17
@@
check_main ghci_mode tcg_env main_mod main_fn
Nothing -> do { complain_no_main
; return tcg_env } ;
Just main_name -> do
Nothing -> do { complain_no_main
; return tcg_env } ;
Just main_name -> do
- { let { rhs = HsApp (HsVar runIOName) (HsVar main_name) }
+ { let { rhs = nlHsApp (nlHsVar runIOName) (nlHsVar main_name) }
-- :Main.main :: IO () = runIO main
-- :Main.main :: IO () = runIO main
- ; (main_expr, ty) <- addSrcLoc (getSrcLoc main_name) $
+ ; (main_expr, ty) <- addSrcSpan (srcLocSpan (getSrcLoc main_name)) $
tcInferRho rhs
; let { root_main_id = setIdLocalExported (mkLocalId rootMainName ty) ;
tcInferRho rhs
; let { root_main_id = setIdLocalExported (mkLocalId rootMainName ty) ;
- main_bind = VarMonoBind root_main_id main_expr }
+ main_bind = noLoc (VarBind root_main_id main_expr) }
; return (tcg_env { tcg_binds = tcg_binds tcg_env
; return (tcg_env { tcg_binds = tcg_binds tcg_env
- `andMonoBinds` main_bind,
+ `snocBag` main_bind,
tcg_dus = tcg_dus tcg_env
`plusDU` usesOnly (unitFV main_name)
})
tcg_dus = tcg_dus tcg_env
`plusDU` usesOnly (unitFV main_name)
})