From: simonmar Date: Fri, 28 Oct 2005 11:35:35 +0000 (+0000) Subject: [project @ 2005-10-28 11:35:35 by simonmar] X-Git-Tag: Initial_conversion_from_CVS_complete~104 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;ds=sidebyside;h=554959511db7fd80b6da073abcfceb2392902054;p=ghc-hetmet.git [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 , 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 --- 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 --- 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 --- 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 --- 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 } } ;