[project @ 2003-06-23 10:35:15 by simonpj]

-------------------
	Dealing with 'main'
	-------------------

1.  In GHC 6.0, a module with no "module Main ... where" header
    elicited an error "main is not in scope" if 'main' is not defined.  We
    don't want this behaviour in GHCi.  This happened because the parser
    expanded the (absent) header to "module Main( main ) where", and the
    'main' in the export list isn't.

Solution: elaborate HsModule to record whether the 'module ..." header was
given explicitly by the user or not.


2.  Add a -main-is flag, and document it, so that you can have a 'main' function
that is not Main.main.  Summary of changes

* The -main-is flag nominates what the main function is to be (see the documentation).
	No -main-is flag 	says that the main function is Main.main
	-main-is Foo.baz	says that the main function is Foo.baz
	-main-is Foo		says that the main function is Foo.main
	-main-is baz		says that the main function is Main.baz

  Let's say  you say -main-is Foo.baz

* TcRnDriver injects the extra definition
	$Mian.main :: IO t
	$Main.main = baz
  in the module Foo.   Note the naming, which is a bit different than before;
  previously the extra defn was for Main.$main.  The RTS invokes zdMain_main_closure.

* CodeGen injects an extra initialisation block into module Foo, thus
	stginit_zdMain {
		stginit_Foo
	}
  That ensures that the RTS can initialise stginit_zdMain.

1 files changed, 27 insertions, 7 deletions

diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 724352cf16..fd5ef9d3a1 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}