[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.

diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 1ea944c..e8d83a5 100644 (file)
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/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

diff --git a/ghc/compiler/main/DynFlags.hs b/ghc/compiler/main/DynFlags.hs
index 52e5542..c6702b1 100644 (file)
--- a/ghc/compiler/main/DynFlags.hs
+++ b/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 }

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index e222579..2ff5229 100644 (file)
--- a/ghc/compiler/main/GHC.hs
+++ b/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)

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index dc22e67..9cd7164 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/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 } } ;