diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs index 75e67e828565c7fdfdac46be549d531ffee07744..99befbd4476dd063e1671dd8797fded72eb28669 100644 --- a/ghc/compiler/absCSyn/CLabel.lhs +++ b/ghc/compiler/absCSyn/CLabel.lhs @@ -567,7 +567,6 @@ pprCLbl (CCS_Label ccs) = ppr ccs pprCLbl (ModuleInitLabel mod way) = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod)) <> char '_' <> text way - pprCLbl (PlainModuleInitLabel mod) = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod)) diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs index 724352cf16a04ca7c06f829f32888d2143360fb7..fd5ef9d3a1712d0f3383e2b9d94e556b1455f12c 100644 --- a/ghc/compiler/codeGen/CodeGen.lhs +++ b/ghc/compiler/codeGen/CodeGen.lhs @@ -24,11 +24,11 @@ module CodeGen ( codeGen ) where -- bother to compile it. import CgExpr ( {-NOTHING!-} ) -- DO NOT DELETE THIS IMPORT -import DriverState ( v_Build_tag ) +import DriverState ( v_Build_tag, v_MainModIs ) import StgSyn import CgMonad import AbsCSyn -import PrelNames ( gHC_PRIM ) +import PrelNames ( gHC_PRIM, dOLLAR_MAIN, mAIN_Name ) import CLabel ( mkSRTLabel, mkClosureLabel, mkPlainModuleInitLabel, mkModuleInitLabel ) import PprAbsC ( dumpRealC ) @@ -47,11 +47,12 @@ import Name ( nameSrcLoc, nameOccName, nameUnique, isInternalName, mkExternalNa import OccName ( mkLocalOcc ) import PrimRep ( PrimRep(..) ) import TyCon ( isDataTyCon ) -import Module ( Module ) +import Module ( Module, mkModuleName ) import BasicTypes ( TopLevelFlag(..) ) import UniqSupply ( mkSplitUniqSupply ) import ErrUtils ( dumpIfSet_dyn, showPass ) import Panic ( assertPanic ) +import qualified Module ( moduleName ) #ifdef DEBUG import Outputable @@ -76,6 +77,7 @@ codeGen dflags this_mod type_env foreign_stubs imported_mods showPass dflags "CodeGen" fl_uniqs <- mkSplitUniqSupply 'f' way <- readIORef v_Build_tag + mb_main_mod <- readIORef v_MainModIs let tycons = typeEnvTyCons type_env @@ -89,8 +91,9 @@ codeGen dflags this_mod type_env foreign_stubs imported_mods datatype_stuff = genStaticConBits cinfo data_tycons code_stuff = initC cinfo (mapCs cgTopBinding stg_binds) - init_stuff = mkModuleInit way cost_centre_info this_mod - foreign_stubs imported_mods + init_stuff = mkModuleInit way cost_centre_info + this_mod mb_main_mod + foreign_stubs imported_mods abstractC = mkAbstractCs [ maybeSplitCode, init_stuff, @@ -117,10 +120,11 @@ mkModuleInit :: String -- the "way" -> CollectedCCs -- cost centre info -> Module + -> Maybe String -- Just m ==> we have flag: -main-is Foo.baz -> ForeignStubs -> [Module] -> AbstractC -mkModuleInit way cost_centre_info this_mod foreign_stubs imported_mods +mkModuleInit way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods = let (cc_decls, cc_regs) = mkCostCentreStuff cost_centre_info @@ -142,6 +146,21 @@ mkModuleInit way cost_centre_info this_mod foreign_stubs imported_mods ] register_mod_imports = map mk_import_register imported_mods + + -- When compiling the module in which the 'main' function lives, + -- we inject an extra stg_init procedure for stg_init_zdMain, for the + -- RTS to invoke. We must consult the -main-is flag in case the + -- user specified a different function to Main.main + main_mod_name = case mb_main_mod of + Just mod_name -> mkModuleName mod_name + Nothing -> mAIN_Name + main_init_block + | Module.moduleName this_mod /= main_mod_name + = AbsCNop -- The normal case + | otherwise -- this_mod contains the main function + = CModuleInitBlock (mkPlainModuleInitLabel dOLLAR_MAIN) + (mkModuleInitLabel dOLLAR_MAIN way) + (mk_import_register this_mod) in mkAbstractCs [ cc_decls, @@ -149,7 +168,8 @@ mkModuleInit way cost_centre_info this_mod foreign_stubs imported_mods (mkModuleInitLabel this_mod way) (mkAbstractCs (register_foreign_exports ++ cc_regs : - register_mod_imports)) + register_mod_imports)), + main_init_block ] \end{code} diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs index 7f5ca52b8e3dde4a855e464687c8edc8a7cc8a3d..887bc699c105c6f8cd1bb61915210cdb2bd65cd9 100644 --- a/ghc/compiler/hsSyn/HsSyn.lhs +++ b/ghc/compiler/hsSyn/HsSyn.lhs @@ -21,7 +21,7 @@ module HsSyn ( module HsTypes, Fixity, NewOrData, - HsModule(..), hsModule, hsImports, + HsModule(..), collectStmtsBinders, collectHsBinders, collectLocatedHsBinders, collectMonoBinders, collectLocatedMonoBinders, @@ -51,10 +51,10 @@ All we actually declare here is the top-level structure for a module. \begin{code} data HsModule name = HsModule - Module - (Maybe Version) -- source interface version number - (Maybe [IE name]) -- export list; Nothing => export everything - -- Just [] => export *nothing* (???) + (Maybe Module) -- Nothing => "module X where" is omitted + -- (in which case the next field is Nothing too) + (Maybe [IE name]) -- Export list; Nothing => export list omitted, so export everything + -- Just [] => export *nothing* -- Just [...] => as you would expect... [ImportDecl name] -- We snaffle interesting stuff out of the -- imported interfaces early on, adding that @@ -69,8 +69,10 @@ data HsModule name instance (NamedThing name, OutputableBndr name) => Outputable (HsModule name) where - ppr (HsModule name iface_version exports imports - decls deprec src_loc) + ppr (HsModule Nothing _ imports decls _ src_loc) + = pp_nonnull imports $$ pp_nonnull decls + + ppr (HsModule (Just name) exports imports decls deprec src_loc) = vcat [ case exports of Nothing -> pp_header (ptext SLIT("where")) @@ -89,11 +91,8 @@ instance (NamedThing name, OutputableBndr name) pp_modname = ptext SLIT("module") <+> ppr name - pp_nonnull [] = empty - pp_nonnull xs = vcat (map ppr xs) - -hsModule (HsModule mod _ _ _ _ _ _) = mod -hsImports (HsModule mod vers exports imports decls deprec src_loc) = imports +pp_nonnull [] = empty +pp_nonnull xs = vcat (map ppr xs) \end{code} diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 22e416a312f6239e277741242e0a64a84f1023be..378265e31e672789a5afa743887181e2858e7070 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.115 2003/05/27 12:40:19 simonmar Exp $ +-- $Id: DriverFlags.hs,v 1.116 2003/06/23 10:35:17 simonpj Exp $ -- -- Driver flags -- @@ -225,6 +225,7 @@ static_flags = ------- Miscellaneous ----------------------------------------------- , ( "no-link-chk" , NoArg (return ()) ) -- ignored for backwards compat , ( "no-hs-main" , NoArg (writeIORef v_NoHsMain True) ) + , ( "main-is" , SepArg setMainIs ) ------- Output Redirection ------------------------------------------ , ( "odir" , HasArg (writeIORef v_Output_dir . Just) ) @@ -520,6 +521,21 @@ buildStaticHscOpts = do return ( static : filtered_opts ) +setMainIs :: String -> IO () +setMainIs arg + | not (null main_mod) -- The arg looked like "Foo.baz" + = do { writeIORef v_MainFunIs (Just main_fn) ; + writeIORef v_MainModIs (Just main_mod) } + + | isUpper (head main_fn) -- The arg looked like "Foo" + = writeIORef v_MainModIs (Just main_fn) + + | otherwise -- The arg looked like "baz" + = writeIORef v_MainFunIs (Just main_fn) + where + (main_mod, main_fn) = split_longest_prefix arg (== '.') + + ----------------------------------------------------------------------------- -- Via-C compilation stuff diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index 76c829587d656b294e37d125677a7509b7385d91..93ac6b72da3276c7f479cf6a36a90c035b8060ab 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverState.hs,v 1.91 2003/06/12 16:50:19 simonpj Exp $ +-- $Id: DriverState.hs,v 1.92 2003/06/23 10:35:17 simonpj Exp $ -- -- Settings for the driver -- @@ -95,6 +95,8 @@ GLOBAL_VAR(v_Scale_sizes_by, 1.0, Double) GLOBAL_VAR(v_Static, True, Bool) GLOBAL_VAR(v_NoLink, False, Bool) GLOBAL_VAR(v_NoHsMain, False, Bool) +GLOBAL_VAR(v_MainModIs, Nothing, Maybe String) +GLOBAL_VAR(v_MainFunIs, Nothing, Maybe String) GLOBAL_VAR(v_Recomp, True, Bool) GLOBAL_VAR(v_Collect_ghc_timing, False, Bool) GLOBAL_VAR(v_Do_asm_mangling, True, Bool) diff --git a/ghc/compiler/main/HscStats.lhs b/ghc/compiler/main/HscStats.lhs index dcd85f85d996cbf6fc98b86d82401bfeea8d92fc..8e59f3c16f55ae22731a5ad33f0e712ce92dfc25 100644 --- a/ghc/compiler/main/HscStats.lhs +++ b/ghc/compiler/main/HscStats.lhs @@ -22,7 +22,7 @@ import Util ( count ) %************************************************************************ \begin{code} -ppSourceStats short (HsModule name version exports imports decls _ src_loc) +ppSourceStats short (HsModule _ exports imports decls _ src_loc) = (if short then hcat else vcat) (map pp_val [("ExportAll ", export_all), -- 1 if no export list diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index c4670a3186566a00d47af5a79aa27c549ca7aa80..20a551ea1ad34fe6ba0bd1b67fa05f6586d87921 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,7 +1,7 @@ {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} ----------------------------------------------------------------------------- --- $Id: Main.hs,v 1.126 2003/06/17 23:26:30 sof Exp $ +-- $Id: Main.hs,v 1.127 2003/06/23 10:35:17 simonpj Exp $ -- -- GHC Driver program -- @@ -160,7 +160,7 @@ main = extra_non_static <- processArgs static_flags (unreg_opts ++ way_opts ++ pkg_extra_opts) [] - -- give the static flags to hsc + -- Give the static flags to hsc static_opts <- buildStaticHscOpts writeIORef v_Static_hsc_opts static_opts diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 5ca2359585c9419859a49a60f9b063638fd1133f..11dc6dc7a42f93046854971e1e94e0b140f1b957 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- -*-haskell-*- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.118 2003/05/19 15:10:40 simonpj Exp $ +$Id: Parser.y,v 1.119 2003/06/23 10:35:22 simonpj Exp $ Haskell grammar. @@ -265,19 +265,9 @@ REIFY_FIXITY { ITreifyFixity } module :: { RdrNameHsModule } : srcloc 'module' modid maybemoddeprec maybeexports 'where' body - { HsModule (mkHomeModule $3) Nothing $5 (fst $7) (snd $7) $4 $1 } + { HsModule (Just (mkHomeModule $3)) $5 (fst $7) (snd $7) $4 $1 } | srcloc body - { -- Behave as if we'd said - -- module Main( main ) where ... - let - main_RDR_Unqual = mkUnqual varName FSLIT("main") - -- We definitely don't want an Orig RdrName, because - -- main might, in principle, be imported into module Main - in - HsModule (mkHomeModule mAIN_Name) - Nothing - (Just [IEVar main_RDR_Unqual]) - (fst $2) (snd $2) Nothing $1 } + { HsModule Nothing Nothing (fst $2) (snd $2) Nothing $1 } maybemoddeprec :: { Maybe DeprecTxt } : '{-# DEPRECATED' STRING '#-}' { Just $2 } diff --git a/ghc/compiler/parser/ParserCore.y b/ghc/compiler/parser/ParserCore.y index af591fa525e7db93a45509d9d223c68f06a53386..1cd7d6a6bf66f627d4558ff094cd3a3a37d548d9 100644 --- a/ghc/compiler/parser/ParserCore.y +++ b/ghc/compiler/parser/ParserCore.y @@ -68,7 +68,7 @@ import Outputable module :: { RdrNameHsModule } : '%module' modid tdefs vdefgs - { HsModule (mkHomeModule $2) Nothing Nothing + { HsModule (Just (mkHomeModule $2)) Nothing [] ($3 ++ concat $4) Nothing noSrcLoc} tdefs :: { [RdrNameHsDecl] } diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index 2475dc8f9bb16be5c9bf2bb30f1726455edd8c04..d65c9f18c1adcc9589623afc8b6264beee0c681b 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -287,12 +287,12 @@ pREL_REAL = mkBasePkgModule pREL_REAL_Name pREL_FLOAT = mkBasePkgModule pREL_FLOAT_Name pRELUDE = mkBasePkgModule pRELUDE_Name - -iNTERACTIVE = mkHomeModule (mkModuleName "$Interactive") - -- MetaHaskell Extension text2 from Meta/work/gen.hs mETA_META_Name = mkModuleName "Language.Haskell.THSyntax" +dOLLAR_MAIN_Name = mkModuleName "$Main" -- Root module for initialisation +dOLLAR_MAIN = mkHomeModule dOLLAR_MAIN_Name +iNTERACTIVE = mkHomeModule (mkModuleName "$Interactive") \end{code} %************************************************************************ @@ -462,7 +462,7 @@ and it's convenient to write them all down in one place. \begin{code} -dollarMainName = varQual mAIN_Name FSLIT("$main") dollarMainKey +dollarMainName = varQual dOLLAR_MAIN_Name FSLIT("main") dollarMainKey runIOName = varQual pREL_TOP_HANDLER_Name FSLIT("runIO") runMainKey -- Stuff from GHC.Prim diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 8e06c6cf6826549e45f9810598e3fd73c96c397c..9197fd978dcc24ae03094db9faa62bb35bccee41 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -19,7 +19,7 @@ import HsSyn ( IE(..), ieName, ImportDecl(..), ForeignDecl(..), HsGroup(..), collectLocatedHsBinders, tyClDeclNames ) -import RdrHsSyn ( RdrNameIE, RdrNameImportDecl ) +import RdrHsSyn ( RdrNameIE, RdrNameImportDecl, main_RDR_Unqual ) import RnEnv import TcRnMonad @@ -34,7 +34,7 @@ import NameSet import NameEnv import OccName ( OccName, srcDataName, isTcOcc ) import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv, - GenAvailInfo(..), AvailInfo, Avails, + GenAvailInfo(..), AvailInfo, Avails, GhciMode(..), IsBootInterface, availName, availNames, availsToNameSet, Deprecations(..), ModIface(..), Dependencies(..), @@ -528,14 +528,30 @@ type ExportOccMap = FiniteMap OccName (Name, RdrNameIE) -- that have the same occurrence name -exportsFromAvail :: Maybe [RdrNameIE] -> TcRn m Avails +exportsFromAvail :: Maybe Module -- Nothing => no 'module M(..) where' header at all + -> Maybe [RdrNameIE] -- Nothing => no explicit export list + -> TcRn m Avails -- Complains if two distinct exports have same OccName -- Warns about identical exports. -- Complains about exports items not in scope -exportsFromAvail exports +exportsFromAvail maybe_mod exports = do { TcGblEnv { tcg_rdr_env = rdr_env, tcg_imports = imports } <- getGblEnv ; + + -- If the module header is omitted altogether, then behave + -- as if the user had written "module Main(main) where..." + -- EXCEPT in interactive mode, when we behave as if he had + -- written "module Main where ..." + -- Reason: don't want to complain about 'main' not in scope + -- in interactive mode + ghci_mode <- getGhciMode ; + let { real_exports + = case maybe_mod of + Just mod -> exports + Nothing | ghci_mode == Interactive -> Nothing + | otherwise -> Just [IEVar main_RDR_Unqual] } ; + exports_from_avail exports rdr_env imports } exports_from_avail Nothing rdr_env diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs index 872a314be025d708d278cce4c2f995b247119dc7..b6e94aaba7d85a35ea31beb7dce9834f61a886e2 100644 --- a/ghc/compiler/typecheck/TcRnDriver.lhs +++ b/ghc/compiler/typecheck/TcRnDriver.lhs @@ -21,6 +21,8 @@ import DsMeta ( templateHaskellNames ) #endif import CmdLineOpts ( DynFlag(..), opt_PprStyle_Debug, dopt ) +import DriverState ( v_MainModIs, v_MainFunIs ) +import DriverUtil ( split_longest_prefix ) import HsSyn ( HsModule(..), HsBinds(..), MonoBinds(..), HsExpr(..), Stmt(..), Pat(VarPat), HsStmtContext(..), RuleDecl(..), HsGroup(..), SpliceDecl(..), @@ -86,7 +88,8 @@ import ErrUtils ( mkDumpDoc, showPass, pprBagOfErrors ) import Id ( Id, mkLocalId, isLocalId, idName, idType, idUnfolding, setIdLocalExported ) import IdInfo ( GlobalIdDetails(..) ) import Var ( Var, setGlobalIdDetails ) -import Module ( Module, moduleName, moduleUserString, moduleEnvElts ) +import Module ( Module, ModuleName, mkHomeModule, mkModuleName, moduleName, moduleUserString, moduleEnvElts ) +import OccName ( mkVarOcc ) import Name ( Name, isExternalName, getSrcLoc, nameOccName ) import NameEnv ( delListFromNameEnv ) import NameSet @@ -115,6 +118,8 @@ import HscTypes ( GlobalRdrElt(..), GlobalRdrEnv, ImportReason(..), Provenance( isLocalGRE ) #endif +import DATA_IOREF ( readIORef ) +import FastString ( mkFastString ) import Panic ( showException ) import List ( partition ) import Util ( sortLt ) @@ -135,9 +140,13 @@ tcRnModule :: HscEnv -> PersistentCompilerState -> IO (PersistentCompilerState, Maybe TcGblEnv) tcRnModule hsc_env pcs - (HsModule this_mod _ exports import_decls local_decls mod_deprec loc) + (HsModule maybe_mod exports import_decls local_decls mod_deprec loc) = 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 + initTc hsc_env pcs this_mod $ addSrcLoc loc $ do { -- Deal with imports; sets tcg_rdr_env, tcg_imports (rdr_env, imports) <- rnImports import_decls ; @@ -165,7 +174,7 @@ tcRnModule hsc_env pcs $ do { -- Process the export list - export_avails <- exportsFromAvail exports ; + export_avails <- exportsFromAvail maybe_mod exports ; updGblEnv (\gbl -> gbl { tcg_exports = export_avails }) $ do { @@ -528,8 +537,8 @@ tcRnExtCore :: HscEnv -> PersistentCompilerState -> IO (PersistentCompilerState, Maybe ModGuts) -- Nothing => some error occurred -tcRnExtCore hsc_env pcs - (HsModule this_mod _ _ _ local_decls _ loc) +tcRnExtCore hsc_env pcs (HsModule (Just this_mod) _ _ decls _ loc) + -- For external core, the module name is syntactically reqd -- Rename the (Core) module. It's a bit like an interface -- file: all names are original names = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ; @@ -539,14 +548,14 @@ tcRnExtCore hsc_env pcs -- Rename the source, only in interface mode. -- rnSrcDecls handles fixity decls etc too, which won't occur -- but that doesn't matter - let { local_group = mkGroup local_decls } ; - (_, rn_local_decls, dus) <- initRn (InterfaceMode this_mod) + let { local_group = mkGroup decls } ; + (_, rn_decls, dus) <- initRn (InterfaceMode this_mod) (rnSrcDecls local_group) ; failIfErrsM ; -- Get the supporting decls rn_imp_decls <- slurpImpDecls (duUses dus) ; - let { rn_decls = rn_local_decls `addImpDecls` rn_imp_decls } ; + let { rn_decls = rn_decls `addImpDecls` rn_imp_decls } ; -- Dump trace of renaming part rnDump (ppr rn_decls) ; @@ -558,7 +567,7 @@ tcRnExtCore hsc_env pcs setGblEnv tcg_env $ do { -- Now the core bindings - core_prs <- tcCoreBinds (hs_coreds rn_local_decls) ; + core_prs <- tcCoreBinds (hs_coreds rn_decls) ; tcExtendGlobalValEnv (map fst core_prs) $ do { -- Wrap up @@ -570,8 +579,8 @@ tcRnExtCore hsc_env pcs final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ; mod_guts = ModGuts { mg_module = this_mod, - mg_usages = [], -- ToDo: compute usage - mg_dir_imps = [], -- ?? + mg_usages = [], -- ToDo: compute usage + mg_dir_imps = [], -- ?? mg_deps = noDependencies, -- ?? mg_exports = my_exports, mg_types = final_type_env, @@ -1093,10 +1102,21 @@ noRdrEnvErr mod = ptext SLIT("No top-level environment available for module") checkMain = do { ghci_mode <- getGhciMode ; tcg_env <- getGblEnv ; - check_main ghci_mode tcg_env + + mb_main_mod <- readMutVar v_MainModIs ; + mb_main_fn <- readMutVar v_MainFunIs ; + let { main_mod = case mb_main_mod of { + Just mod -> mkModuleName mod ; + Nothing -> mAIN_Name } ; + main_fn = case mb_main_fn of { + Just fn -> mkRdrUnqual (mkVarOcc (mkFastString fn)) ; + Nothing -> main_RDR_Unqual } } ; + + check_main ghci_mode tcg_env main_mod main_fn } -check_main ghci_mode tcg_env + +check_main ghci_mode tcg_env main_mod main_fn -- If we are in module Main, check that 'main' is defined. -- It may be imported from another module, in which case -- we have to drag in its. @@ -1111,7 +1131,7 @@ check_main ghci_mode tcg_env -- -- Blimey: a whole page of code to do this... - | mod_name /= mAIN_Name + | mod_name /= main_mod = return (tcg_env, emptyFVs) -- Check that 'main' is in scope @@ -1119,11 +1139,12 @@ check_main ghci_mode tcg_env -- -- We use a guard for this (rather than letting lookupSrcName fail) -- because it's not an error in ghci) - | not (main_RDR_Unqual `elemRdrEnv` rdr_env) + | not (main_fn `elemRdrEnv` rdr_env) = do { complain_no_main; return (tcg_env, emptyFVs) } - | otherwise - = do { main_name <- lookupSrcName main_RDR_Unqual ; + | otherwise -- OK, so the appropriate 'main' is in scope + -- + = do { main_name <- lookupSrcName main_fn ; tcg_env <- importSupportingDecls (unitFV runIOName) ; @@ -1152,8 +1173,9 @@ check_main ghci_mode tcg_env -- In other modes, fail altogether, so that we don't go on -- and complain a second time when processing the export list. - mainCtxt = ptext SLIT("When checking the type of 'main'") - noMainMsg = ptext SLIT("No 'main' defined in module Main") + mainCtxt = ptext SLIT("When checking the type of the main function") <+> quotes (ppr main_fn) + noMainMsg = ptext SLIT("The main function") <+> quotes (ppr main_fn) + <+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod) \end{code} @@ -1253,9 +1275,8 @@ ppr_rules rs = vcat [ptext SLIT("{-# RULES"), ptext SLIT("#-}")] ppr_gen_tycons [] = empty -ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"), - vcat (map ppr_gen_tycon tcs), - ptext SLIT("#-}") +ppr_gen_tycons tcs = vcat [ptext SLIT("Generic type constructor details:"), + nest 2 (vcat (map ppr_gen_tycon tcs)) ] -- x&y are now Id's, not CoreExpr's diff --git a/ghc/docs/users_guide/ffi-chap.sgml b/ghc/docs/users_guide/ffi-chap.sgml index 0aaeabd8a62c591d51e44dec604639bf680928fd..99d21a3cc19b23274074faa323bc9920a83d19f7 100644 --- a/ghc/docs/users_guide/ffi-chap.sgml +++ b/ghc/docs/users_guide/ffi-chap.sgml @@ -101,7 +101,7 @@ extern HsInt foo(HsInt a0); invoke foo() from C, just #include "Foo_stub.h" and call foo(). - + Using your own <literal>main()</literal> Normally, GHC's runtime system provides a diff --git a/ghc/docs/users_guide/phases.sgml b/ghc/docs/users_guide/phases.sgml index 0dee0c1f8fb6b59c99b084a96df1ee88e1a712a0..e0f92b3fd23b408d63061bdb816631ddabf936dc 100644 --- a/ghc/docs/users_guide/phases.sgml +++ b/ghc/docs/users_guide/phases.sgml @@ -554,6 +554,27 @@ strmod = "\ + + + + specifying your own main function + + The normal rule in Haskell is that your program must supply a main + function in module Main. When testing, it is often convenient + to change which function is the "main" one, and the flag + allows you to do so. The thing can be one of: + + A lower-case identifier foo. GHC assumes that the main function is Main.foo. + An module name A. GHC assumes that the main function is A.main. + An qualified name A.foo. GHC assumes that the main function is A.foo. + + Strictly speaking, is not a link-phase flag at all; it has no effect on the link step. + The flag must be specified when compiling the module containing the specified main function (e.g. module A + in the latter two items above. It has no effect for other modules (and hence can safely be given to ghc --make). + + + + @@ -564,7 +585,7 @@ strmod = "\ be supplying its definition of main() at link-time, you will have to. To signal that to the compiler when linking, use - . + . See also . Notice that since the command-line passed to the linker is rather involved, you probably want to use diff --git a/ghc/rts/Main.c b/ghc/rts/Main.c index 931371c1a0458188ffc2acc30debbdf201bab376..aa10c44eb8835060b306e493ccddf0b252493fd1 100644 --- a/ghc/rts/Main.c +++ b/ghc/rts/Main.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Main.c,v 1.37 2003/03/25 18:00:19 sof Exp $ + * $Id: Main.c,v 1.38 2003/06/23 10:35:23 simonpj Exp $ * * (c) The GHC Team 1998-2000 * @@ -41,7 +41,7 @@ # include #endif -extern void __stginit_Main(void); +extern void __stginit_zdMain(void); /* Hack: we assume that we're building a batch-mode system unless * INTERPRETER is set @@ -53,7 +53,7 @@ int main(int argc, char *argv[]) SchedulerStatus status; /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */ - startupHaskell(argc,argv,__stginit_Main); + startupHaskell(argc,argv,__stginit_zdMain); /* kick off the computation by creating the main thread with a pointer to mainIO_closure representing the computation of the overall program; diff --git a/ghc/rts/Prelude.h b/ghc/rts/Prelude.h index cc1e8e8dc9a39aea0fa7a9d408658493f1081f76..486aa61845ff94776429e4dff20800fe1f759e26 100644 --- a/ghc/rts/Prelude.h +++ b/ghc/rts/Prelude.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Prelude.h,v 1.22 2003/02/06 09:56:10 simonmar Exp $ + * $Id: Prelude.h,v 1.23 2003/06/23 10:35:23 simonpj Exp $ * * (c) The GHC Team, 1998-2001 * @@ -18,7 +18,7 @@ extern DLL_IMPORT StgClosure GHCziBase_True_closure; extern DLL_IMPORT StgClosure GHCziBase_False_closure; extern DLL_IMPORT StgClosure GHCziPack_unpackCString_closure; extern DLL_IMPORT StgClosure GHCziWeak_runFinalizzerBatch_closure; -extern StgClosure Main_zdmain_closure; +extern StgClosure zdMain_main_closure; extern DLL_IMPORT StgClosure GHCziTopHandler_runIO_closure; extern DLL_IMPORT StgClosure GHCziTopHandler_runNonIO_closure; @@ -67,7 +67,7 @@ extern DLL_IMPORT const StgInfoTable GHCziStable_StablePtr_con_info; #define False_closure (&GHCziBase_False_closure) #define unpackCString_closure (&GHCziPack_unpackCString_closure) #define runFinalizerBatch_closure (&GHCziWeak_runFinalizzerBatch_closure) -#define mainIO_closure (&Main_zdmain_closure) +#define mainIO_closure (&zdMain_main_closure) #define runIO_closure (&GHCziTopHandler_runIO_closure) #define runNonIO_closure (&GHCziTopHandler_runNonIO_closure)