import Panic
import Util
+#ifdef GHCI
import Time ( getClockTime )
+#endif
import Directory
import System
import IOExts
++ pkg_extra_ld_opts
++ extra_ld_opts
++ if static && not no_hs_main then
- [ "-u", prefixUnderscore "PrelMain_mainIO_closure",
- "-u", prefixUnderscore "__stginit_PrelMain"]
+ [ "-u", prefixUnderscore "Main_zdmain_closure"]
else []))
-- parallel only: move binary to another dir -- HWL
import CodeGen ( codeGen )
import CodeOutput ( codeOutput )
-import Module ( ModuleName, moduleName, mkHomeModule,
- moduleUserString, lookupModuleEnv )
+import Module ( ModuleName, moduleName, mkHomeModule )
import CmdLineOpts
import DriverState ( v_HCHeader )
import ErrUtils ( dumpIfSet_dyn, showPass, printError )
-------------------
-- RENAME
-------------------
- ; (pcs_rn, print_unqualified, maybe_rn_result)
+ ; (pcs_rn, print_unqual, maybe_rn_result)
<- _scc_ "Rename"
- renameModule dflags hit hst pcs_ch this_mod rdr_module
+ renameModule dflags ghci_mode hit hst pcs_ch this_mod rdr_module
; case maybe_rn_result of {
- Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
- Just (is_exported, new_iface, rn_hs_decls) -> do {
-
- -- In interactive mode, we don't want to discard any top-level
- -- entities at all (eg. do not inline them away during
- -- simplification), and retain them all in the TypeEnv so they are
- -- available from the command line.
- --
- -- isGlobalName separates the user-defined top-level names from those
- -- introduced by the type checker.
-
- ; let dont_discard | ghci_mode == Interactive = isGlobalName
- | otherwise = is_exported
+ Nothing -> return (HscFail pcs_ch);
+ Just (dont_discard, new_iface, rn_result) -> do {
-------------------
-- TYPECHECK
-------------------
; maybe_tc_result
<- _scc_ "TypeCheck"
- typecheckModule dflags pcs_rn hst new_iface
- print_unqualified rn_hs_decls
+ typecheckModule dflags pcs_rn hst print_unqual rn_result
; case maybe_tc_result of {
- Nothing -> return (HscFail pcs_ch{-was: pcs_rn-});
+ Nothing -> return (HscFail pcs_ch);
Just (pcs_tc, tc_result) -> do {
-------------------
-------------------
; (ds_details, foreign_stuff)
<- _scc_ "DeSugar"
- deSugar dflags pcs_tc hst this_mod print_unqualified tc_result
+ deSugar dflags pcs_tc hst this_mod print_unqual tc_result
; pcs_middle
<- _scc_ "pcs_middle"
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
VersionInfo(..), initialVersionInfo, lookupVersion,
+ FixityEnv, lookupFixity,
TyThing(..), isTyClThing, implicitTyThingIds,
#include "HsVersions.h"
-import RdrName ( RdrName, RdrNameEnv, addListToRdrEnv, emptyRdrEnv,
+import RdrName ( RdrName, RdrNameEnv, addListToRdrEnv,
mkRdrUnqual, rdrEnvToList )
import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc )
import NameEnv
import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
import DataCon ( dataConId, dataConWrapId )
-import BasicTypes ( Version, initialVersion, Fixity, IPName )
+import BasicTypes ( Version, initialVersion, Fixity, defaultFixity, IPName )
import HsSyn ( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
-- Its top level environment or Nothing if we read this
-- interface from a file.
- mi_fixities :: !(NameEnv Fixity), -- Fixities
+ mi_fixities :: !FixityEnv, -- Fixities
mi_deprecs :: !Deprecations, -- Deprecations
mi_decls :: IfaceDecls -- The RnDecls form of ModDetails
pprAvail (Avail n) = ppr n
\end{code}
+\begin{code}
+type FixityEnv = NameEnv Fixity
+
+lookupFixity :: FixityEnv -> Name -> Fixity
+lookupFixity env n = lookupNameEnv env n `orElse` defaultFixity
+\end{code}
+
%************************************************************************
%* *
import HsCore ( HsIdInfo(..), UfExpr(..), toUfExpr, toUfBndr )
import HsTypes ( toHsTyVars )
import TysPrim ( alphaTyVars )
-import BasicTypes ( Fixity(..), NewOrData(..), Activation(..),
+import BasicTypes ( NewOrData(..), Activation(..),
Version, initialVersion, bumpVersion
)
import NewDemand ( isTopSig )
import RnMonad
import RnHsSyn ( RenamedInstDecl, RenamedTyClDecl )
import HscTypes ( VersionInfo(..), ModIface(..), ModDetails(..),
- ModuleLocation(..), GhciMode(..),
+ ModuleLocation(..), GhciMode(..), FixityEnv, lookupFixity,
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
TyThing(..), DFunId, Avails, TypeEnv,
WhatsImported(..), GenAvailInfo(..),
pp_change False what = text what <+> ptext SLIT("changed")
diffDecls :: VersionInfo -- Old version
- -> NameEnv Fixity -> NameEnv Fixity -- Old and new fixities
+ -> FixityEnv -> FixityEnv -- Old and new fixities
-> [RenamedTyClDecl] -> [RenamedTyClDecl] -- Old and new decls
-> (Bool, -- True <=> no change
SDoc, -- Record of differences
-- When seeing if two decls are the same,
-- remember to check whether any relevant fixity has changed
eq_tc d1 d2 = d1 == d2 && all (same_fixity . fst) (tyClDeclNames d1)
- same_fixity n = lookupNameEnv old_fixities n == lookupNameEnv new_fixities n
+ same_fixity n = lookupFixity old_fixities n == lookupFixity new_fixities n
diff ok_so_far pp new_vers [] [] = (ok_so_far, pp, new_vers)
diff ok_so_far pp new_vers (od:ods) [] = diff False (pp $$ only_old od) new_vers ods []
= [
-- Type constructors (synonyms especially)
ioTyConName, ioDataConName,
- mainName,
+ runMainName,
orderingTyConName,
rationalTyConName,
ratioDataConName,
pREL_ERR_Name = mkModuleName "PrelErr"
pREL_REAL_Name = mkModuleName "PrelReal"
pREL_FLOAT_Name = mkModuleName "PrelFloat"
+pREL_TOP_HANDLER_Name = mkModuleName "PrelTopHandler"
-pREL_MAIN_Name = mkModuleName "PrelMain"
mAIN_Name = mkModuleName "Main"
pREL_INT_Name = mkModuleName "PrelInt"
pREL_WORD_Name = mkModuleName "PrelWord"
and it's convenient to write them all down in one place.
\begin{code}
-mainName = varQual mAIN_Name SLIT("main") mainKey
+dollarMainName = varQual mAIN_Name SLIT("$main") dollarMainKey
+runMainName = varQual pREL_TOP_HANDLER_Name SLIT("runMain") runMainKey
-- Stuff from PrelGHC
usOnceTyConName = kindQual SLIT(".") usOnceTyConKey
splitIdKey = mkPreludeMiscIdUnique 48
fstIdKey = mkPreludeMiscIdUnique 49
sndIdKey = mkPreludeMiscIdUnique 50
+otherwiseIdKey = mkPreludeMiscIdUnique 51
+mapIdKey = mkPreludeMiscIdUnique 52
+assertIdKey = mkPreludeMiscIdUnique 53
+runSTRepIdKey = mkPreludeMiscIdUnique 54
+
+dollarMainKey = mkPreludeMiscIdUnique 55
+runMainKey = mkPreludeMiscIdUnique 56
\end{code}
Certain class operations from Prelude classes. They get their own
during type checking.
\begin{code}
+ -- Just a place holder for unbound variables produced by the renamer:
+unboundKey = mkPreludeMiscIdUnique 101
fromIntegerClassOpKey = mkPreludeMiscIdUnique 102
minusClassOpKey = mkPreludeMiscIdUnique 103
fromRationalClassOpKey = mkPreludeMiscIdUnique 104
negateClassOpKey = mkPreludeMiscIdUnique 111
failMClassOpKey = mkPreludeMiscIdUnique 112
thenMClassOpKey = mkPreludeMiscIdUnique 113 -- (>>=)
- -- Just a place holder for unbound variables produced by the renamer:
-unboundKey = mkPreludeMiscIdUnique 114
fromEnumClassOpKey = mkPreludeMiscIdUnique 115
-
-mainKey = mkPreludeMiscIdUnique 116
returnMClassOpKey = mkPreludeMiscIdUnique 117
-otherwiseIdKey = mkPreludeMiscIdUnique 118
toEnumClassOpKey = mkPreludeMiscIdUnique 119
-mapIdKey = mkPreludeMiscIdUnique 120
-\end{code}
-
-\begin{code}
-assertIdKey = mkPreludeMiscIdUnique 121
-runSTRepIdKey = mkPreludeMiscIdUnique 122
\end{code}
\begin{code}
module Rename (
- renameModule, renameStmt, renameRdrName, mkGlobalContext,
+ renameModule, RnResult(..), renameStmt, renameRdrName, mkGlobalContext,
closeIfaceDecls, checkOldIface, slurpIface
) where
warnUnusedLocalBinds, warnUnusedModules,
lookupSrcName, getImplicitStmtFVs,
getImplicitModuleFVs, newGlobalName, unQualInScope,
- ubiquitousNames, lookupOccRn,
+ ubiquitousNames, lookupOccRn, checkMain,
plusGlobalRdrEnv, mkGlobalRdrEnv
)
import Module ( Module, ModuleName, WhereFrom(..),
moduleNameUserString, moduleName,
moduleEnvElts
)
-import Name ( Name, nameModule )
+import Name ( Name, nameModule, isGlobalName )
import NameEnv
import NameSet
import RdrName ( foldRdrEnv, isQual )
%*********************************************************
\begin{code}
-renameModule :: DynFlags
+renameModule :: DynFlags -> GhciMode
-> HomeIfaceTable -> HomeSymbolTable
-> PersistentCompilerState
-> Module -> RdrNameHsModule
-> IO (PersistentCompilerState, PrintUnqualified,
- Maybe (IsExported, ModIface, [RenamedHsDecl]))
+ Maybe (IsExported, ModIface, RnResult))
-- Nothing => some error occurred in the renamer
-renameModule dflags hit hst pcs this_module rdr_module
+renameModule dflags ghci_mode hit hst pcs this_module rdr_module
= renameSource dflags hit hst pcs this_module $
- rename this_module rdr_module
+ rename ghci_mode this_module rdr_module
\end{code}
\begin{code}
\end{code}
\begin{code}
-rename :: Module -> RdrNameHsModule
- -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, [RenamedHsDecl]))
-rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
+data RnResult -- A RenamedModule ia passed from renamer to typechecker
+ = RnResult { rr_mod :: Module, -- Same as in the ModIface,
+ rr_fixities :: FixityEnv, -- but convenient to have it here
+
+ rr_main :: Maybe Name, -- Just main, for module Main,
+ -- Nothing for other modules
+
+ rr_decls :: [RenamedHsDecl]
+ -- The other declarations of the module
+ -- Fixity and deprecations have already been slurped out
+ } -- and are now in the ModIface for the module
+
+rename :: GhciMode -> Module -> RdrNameHsModule
+ -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, RnResult))
+rename ghci_mode this_module
+ contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
= pushSrcLocRn loc $
-- FIND THE GLOBAL NAME ENVIRONMENT
rnSourceDecls gbl_env global_avail_env
local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
+ -- GET ANY IMPLICIT FREE VARIALBES
+ getImplicitModuleFVs rn_local_decls `thenRn` \ implicit_fvs ->
+ checkMain ghci_mode mod_name gbl_env `thenRn` \ (maybe_main_name, main_fvs, implicit_main_fvs) ->
+ let
+ export_fvs = availsToNameSet export_avails
+ used_fvs = source_fvs `plusFV` export_fvs `plusFV` main_fvs
+ -- The export_fvs make the exported names look just as if they
+ -- occurred in the source program. For the reasoning, see the
+ -- comments with RnIfaces.mkImportInfo
+ -- It also helps reportUnusedNames, which of course must not complain
+ -- that 'f' isn't mentioned if it is mentioned in the export list
+
+ needed_fvs = implicit_fvs `plusFV` implicit_main_fvs `plusFV` used_fvs
+ -- It's important to do the "plus" this way round, so that
+ -- when compiling the prelude, locally-defined (), Bool, etc
+ -- override the implicit ones.
+
+ in
+ traceRn (text "Needed FVs:" <+> fsep (map ppr (nameSetToList needed_fvs))) `thenRn_`
+
-- EXIT IF ERRORS FOUND
-- We exit here if there are any errors in the source, *before*
-- we attempt to slurp the decls from the interfaces, otherwise
else
-- SLURP IN ALL THE NEEDED DECLARATIONS
- -- Find out what re-bindable names to use for desugaring
- getImplicitModuleFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
- let
- export_fvs = availsToNameSet export_avails
- source_fvs2 = source_fvs `plusFV` export_fvs
- -- The export_fvs make the exported names look just as if they
- -- occurred in the source program. For the reasoning, see the
- -- comments with RnIfaces.mkImportInfo
- -- It also helps reportUnusedNames, which of course must not complain
- -- that 'f' isn't mentioned if it is mentioned in the export list
-
- source_fvs3 = implicit_fvs `plusFV` source_fvs2
- -- It's important to do the "plus" this way round, so that
- -- when compiling the prelude, locally-defined (), Bool, etc
- -- override the implicit ones.
-
- in
- traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList source_fvs3))) `thenRn_`
- slurpImpDecls source_fvs3 `thenRn` \ rn_imp_decls ->
+ slurpImpDecls needed_fvs `thenRn` \ rn_imp_decls ->
rnDump rn_imp_decls rn_local_decls `thenRn_`
-- GENERATE THE VERSION/USAGE INFO
final_decls = rn_local_decls ++ rn_imp_decls
+ -- In interactive mode, we don't want to discard any top-level
+ -- entities at all (eg. do not inline them away during
+ -- simplification), and retain them all in the TypeEnv so they are
+ -- available from the command line.
+ --
+ -- isGlobalName separates the user-defined top-level names from those
+ -- introduced by the type checker.
+ dont_discard :: Name -> Bool
+ dont_discard | ghci_mode == Interactive = isGlobalName
+ | otherwise = (`elemNameSet` exported_names)
+
+ exported_names = availsToNameSet export_avails
+
mod_iface = ModIface { mi_module = this_module,
mi_package = opt_InPackage,
mi_version = initialVersionInfo,
mi_decls = panic "mi_decls"
}
- is_exported name = name `elemNameSet` exported_names
- exported_names = availsToNameSet export_avails
+ rn_result = RnResult { rr_mod = this_module,
+ rr_fixities = fixities,
+ rr_decls = final_decls,
+ rr_main = maybe_main_name }
in
-- REPORT UNUSED NAMES, AND DEBUG DUMP
reportUnusedNames mod_iface print_unqualified
imports full_avail_env gbl_env
- source_fvs2 rn_imp_decls `thenRn_`
- -- NB: source_fvs2: include exports (else we get bogus
+ used_fvs rn_imp_decls `thenRn_`
+ -- NB: used_fvs: include exports (else we get bogus
-- warnings of unused things) but not implicit FVs.
- returnRn (print_unqualified, Just (is_exported, mod_iface, final_decls))
+ returnRn (print_unqualified, Just (dont_discard, mod_iface, rn_result))
where
mod_name = moduleName this_module
\end{code}
import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), AvailEnv,
AvailInfo, Avails, GenAvailInfo(..), NameSupply(..),
- ModIface(..),
+ ModIface(..), GhciMode(..),
Deprecations(..), lookupDeprec,
extendLocalRdrEnv
)
mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
import PrelNames ( mkUnboundName,
derivingOccurrences,
- mAIN_Name, pREL_MAIN_Name,
- ioTyConName, intTyConName,
+ mAIN_Name, main_RDR_Unqual,
+ runMainName, intTyConName,
boolTyConName, funTyConName,
unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
eqStringName, printName,
-- These are all needed implicitly when compiling a statement
-- See TcModule.tc_stmts
-getImplicitModuleFVs mod_name decls -- Compiling a module
+getImplicitModuleFVs decls -- Compiling a module
= lookupOrigNames deriv_occs `thenRn` \ deriving_names ->
- returnRn (deriving_names `plusFV` implicit_main `plusFV` ubiquitousNames)
+ returnRn (deriving_names `plusFV` ubiquitousNames)
where
- -- Add occurrences for IO or PrimIO
- implicit_main | mod_name == mAIN_Name
- || mod_name == pREL_MAIN_Name = unitFV ioTyConName
- | otherwise = emptyFVs
-
-- deriv_classes is now a list of HsTypes, so a "normal" one
-- appears as a (HsClassP c []). The non-normal ones for the new
-- newtype-deriving extension, and they don't require any
-- Add occurrences for very frequently used types.
-- (e.g. we don't want to be bothered with making funTyCon a
-- free var at every function application!)
+
+checkMain ghci_mode mod_name gbl_env
+ -- LOOKUP main IF WE'RE IN MODULE Main
+ -- The main point of this is to drag in the declaration for 'main',
+ -- its in another module, and for the Prelude function 'runMain',
+ -- so that the type checker will find them
+ --
+ -- We have to return the main_name separately, because it's a
+ -- bona fide 'use', and should be recorded as such, but the others aren't
+ | mod_name /= mAIN_Name
+ = returnRn (Nothing, emptyFVs, emptyFVs)
+
+ | not (main_RDR_Unqual `elemRdrEnv` gbl_env)
+ = complain_no_main `thenRn_`
+ returnRn (Nothing, emptyFVs, emptyFVs)
+
+ | otherwise
+ = lookupSrcName gbl_env main_RDR_Unqual `thenRn` \ main_name ->
+ returnRn (Just main_name, unitFV main_name, unitFV runMainName)
+
+ where
+ complain_no_main | ghci_mode == Interactive = addWarnRn noMainMsg
+ | otherwise = addErrRn noMainMsg
+ -- In interactive mode, only warn about the absence of main
\end{code}
%************************************************************************
quotes (ppr shadow),
ptext SLIT("shadows an existing binding")]
+noMainMsg = ptext SLIT("No 'main' defined in module Main")
+
unknownNameErr name
= sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
where
#include "HsVersions.h"
-import DriverState ( GhcMode(..), v_GhcMode, isCompManagerMode )
+import DriverState ( v_GhcMode, isCompManagerMode )
import DriverUtil ( splitFilename )
import CmdLineOpts ( opt_IgnoreIfacePragmas )
import HscTypes ( ModuleLocation(..),
AvailInfo, GenAvailInfo(..), Avails, Deprecations(..)
)
import HsSyn ( TyClDecl(..), InstDecl(..),
- HsType(..), HsPred(..), FixitySig(..), RuleDecl(..),
+ FixitySig(..), RuleDecl(..),
tyClDeclNames, tyClDeclSysNames, hsTyVarNames, getHsInstHead,
)
import RdrHsSyn ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl )
\begin{code}
+type RenamedHsDecl = HsDecl Name RenamedPat
type RenamedArithSeqInfo = ArithSeqInfo Name RenamedPat
type RenamedClassOpSig = Sig Name
type RenamedConDecl = ConDecl Name
type RenamedContext = HsContext Name
-type RenamedHsDecl = HsDecl Name RenamedPat
type RenamedRuleDecl = RuleDecl Name RenamedPat
type RenamedTyClDecl = TyClDecl Name RenamedPat
type RenamedDefaultDecl = DefaultDecl Name
type RenamedGRHSs = GRHSs Name RenamedPat
type RenamedHsBinds = HsBinds Name RenamedPat
type RenamedHsExpr = HsExpr Name RenamedPat
-type RenamedHsModule = HsModule Name RenamedPat
type RenamedInstDecl = InstDecl Name RenamedPat
type RenamedMatchContext = HsMatchContext Name
type RenamedMatch = Match Name RenamedPat
import RnMonad
import FiniteMap
-import PrelNames ( pRELUDE_Name, mAIN_Name, main_RDR_Unqual, isUnboundName )
+import PrelNames ( pRELUDE_Name, mAIN_Name, isUnboundName )
import Module ( ModuleName, moduleName, WhereFrom(..) )
import Name ( Name, nameSrcLoc, nameOccName )
import NameSet
import OccName ( setOccNameSpace, dataName )
import NameSet ( elemNameSet, emptyNameSet )
import Outputable
-import Maybes ( maybeToBool, catMaybes, mapMaybe )
+import Maybes ( maybeToBool, catMaybes )
import ListSetOps ( removeDups )
import Util ( sortLt )
import List ( partition )
-- Complains about exports items not in scope
exportsFromAvail this_mod Nothing
mod_avail_env entity_avail_env global_name_env
- = exportsFromAvail this_mod true_exports mod_avail_env entity_avail_env global_name_env
+ = exportsFromAvail this_mod (Just true_exports) mod_avail_env
+ entity_avail_env global_name_env
where
- true_exports = Just $ if this_mod == mAIN_Name
- then [IEVar main_RDR_Unqual]
- -- export Main.main *only* unless otherwise specified,
- else [IEModuleContents this_mod]
- -- but for all other modules export everything.
+ true_exports
+ | this_mod == mAIN_Name = []
+ -- Export nothing; Main.$main is automatically exported
+ | otherwise = [IEModuleContents this_mod]
+ -- but for all other modules export everything.
exportsFromAvail this_mod (Just export_items)
mod_avail_env entity_avail_env global_name_env
import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, renameSigsFVs )
import RnEnv ( lookupTopBndrRn, lookupOccRn, lookupIfaceName,
- lookupOrigNames, lookupSysBinder, newLocalsRn,
+ lookupSysBinder, newLocalsRn,
bindLocalsFVRn, bindPatSigTyVars,
bindTyVarsRn, extendTyVarEnvFVRn,
bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
import DataCon ( dataConId )
import Name ( Name, NamedThing(..) )
import NameSet
-import PrelInfo ( derivableClassKeys )
import PrelNames ( deRefStablePtrName, newStablePtrName,
bindIOName, returnIOName
)
import SrcLoc ( SrcLoc )
import CmdLineOpts ( DynFlag(..) )
-- Warn of unused for-all'd tyvars
-import Unique ( Uniquable(..) )
import Maybes ( maybeToBool )
\end{code}
import Inst ( Inst, InstOrigin(..), LIE, emptyLIE, plusLIE, plusLIEs,
instToId, newDicts, newMethod )
-import TcEnv ( RecTcEnv, TyThingDetails(..),
+import TcEnv ( TyThingDetails(..),
tcLookupClass, tcExtendTyVarEnvForMeths, tcExtendGlobalTyVars,
tcExtendLocalValEnv, tcExtendTyVarEnv
)
collectLocatedMonoBinders )
import RdrHsSyn ( RdrNameMonoBinds )
import RnHsSyn ( RenamedHsBinds, RenamedMonoBinds, RenamedTyClDecl, RenamedHsPred )
-import CmdLineOpts ( DynFlag(..), DynFlags )
+import CmdLineOpts ( DynFlag(..) )
import TcMonad
import TcEnv ( tcSetInstEnv, newDFunName, InstInfo(..), pprInstInfo,
- tcLookupClass, tcLookupTyCon, tcExtendTyVarEnv
+ tcLookupTyCon, tcExtendTyVarEnv
)
import TcGenDeriv -- Deriv stuff
import InstEnv ( InstEnv, simpleDFunClassTyCon, extendInstEnv )
import RnBinds ( rnMethodBinds, rnTopMonoBinds )
import RnEnv ( bindLocatedLocalsRn )
import RnMonad ( renameDerivedCode, thenRn, mapRn, returnRn )
-import HscTypes ( DFunId, PersistentRenamerState )
+import HscTypes ( DFunId, PersistentRenamerState, FixityEnv )
import BasicTypes ( Fixity, NewOrData(..) )
import Class ( className, classKey, classTyVars, Class )
-import ErrUtils ( dumpIfSet_dyn, Message )
+import ErrUtils ( dumpIfSet_dyn )
import MkId ( mkDictFunId )
import DataCon ( dataConRepArgTys, isNullaryDataCon, isExistentialDataCon )
import PrelInfo ( needsDataDeclCtxtClassKeys )
import Var ( TyVar, tyVarKind )
import VarSet ( mkVarSet, subVarSet )
import PrelNames
-import Util ( zipWithEqual, sortLt, eqListBy )
+import Util ( zipWithEqual, sortLt )
import ListSetOps ( removeDups, assoc )
import Outputable
import Maybe ( isJust )
-import List ( nub )
import FastString ( FastString )
\end{code}
tcDeriving :: PersistentRenamerState
-> Module -- name of module under scrutiny
-> InstEnv -- What we already know about instances
- -> (Name -> Maybe Fixity) -- used in deriving Show and Read
+ -> FixityEnv -- used in deriving Show and Read
-> [RenamedTyClDecl] -- All type constructors
-> TcM ([InstInfo], -- The generated "instance decls".
RenamedHsBinds) -- Extra generated bindings
-- Generate the method bindings for the required instance
-- (paired with class name, as we need that when renaming
-- the method binds)
-gen_bind :: (Name -> Maybe Fixity) -> DFunId -> (Name, RdrNameMonoBinds)
+gen_bind :: FixityEnv -> DFunId -> (Name, RdrNameMonoBinds)
gen_bind get_fixity dfun
= (cls_nm, binds)
where
tyVarsOfTypes, tcSplitDFunTy,
getDFunTyKey, tcTyConAppTyCon
)
-import Id ( idName, isDataConWrapId_maybe )
-import IdInfo ( vanillaIdInfo )
-import Var ( TyVar, Id, idType, lazySetIdInfo, idInfo )
+import Id ( isDataConWrapId_maybe )
+import Var ( TyVar, Id, idType )
import VarSet
import DataCon ( DataCon )
import TyCon ( TyCon )
import RdrHsSyn ( mkHsOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat )
import RdrName ( RdrName, mkUnqual )
import BasicTypes ( RecFlag(..), Fixity(..), FixityDirection(..)
- , maxPrecedence, defaultFixity
+ , maxPrecedence
, Boxity(..)
)
import FieldLabel ( fieldLabelName )
isDataSymOcc, isSymOcc
)
+import HscTypes ( FixityEnv, lookupFixity )
import PrelInfo -- Lots of RdrNames
import SrcLoc ( generatedSrcLoc, SrcLoc )
import TyCon ( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon,
import Util ( mapAccumL, zipEqual, zipWithEqual, isSingleton,
zipWith3Equal, nOfThem )
import Panic ( panic, assertPanic )
-import Maybes ( maybeToBool, orElse )
+import Maybes ( maybeToBool )
import Constants
import List ( partition, intersperse )
%************************************************************************
\begin{code}
-gen_Read_binds :: (Name -> Maybe Fixity) -> TyCon -> RdrNameMonoBinds
+gen_Read_binds :: FixityEnv -> TyCon -> RdrNameMonoBinds
gen_Read_binds get_fixity tycon
= reads_prec `AndMonoBinds` read_list
%************************************************************************
\begin{code}
-gen_Show_binds :: (Name -> Maybe Fixity) -> TyCon -> RdrNameMonoBinds
+gen_Show_binds :: FixityEnv -> TyCon -> RdrNameMonoBinds
gen_Show_binds get_fixity tycon
= shows_prec `AndMonoBinds` show_list
\end{code}
\begin{code}
-getLRPrecs :: Bool -> (Name -> Maybe Fixity) -> Name -> [Integer]
+getLRPrecs :: Bool -> FixityEnv -> Name -> [Integer]
getLRPrecs is_infix get_fixity nm = [lp, rp]
where
{-
defaultPrecedence :: Integer
defaultPrecedence = fromInt maxPrecedence
-getPrecedence :: (Name -> Maybe Fixity) -> Name -> Integer
+getPrecedence :: FixityEnv -> Name -> Integer
getPrecedence get_fixity nm
- = case get_fixity nm of
- Just (Fixity x _) -> fromInt x
- other -> defaultPrecedence
+ = case lookupFixity get_fixity nm of
+ Fixity x _ -> fromInt x
-isLRAssoc :: (Name -> Maybe Fixity) -> Name -> (Bool, Bool)
+isLRAssoc :: FixityEnv -> Name -> (Bool, Bool)
isLRAssoc get_fixity nm =
- case get_fixity nm `orElse` defaultFixity of
+ case lookupFixity get_fixity nm of
Fixity _ InfixN -> (False, False)
Fixity _ InfixR -> (False, True)
Fixity _ InfixL -> (True, False)
import CmdLineOpts ( DynFlag(..) )
-import HsSyn ( HsDecl(..), InstDecl(..), TyClDecl(..), HsType(..),
+import HsSyn ( InstDecl(..), TyClDecl(..), HsType(..),
MonoBinds(..), HsExpr(..), HsLit(..), Sig(..), HsTyVarBndr(..),
andMonoBindList, collectMonoBinders,
isClassDecl, toHsType
)
-import RnHsSyn ( RenamedHsBinds, RenamedInstDecl, RenamedHsDecl,
+import RnHsSyn ( RenamedHsBinds, RenamedInstDecl,
RenamedMonoBinds, RenamedTyClDecl, RenamedHsType,
extractHsTyVars, maybeGenericMatch
)
import TcMonad
import TcMType ( tcInstSigType, checkValidTheta, checkValidInstHead, instTypeErr,
UserTypeCtxt(..), SourceTyCtxt(..) )
-import TcType ( mkClassPred, mkTyVarTy, mkTyVarTys, tcSplitForAllTys,
+import TcType ( mkClassPred, mkTyVarTy, tcSplitForAllTys,
tcSplitSigmaTy, getClassPredTys, tcSplitPredTy_maybe,
TyVarDetails(..)
)
import Inst ( InstOrigin(..), newDicts, instToId,
LIE, mkLIE, emptyLIE, plusLIE, plusLIEs )
import TcDeriv ( tcDeriving )
-import TcEnv ( TcEnv, tcExtendGlobalValEnv, isLocalThing,
+import TcEnv ( tcExtendGlobalValEnv,
tcExtendTyVarEnvForMeths, tcLookupId, tcLookupClass,
InstInfo(..), pprInstInfo, simpleInstInfoTyCon,
simpleInstInfoTy, newDFunName
import TcMonoType ( tcHsTyVars, kcHsSigType, tcHsType, tcHsSigType )
import TcUnify ( checkSigTyVars )
import TcSimplify ( tcSimplifyCheck )
-import HscTypes ( HomeSymbolTable, DFunId,
+import HscTypes ( HomeSymbolTable, DFunId, FixityEnv,
PersistentCompilerState(..), PersistentRenamerState,
- ModDetails(..), PackageInstEnv
+ ModDetails(..)
)
-import Subst ( substTy, substTheta )
+import Subst ( substTheta )
import DataCon ( classDataCon )
import Class ( Class, classBigSig )
import Var ( idName, idType )
import TyCon ( TyCon )
import Subst ( mkTopTyVarSubst, substTheta )
import TysWiredIn ( genericTyCons )
-import Name ( Name )
import SrcLoc ( SrcLoc )
import Unique ( Uniquable(..) )
import Util ( lengthExceeds, isSingleton )
-import BasicTypes ( NewOrData(..), Fixity )
+import BasicTypes ( NewOrData(..) )
import ErrUtils ( dumpIfSet_dyn )
import ListSetOps ( Assoc, emptyAssoc, plusAssoc_C, mapAssoc,
assocElts, extendAssoc_C, equivClassesByUniq, minusList
)
import Maybe ( catMaybes )
-import List ( partition )
import Outputable
\end{code}
tcInstDecls1 -- Deal with source-code instance decls
:: PersistentRenamerState
-> InstEnv -- Imported instance envt
- -> (Name -> Maybe Fixity) -- for deriving Show and Read
+ -> FixityEnv -- for deriving Show and Read
-> Module -- Module for deriving
-> [RenamedTyClDecl] -- For deriving stuff
-> [RenamedInstDecl] -- Source code instance decls
import CmdLineOpts ( DynFlag(..), DynFlags, dopt )
import HsSyn ( HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
Stmt(..), InPat(..), HsMatchContext(..), HsDoContext(..), RuleDecl(..),
- isSourceInstDecl, nullBinds, mkSimpleMatch, placeHolderType
+ isSourceInstDecl, mkSimpleMatch, placeHolderType
)
-import PrelNames ( mAIN_Name, mainName, ioTyConName, printName,
- returnIOName, bindIOName, failIOName,
- itName
+import PrelNames ( ioTyConName, printName,
+ returnIOName, bindIOName, failIOName, runMainName,
+ dollarMainName, itName
)
import MkId ( unsafeCoerceId )
-import RnHsSyn ( RenamedHsBinds, RenamedHsDecl, RenamedStmt,
- RenamedHsExpr, RenamedRuleDecl, RenamedTyClDecl, RenamedInstDecl )
+import RnHsSyn ( RenamedHsDecl, RenamedStmt, RenamedHsExpr,
+ RenamedRuleDecl, RenamedTyClDecl, RenamedInstDecl )
import TcHsSyn ( TypecheckedMonoBinds, TypecheckedHsExpr,
TypecheckedForeignDecl, TypecheckedRuleDecl,
zonkTopBinds, zonkForeignExports, zonkRules, mkHsLet,
zonkExpr, zonkIdBndr
)
+import Rename ( RnResult(..) )
import MkIface ( pprModDetails )
import TcExpr ( tcMonoExpr )
import TcMonad
-import TcMType ( newTyVarTy, zonkTcType, tcInstType )
+import TcMType ( newTyVarTy, zonkTcType )
import TcType ( Type, liftedTypeKind, openTypeKind,
- tyVarsOfType, tidyType, tcFunResultTy,
- mkForAllTys, mkFunTys, mkTyConApp, tcSplitForAllTys
+ tyVarsOfType, tcFunResultTy,
+ mkForAllTys, mkFunTys, mkTyConApp, tcSplitForAllTys,
+ tcSplitTyConApp_maybe, isUnitTy
)
import TcMatches ( tcStmtsAndThen )
-import Inst ( emptyLIE, plusLIE )
+import Inst ( LIE, emptyLIE, plusLIE )
import TcBinds ( tcTopBinds )
import TcClassDcl ( tcClassDecls2 )
import TcDefaults ( tcDefaults, defaultDefaultTys )
-import TcEnv ( TcEnv, RecTcEnv, InstInfo(iDFunId), tcExtendGlobalValEnv, tcLookup_maybe,
+import TcEnv ( TcEnv, RecTcEnv, InstInfo(iDFunId), tcExtendGlobalValEnv,
isLocalThing, tcSetEnv, tcSetInstEnv, initTcEnv, getTcGEnv,
tcExtendGlobalEnv, tcExtendGlobalTypeEnv,
tcLookupGlobalId, tcLookupTyCon,
- TcTyThing(..), TyThing(..), tcLookupId
+ TyThing(..), tcLookupId
)
import TcRules ( tcIfaceRules, tcSourceRules )
import TcForeign ( tcForeignImports, tcForeignExports )
import TcIfaceSig ( tcInterfaceSigs )
import TcInstDcls ( tcInstDecls1, tcIfaceInstDecls1, addInstDFuns, initInstEnv, tcInstDecls2 )
-import TcUnify ( unifyTauTy )
import TcSimplify ( tcSimplifyTop, tcSimplifyInfer )
import TcTyClsDecls ( tcTyAndClassDecls )
import CoreUnfold ( unfoldingTemplate )
import ErrUtils ( printErrorsAndWarnings, errorsFound,
dumpIfSet_dyn, dumpIfSet_dyn_or, showPass )
import Rules ( extendRuleBase )
-import Id ( Id, idType, idUnfolding )
-import Module ( Module, moduleName )
-import Name ( Name )
-import NameEnv ( lookupNameEnv )
+import Id ( Id, mkLocalId, idType, idUnfolding, setIdLocalExported )
+import Module ( Module )
+import Name ( Name, getName, getSrcLoc )
import TyCon ( tyConGenInfo )
-import BasicTypes ( EP(..), Fixity, RecFlag(..) )
+import BasicTypes ( EP(..), RecFlag(..) )
import SrcLoc ( noSrcLoc )
import Outputable
import IO ( stdout )
:: DynFlags
-> PersistentCompilerState
-> HomeSymbolTable
- -> ModIface -- Iface for this module
-> PrintUnqualified -- For error printing
- -> [RenamedHsDecl]
+ -> RnResult
-> IO (Maybe (PersistentCompilerState, TcResults))
-- The new PCS is Augmented with imported information,
-- (but not stuff from this module)
}
-typecheckModule dflags pcs hst mod_iface unqual decls
+typecheckModule dflags pcs hst unqual rn_result
= do { maybe_tc_result <- typecheck dflags pcs hst unqual $
- tcModule pcs hst get_fixity this_mod decls
+ tcModule pcs hst rn_result
; printTcDump dflags unqual maybe_tc_result
; return maybe_tc_result }
- where
- this_mod = mi_module mod_iface
- fixity_env = mi_fixities mod_iface
-
- get_fixity :: Name -> Maybe Fixity
- get_fixity nm = lookupNameEnv fixity_env nm
-
tcModule :: PersistentCompilerState
-> HomeSymbolTable
- -> (Name -> Maybe Fixity)
- -> Module
- -> [RenamedHsDecl]
+ -> RnResult
-> TcM (PersistentCompilerState, TcResults)
-tcModule pcs hst get_fixity this_mod decls
+tcModule pcs hst (RnResult { rr_decls = decls, rr_mod = this_mod,
+ rr_fixities = fix_env, rr_main = maybe_main_name })
= fixTc (\ ~(unf_env, _, _) ->
-- Loop back the final environment, including the fully zonked
-- versions of bindings from this module. In the presence of mutual
-- in this module, which is why the knot is so big
-- Type-check the type and class decls, and all imported decls
- tcImports unf_env pcs hst get_fixity this_mod
+ tcImports unf_env pcs hst this_mod
tycl_decls iface_inst_decls iface_rule_decls `thenTc` \ (env1, new_pcs) ->
tcSetEnv env1 $
-- Do the source-language instances, including derivings
initInstEnv new_pcs hst `thenNF_Tc` \ inst_env1 ->
tcInstDecls1 (pcs_PRS new_pcs) inst_env1
- get_fixity this_mod
+ fix_env this_mod
tycl_decls src_inst_decls `thenTc` \ (inst_env2, inst_info, deriv_binds) ->
tcSetInstEnv inst_env2 $
-- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
traceTc (text "Tc10") `thenNF_Tc_`
- tcCheckMain this_mod `thenTc_`
+ tcCheckMain maybe_main_name `thenTc` \ (main_bind, lie_main) ->
-- Deal with constant or ambiguous InstIds. How could
-- there be ambiguous ones? They can only arise if a
lie_instdecls `plusLIE`
lie_clasdecls `plusLIE`
lie_fodecls `plusLIE`
- lie_rules
+ lie_rules `plusLIE`
+ lie_main
in
tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
- traceTc (text "endsimpltop") `thenTc_`
+ traceTc (text "endsimpltop") `thenTc_`
-- Backsubstitution. This must be done last.
-- Even tcSimplifyTop may do some unification.
let
- all_binds = val_binds `AndMonoBinds`
- inst_binds `AndMonoBinds`
- cls_dm_binds `AndMonoBinds`
- const_inst_binds `AndMonoBinds`
- foe_binds
+ all_binds = val_binds `AndMonoBinds`
+ inst_binds `AndMonoBinds`
+ cls_dm_binds `AndMonoBinds`
+ const_inst_binds `AndMonoBinds`
+ foe_binds `AndMonoBinds`
+ main_bind
in
traceTc (text "Tc7") `thenNF_Tc_`
zonkTopBinds all_binds `thenNF_Tc` \ (all_binds', final_env) ->
tcImports :: RecTcEnv
-> PersistentCompilerState
-> HomeSymbolTable
- -> (Name -> Maybe Fixity)
-> Module
-> [RenamedTyClDecl]
-> [RenamedInstDecl]
-- tcImports is only called when processing source code,
-- so that any interface-file declarations are for other modules, not this one
-tcImports unf_env pcs hst get_fixity this_mod
+tcImports unf_env pcs hst this_mod
tycl_decls inst_decls rule_decls
-- (unf_env :: RecTcEnv) is used for type-checking interface pragmas
-- which is done lazily [ie failure just drops the pragma
%************************************************************************
We must check that in module Main,
- a) main is defined
- b) main :: forall a1...an. IO t, for some type t
+ a) Main.main is in scope
+ b) Main.main :: forall a1...an. IO t, for some type t
-If we have
- main = error "Urk"
-then the type of main will be
- main :: forall a. a
-and that should pass the test too.
+Then we build
+ $main = PrelTopHandler.runMain Main.main
-So we just instantiate the type and unify with IO t, and declare
-victory if doing so succeeds.
+The function
+ PrelTopHandler :: IO a -> IO ()
+catches the top level exceptions.
+It accepts a Main.main of any type (IO a).
\begin{code}
-tcCheckMain :: Module -> TcM ()
-tcCheckMain this_mod
- | not (moduleName this_mod == mAIN_Name )
- = returnTc ()
-
- | otherwise
- = -- First unify the main_id with IO t, for any old t
- tcLookup_maybe mainName `thenNF_Tc` \ maybe_thing ->
- case maybe_thing of
- Just (ATcId main_id) -> check_main_ty (idType main_id)
- other -> addErrTc noMainErr
+tcCheckMain :: Maybe Name -> TcM (TypecheckedMonoBinds, LIE)
+tcCheckMain Nothing = returnTc (EmptyMonoBinds, emptyLIE)
+
+tcCheckMain (Just main_name)
+ = tcLookupId main_name `thenNF_Tc` \ main_id ->
+ -- If it is not Nothing, it should be in the env
+ tcAddSrcLoc (getSrcLoc main_id) $
+ tcAddErrCtxt mainCtxt $
+ newTyVarTy liftedTypeKind `thenNF_Tc` \ ty ->
+ tcMonoExpr rhs ty `thenTc` \ (main_expr, lie) ->
+ zonkTcType ty `thenNF_Tc` \ ty ->
+ ASSERT( is_io_unit ty )
+ let
+ dollar_main_id = setIdLocalExported (mkLocalId dollarMainName ty)
+ in
+ returnTc (VarMonoBind dollar_main_id main_expr, lie)
where
- check_main_ty main_ty
- = tcInstType main_ty `thenNF_Tc` \ (tvs, theta, main_tau) ->
- newTyVarTy liftedTypeKind `thenNF_Tc` \ arg_ty ->
- tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
- tcAddErrCtxtM (mainTypeCtxt main_ty) $
- if not (null theta) then
- failWithTc empty -- Context has the error message
- else
- unifyTauTy main_tau (mkTyConApp ioTyCon [arg_ty])
-
-mainTypeCtxt main_ty tidy_env
- = zonkTcType main_ty `thenNF_Tc` \ main_ty' ->
- returnNF_Tc (tidy_env, ptext SLIT("`main' has the illegal type") <+>
- quotes (ppr (tidyType tidy_env main_ty')))
-
-noMainErr = hsep [ptext SLIT("Module") <+> quotes (ppr mAIN_Name),
- ptext SLIT("must include a definition for") <+> quotes (ptext SLIT("main"))]
+ rhs = HsApp (HsVar runMainName) (HsVar main_name)
+
+is_io_unit :: Type -> Bool -- True for IO ()
+is_io_unit tau = case tcSplitTyConApp_maybe tau of
+ Just (tc, [arg]) -> getName tc == ioTyConName && isUnitTy arg
+ other -> False
+
+mainCtxt = ptext SLIT("When checking the type of 'main'")
\end{code}
+++ /dev/null
----------------------------------------------------------------------------
--- Main.hi
---
--- This hand-written interface file fakes a "Main" module
--- It is used *solely* so that GHCmain generates the right kind of
--- external reference to Main.main
----------------------------------------------------------------------------
-
-__interface Main 1 where
-__export Main main ;
-1 main :: __forall a => PrelIOBase.IO a; -- wish this could be __o. KSW 1999-04.
-
-
DLL_DESCRIPTION="GHC-compiled Haskell Prelude"
-ifeq "$(DLLized)" "YES"
-EXCLUDED_SRCS += Prelmain.lhs
-# PrelMain.dll_o isn't to be included in the final .a,
-# but it needs to be generated
-all :: PrelMain.dll_o
-endif
-
CLEAN_FILES += PrelGHC.hi-boot PrelGHC.hi $(foreach way, $(WAYS), PrelGHC.$(way)_hi)
#-----------------------------------------------------------------------------
# Building the library for GHCi
#
-# The procedure differs from that in fptools/mk/target.mk in two ways:
-# (a) we don't want PrelMain in the GHCi std library
-# (b) on Win32 we must split it into two, because a single .o file can't
+# The procedure differs from that in fptools/mk/target.mk in one way:
+# (*) on Win32 we must split it into two, because a single .o file can't
# have more than 65536 relocations in it.
#
-# we don't want PrelMain in the GHCi library.
-GHCI_LIBOBJS = $(filter-out PrelMain.$(way_)o,$(HS_OBJS))
+GHCI_LIBOBJS = $(HS_OBJS)
# Turn off standard rule which creates HSstd.o from LIBOBJS.
DONT_WANT_STD_GHCI_LIB_RULE=YES
#
# Files to install from here
#
-ifeq "$(DLLized)" "YES"
-INSTALL_LIBS += PrelMain.dll_o
-endif
INSTALL_DATAS += PrelGHC.$(way_)hi
+++ /dev/null
-% ------------------------------------------------------------------------------
-% $Id: PrelMain.lhs,v 1.9 2001/05/21 14:07:31 simonmar Exp $
-%
-% (c) The University of Glasgow, 1994-2000
-%
-
-\section[PrelMain]{Module @PrelMain@}
-
-\begin{code}
-module PrelMain( mainIO ) where
-
-import {-# SOURCE #-} qualified Main -- for type of "Main.main"
-
-import IO
-import PrelException
-import PrelTopHandler
-
-mainIO :: IO () -- It must be of type (IO t) because that's what
- -- the RTS expects. GHC doesn't check this, so
- -- make sure this type signature stays!
-mainIO = catchException Main.main topHandler
-\end{code}
-- Note: used to be called PrelTopHandler.lhs, so if you're looking
-- for CVS info, try 'cvs log'ging it too.
module PrelTopHandler (
- topHandler, reportStackOverflow, reportError
+ runMain, reportStackOverflow, reportError
) where
import IO
import PrelIOBase
import PrelException
+-- runMain is applied to Main.main by TcModule
+runMain :: IO a -> IO ()
+runMain main = catchException (main >> return ()) topHandler
+
topHandler :: Exception -> IO ()
topHandler err = catchException (real_handler err) topHandler
/* -----------------------------------------------------------------------------
- * $Id: Main.c,v 1.32 2002/01/22 13:54:22 simonmar Exp $
+ * $Id: Main.c,v 1.33 2002/02/05 15:42:04 simonpj Exp $
*
* (c) The GHC Team 1998-2000
*
# include <windows.h>
#endif
-extern void __stginit_PrelMain(void);
+extern void __stginit_Main(void);
/* Hack: we assume that we're building a batch-mode system unless
* INTERPRETER is set
SchedulerStatus status;
/* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
- startupHaskell(argc,argv,__stginit_PrelMain);
+ startupHaskell(argc,argv,__stginit_Main);
/* kick off the computation by creating the main thread with a pointer
to mainIO_closure representing the computation of the overall program;
/* -----------------------------------------------------------------------------
- * $Id: Prelude.h,v 1.17 2002/01/22 13:54:22 simonmar Exp $
+ * $Id: Prelude.h,v 1.18 2002/02/05 15:42:04 simonpj Exp $
*
* (c) The GHC Team, 1998-2001
*
extern DLL_IMPORT const StgClosure PrelBase_False_closure;
extern DLL_IMPORT const StgClosure PrelPack_unpackCString_closure;
extern DLL_IMPORT const StgClosure PrelWeak_runFinalizzerBatch_closure;
-extern const StgClosure PrelMain_mainIO_closure;
+extern const StgClosure Main_zdmain_closure;
extern DLL_IMPORT const StgClosure PrelIOBase_stackOverflow_closure;
extern DLL_IMPORT const StgClosure PrelIOBase_heapOverflow_closure;
#define False_closure (&PrelBase_False_closure)
#define unpackCString_closure (&PrelPack_unpackCString_closure)
#define runFinalizerBatch_closure (&PrelWeak_runFinalizzerBatch_closure)
-#define mainIO_closure (&PrelMain_mainIO_closure)
+#define mainIO_closure (&Main_zdmain_closure)
#define stackOverflow_closure (&PrelIOBase_stackOverflow_closure)
#define heapOverflow_closure (&PrelIOBase_heapOverflow_closure)
projects / ghc-hetmet.git / commitdiff