[project @ 2006-01-06 16:30:17 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / GHC.hs

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index e222579..7e0ec2f 100644 (file)
--- a/ghc/compiler/main/GHC.hs
+++ b/ghc/compiler/main/GHC.hs
@@ -37,7 +37,7 @@ module GHC (
        TypecheckedSource, ParsedSource, RenamedSource,
 
        -- * Inspecting the module structure of the program
-       ModuleGraph, ModSummary(..),
+       ModuleGraph, ModSummary(..), ModLocation(..),
        getModuleGraph,
        isLoaded,
        topSortModuleGraph,
@@ -97,7 +97,7 @@ module GHC (
        -- ** Type constructors
        TyCon, 
        tyConTyVars, tyConDataCons, tyConArity,
-       isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
+       isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
        getSynTyConDefn,
 
        -- ** Type variables
@@ -191,7 +191,7 @@ import Id           ( Id, idType, isImplicitId, isDeadBinder,
 import Var             ( TyVar )
 import TysPrim         ( alphaTyVars )
 import TyCon           ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon,
-                         isPrimTyCon, tyConArity,
+                         isPrimTyCon, isFunTyCon, tyConArity,
                          tyConTyVars, tyConDataCons, getSynTyConDefn )
 import Class           ( Class, classSCTheta, classTvsFds, classMethods )
 import FunDeps         ( pprFundeps )
@@ -219,7 +219,7 @@ import FiniteMap
 import Panic
 import Digraph
 import Bag             ( unitBag )
-import ErrUtils                ( Severity(..), showPass, Messages, fatalErrorMsg, debugTraceMsg,
+import ErrUtils                ( Severity(..), showPass, fatalErrorMsg, debugTraceMsg,
                          mkPlainErrMsg, printBagOfErrors, printErrorsAndWarnings )
 import qualified ErrUtils
 import Util
@@ -228,11 +228,10 @@ import Outputable
 import SysTools                ( cleanTempFilesExcept )
 import BasicTypes
 import TcType           ( tcSplitSigmaTy, isDictTy )
-import FastString      ( mkFastString )
 
 import Directory        ( getModificationTime, doesFileExist )
 import Maybe           ( isJust, isNothing, fromJust )
-import Maybes          ( orElse, expectJust, mapCatMaybes )
+import Maybes          ( expectJust, mapCatMaybes )
 import List            ( partition, nub )
 import qualified List
 import Monad           ( unless, when )
@@ -353,6 +352,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 +490,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 +620,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 " ++ moduleString main_mod ++ " module."))
 
              -- link everything together
               linkresult <- link ghci_mode dflags do_linking (hsc_HPT hsc_env1)