[project @ 2005-10-28 11:35:35 by simonmar]

Change the default executable name to match the basename of the source
file containing the Main module (or the module specified by -main-is),
if there is one.  On Windows, the .exe extension is added.

As requested on the ghc-users list, and as implemented by Tomasz
Zielonka <tomasz.zielonka at gmail.com>, with modifications by me.

I changed the type of the mainModIs field of DynFlags from Maybe
String to Module, which removed some duplicate code.

ghc/compiler/codeGen/CodeGen.lhs

@@ -74,7 +74,7 @@ codeGen dflags hmods this_mod data_tycons foreign_stubs imported_mods
   = do	
   { showPass dflags "CodeGen"
   ; let way = buildTag dflags
-        mb_main_mod = mainModIs dflags
+        main_mod = mainModIs dflags
 
 -- Why?
 --   ; mapM_ (\x -> seq x (return ())) data_tycons
@@ -83,7 +83,7 @@ codeGen dflags hmods this_mod data_tycons foreign_stubs imported_mods
 		{ cmm_binds  <- mapM (getCmm . cgTopBinding dflags hmods) stg_binds
 		; cmm_tycons <- mapM cgTyCon data_tycons
 		; cmm_init   <- getCmm (mkModuleInit dflags hmods way cost_centre_info 
-					     this_mod mb_main_mod
+					     this_mod main_mod
 				  	     foreign_stubs imported_mods)
 		; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init])
 		}
@@ -147,11 +147,11 @@ mkModuleInit
 	-> String		-- the "way"
 	-> CollectedCCs         -- cost centre info
 	-> Module
-	-> Maybe String		-- Just m ==> we have flag: -main-is Foo.baz 
+	-> Module		-- name of the Main module
 	-> ForeignStubs
 	-> [Module]
 	-> Code
-mkModuleInit dflags hmods way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods
+mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs imported_mods
   = do	{ 	
         if opt_SccProfilingOn
             then do { -- Allocate the static boolean that records if this
@@ -192,10 +192,6 @@ mkModuleInit dflags hmods way cost_centre_info this_mod mb_main_mod foreign_stub
 
     mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) wordRep
 
-    main_mod = case mb_main_mod of
-			Just mod_name -> mkModule mod_name
-			Nothing	      -> mAIN
-
     -- Main refers to GHC.TopHandler.runIO, so make sure we call the
     -- init function for GHC.TopHandler.
     extra_imported_mods

ghc/compiler/main/DynFlags.hs

@@ -48,6 +48,8 @@ module DynFlags (
 
 #include "HsVersions.h"
 
+import Module		( Module, mkModule )
+import PrelNames	( mAIN )
 import StaticFlags	( opt_Static, opt_PIC, 
 			  WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag )
 import {-# SOURCE #-} Packages (PackageState)
@@ -202,7 +204,7 @@ data DynFlags = DynFlags {
   stolen_x86_regs	:: Int,		
   cmdlineHcIncludes	:: [String],	-- -#includes
   importPaths		:: [FilePath],
-  mainModIs		:: Maybe String,
+  mainModIs		:: Module,
   mainFunIs		:: Maybe String,
 
   -- ways
@@ -334,7 +336,7 @@ defaultDynFlags =
 	stolen_x86_regs		= 4,
 	cmdlineHcIncludes	= [],
 	importPaths		= ["."],
-	mainModIs		= Nothing,
+	mainModIs		= mAIN,
 	mainFunIs		= Nothing,
 	
 	wayNames		= panic "ways",
@@ -1056,10 +1058,10 @@ setMainIs :: String -> DynP ()
 setMainIs arg
   | not (null main_fn)		-- The arg looked like "Foo.baz"
   = upd $ \d -> d{ mainFunIs = Just main_fn,
-	  	   mainModIs = Just main_mod }
+	  	   mainModIs = mkModule main_mod }
 
   | isUpper (head main_mod)	-- The arg looked like "Foo"
-  = upd $ \d -> d{ mainModIs = Just main_mod }
+  = upd $ \d -> d{ mainModIs = mkModule main_mod }
   
   | otherwise			-- The arg looked like "baz"
   = upd $ \d -> d{ mainFunIs = Just main_mod }

ghc/compiler/main/GHC.hs

@@ -222,6 +222,7 @@ import Bag		( unitBag )
 import ErrUtils		( Severity(..), showPass, Messages, fatalErrorMsg, debugTraceMsg,
 			  mkPlainErrMsg, printBagOfErrors, printErrorsAndWarnings )
 import qualified ErrUtils
+import PrelNames	( mAIN )
 import Util
 import StringBuffer	( StringBuffer, hGetStringBuffer )
 import Outputable
@@ -353,6 +354,23 @@ getSessionDynFlags s = withSession s (return . hsc_dflags)
 setSessionDynFlags :: Session -> DynFlags -> IO ()
 setSessionDynFlags s dflags = modifySession s (\h -> h{ hsc_dflags = dflags })
 
+-- | If there is no -o option, guess the name of target executable
+-- by using top-level source file name as a base.
+guessOutputFile :: Session -> IO ()
+guessOutputFile s = modifySession s $ \env ->
+    let dflags = hsc_dflags env
+        mod_graph = hsc_mod_graph env
+        mainModuleSrcPath, guessedName :: Maybe String
+        mainModuleSrcPath = do
+            let isMain = (== mainModIs dflags) . ms_mod
+            [ms] <- return (filter isMain mod_graph)
+            ml_hs_file (ms_location ms)
+        guessedName = fmap basenameOf mainModuleSrcPath
+    in
+    case outputFile dflags of
+        Just _ -> env
+        Nothing -> env { hsc_dflags = dflags { outputFile = guessedName } }
+
 -- -----------------------------------------------------------------------------
 -- Targets
 
@@ -474,6 +492,7 @@ load s@(Session ref) how_much
 	   Nothing        -> return Failed
 
 load2 s@(Session ref) how_much mod_graph = do
+        guessOutputFile s
 	hsc_env <- readIORef ref
 
         let hpt1      = hsc_HPT hsc_env
@@ -603,18 +622,15 @@ load2 s@(Session ref) how_much mod_graph = do
 	      --
 	      let ofile = outputFile dflags
 	      let no_hs_main = dopt Opt_NoHsMain dflags
-	      let mb_main_mod = mainModIs dflags
 	      let 
-	 	main_mod = mb_main_mod `orElse` "Main"
-		a_root_is_Main 
-               	    = any ((==main_mod).moduleUserString.ms_mod) 
-                    	  mod_graph
+	 	main_mod = mainModIs dflags
+		a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
 		do_linking = a_root_is_Main || no_hs_main
 
 	      when (ghci_mode == BatchCompile && isJust ofile && not do_linking) $
 	        debugTraceMsg dflags 1 (text ("Warning: output was redirected with -o, " ++
 				              "but no output will be generated\n" ++
-				              "because there is no " ++ main_mod ++ " module."))
+				              "because there is no " ++ moduleUserString main_mod ++ " module."))
 
 	      -- link everything together
               linkresult <- link ghci_mode dflags do_linking (hsc_HPT hsc_env1)

ghc/compiler/typecheck/TcRnDriver.lhs

@@ -732,9 +732,7 @@ checkMain
   = do { ghci_mode <- getGhciMode ;
 	 tcg_env   <- getGblEnv ;
 	 dflags    <- getDOpts ;
-	 let { main_mod = case mainModIs dflags of {
-				Just mod -> mkModule mod ;
-				Nothing  -> mAIN } ;
+	 let { main_mod = mainModIs dflags ;
 	       main_fn  = case mainFunIs dflags of {
 				Just fn -> mkRdrUnqual (mkVarOcc (mkFastString fn)) ;
 				Nothing -> main_RDR_Unqual } } ;