Commit 55495951 authored by simonmar's avatar simonmar

[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.
parent d8afca91
......@@ -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
......
......@@ -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 }
......
......@@ -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)
......
......@@ -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 } } ;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment