[project @ 2005-03-08 09:45:45 by simonpj]

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

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index a295b31..bb128f2 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.144 2005/01/28 12:55:38 simonmar Exp $
+-- $Id: Main.hs,v 1.148 2005/02/10 15:26:23 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -14,28 +14,29 @@ module Main (main) where
 #include "HsVersions.h"
 
 #ifdef GHCI
-import InteractiveUI( ghciWelcomeMsg, interactiveUI )
+import InteractiveUI   ( ghciWelcomeMsg, interactiveUI )
 #endif
 
 
+import DriverState     ( isInteractiveMode )
 import CompManager     ( cmInit, cmLoadModules, cmDepAnal )
 import HscTypes                ( GhciMode(..) )
 import Config          ( cBooterVersion, cGhcUnregisterised, cProjectVersion )
 import SysTools                ( initSysTools, cleanTempFiles, normalisePath )
 import Packages                ( dumpPackages, initPackages, haskell98PackageId, PackageIdH(..) )
 import DriverPipeline  ( staticLink, doMkDLL, compileFile )
-import DriverState     ( isLinkMode, isMakeMode, isInteractiveMode,
+import DriverState     ( isLinkMode, 
                          isCompManagerMode, isInterpretiveMode, 
                          buildStgToDo, findBuildTag, unregFlags, 
-                         v_GhcMode, v_GhcModeFlag, GhcMode(..),
+                         v_GhcMode, GhcMode(..),
                          v_Keep_tmp_files, v_Ld_inputs, v_Ways, 
-                         v_Output_file, v_Output_hi, 
-                         verifyOutputFiles, v_NoLink
+                         v_Output_file, v_Output_hi, v_GhcLink,
+                         verifyOutputFiles, GhcLink(..)
                        )
 import DriverFlags
 
 import DriverMkDepend  ( doMkDependHS )
-import DriverPhases    ( isSourceFilename )
+import DriverPhases    ( Phase, isStopLn, isSourceFilename )
 
 import DriverUtil      ( add, handle, handleDyn, later, unknownFlagsErr )
 import CmdLineOpts     ( DynFlags(..), HscTarget(..), v_Static_hsc_opts,
@@ -51,7 +52,6 @@ import EXCEPTION      ( throwDyn, Exception(..),
 
 -- Standard Haskell libraries
 import IO
-import Directory       ( doesFileExist )
 import System          ( getArgs, exitWith, ExitCode(..) )
 import Monad
 import List
@@ -169,6 +169,9 @@ main =
        -- so there shouldn't be any difficulty if we receive further
        -- signals.
 
+       -- Display banner
+   showBanner mode dflags2
+
        -- Read the package config(s), and process the package-related
        -- command-line flags
    dflags <- initPackages dflags2
@@ -205,31 +208,23 @@ main =
     --       the command-line.
    mapM_ (add v_Ld_inputs) (reverse objs)
 
-       ---------------- Display banners and configuration -----------
-   showBanners mode dflags static_opts
+       ---------------- Display configuration -----------
+   when (verbosity dflags >= 4) $
+       dumpPackages dflags
+
+   when (verbosity dflags >= 3) $
+       hPutStrLn stderr ("Hsc static flags: " ++ unwords static_opts)
 
        ---------------- Final sanity checking -----------
    checkOptions mode srcs objs
 
        ---------------- Do the business -----------
 
-   -- Always link in the haskell98 package for static linking.  Other
-   -- packages have to be specified via the -package flag.
-   let link_pkgs
-         | ExtPackage h98_id <- haskell98PackageId (pkgState dflags) = [h98_id]
-         | otherwise = []
-
    case mode of
        DoMake         -> doMake dflags srcs
        DoMkDependHS   -> doMkDependHS dflags srcs 
-       StopBefore p   -> do { compileFiles mode dflags srcs; return () }
-       DoMkDLL        -> do { o_files <- compileFiles mode dflags srcs; 
-                              doMkDLL dflags o_files link_pkgs }
-       DoLink         -> do { o_files <- compileFiles mode dflags srcs; 
-                              omit_linking <- readIORef v_NoLink;
-                              when (not omit_linking)
-                                   (staticLink dflags o_files link_pkgs) }
-
+       StopBefore p   -> do { o_files <- compileFiles mode dflags srcs 
+                            ; doLink dflags p o_files }
 #ifndef GHCI
        DoInteractive -> noInteractiveError
        DoEval _      -> noInteractiveError
@@ -282,6 +277,26 @@ compileFiles :: GhcMode
 compileFiles mode dflags srcs = mapM (compileFile mode dflags) srcs
 
 
+doLink :: DynFlags -> Phase -> [FilePath] -> IO ()
+doLink dflags stop_phase o_files
+  | not (isStopLn stop_phase)
+  = return ()          -- We stopped before the linking phase
+
+  | otherwise
+  = do         { ghc_link <- readIORef v_GhcLink
+       ; case ghc_link of
+           NoLink     -> return ()
+           StaticLink -> staticLink dflags o_files link_pkgs
+           MkDLL      -> doMkDLL dflags o_files link_pkgs
+       }
+  where
+   -- Always link in the haskell98 package for static linking.  Other
+   -- packages have to be specified via the -package flag.
+    link_pkgs
+         | ExtPackage h98_id <- haskell98PackageId (pkgState dflags) = [h98_id]
+         | otherwise = []
+
+
 -- ----------------------------------------------------------------------------
 -- Run --make mode
 
@@ -297,10 +312,9 @@ doMake dflags srcs  = do
 -- ---------------------------------------------------------------------------
 -- Various banners and verbosity output.
 
-showBanners :: GhcMode -> DynFlags -> [String] -> IO ()
-showBanners mode dflags static_opts = do
+showBanner :: GhcMode -> DynFlags -> IO ()
+showBanner mode dflags = do
    let verb = verbosity dflags
-
        -- Show the GHCi banner
 #  ifdef GHCI
    when (isInteractiveMode mode && verb >= 1) $
@@ -308,14 +322,8 @@ showBanners mode dflags static_opts = do
 #  endif
 
        -- Display details of the configuration in verbose mode
-   when (verb >= 2) $
+   when (not (isInteractiveMode mode) && verb >= 2) $
        do hPutStr stderr "Glasgow Haskell Compiler, Version "
           hPutStr stderr cProjectVersion
           hPutStr stderr ", for Haskell 98, compiled by GHC version "
           hPutStrLn stderr cBooterVersion
-
-   when (verb >= 3) $
-       dumpPackages dflags
-
-   when (verb >= 3) $
-       hPutStrLn stderr ("Hsc static flags: " ++ unwords static_opts)