[project @ 2001-01-12 11:04:45 by simonmar]

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

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 40fed22..a3ad516 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -fno-warn-incomplete-patterns #-}
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.37 2000/12/12 12:10:08 simonmar Exp $
+-- $Id: Main.hs,v 1.46 2001/01/12 11:04:45 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -33,7 +33,7 @@ import DriverFlags
 import DriverMkDepend
 import DriverUtil
 import Panic
-import DriverPhases    ( Phase(..) )
+import DriverPhases    ( Phase(..), haskellish_file )
 import CmdLineOpts     ( HscLang(..), DynFlags(..), v_Static_hsc_opts )
 import TmpFiles
 import Finder          ( initFinder )
@@ -74,9 +74,7 @@ import Maybe
 -- Win32 support: proper signal handling
 -- make sure OPTIONS in .hs file propogate to .hc file if -C or -keep-hc-file-too
 -- reading the package configuration file is too slow
--- -H, -K, -Rghc-timing
--- hi-diffs
--- -ddump-all doesn't do anything
+-- -K<size>
 
 -----------------------------------------------------------------------------
 -- Differences vs. old driver:
@@ -84,7 +82,6 @@ import Maybe
 -- No more "Enter your Haskell program, end with ^D (on a line of its own):"
 -- consistency checking removed (may do this properly later)
 -- removed -noC
--- no hi diffs (could be added later)
 -- no -Ofile
 
 -----------------------------------------------------------------------------
@@ -92,15 +89,17 @@ import Maybe
 
 main =
   -- top-level exception handler: any unrecognised exception is a compiler bug.
-  handle (\exception -> panic (show exception)) $ do
+  handle (\exception -> do hPutStr stderr (show (Panic (show exception)))
+                          exitWith (ExitFailure 1)
+         ) $ do
 
   -- all error messages are propagated as exceptions
   handleDyn (\dyn -> case dyn of
                          PhaseFailed _phase code -> exitWith code
                          Interrupted -> exitWith (ExitFailure 1)
-                         _ -> do hPutStrLn stderr (show (dyn :: BarfKind))
+                         _ -> do hPutStrLn stderr (show (dyn :: GhcException))
                                  exitWith (ExitFailure 1)
-             ) $ do
+           ) $ do
 
    -- make sure we clean up after ourselves
    later (do  forget_it <- readIORef v_Keep_tmp_files
@@ -243,6 +242,9 @@ main =
    when (verb >= 2) 
        (hPutStrLn stderr ("Using package config file: " ++ conf_file))
 
+   when (verb >= 3) 
+       (hPutStrLn stderr ("Hsc static flags: " ++ unwords static_opts))
+
        -- initialise the finder
    pkg_avails <- getPackageInfo
    initFinder pkg_avails
@@ -254,30 +256,44 @@ main =
    if (mode == DoMake)        then beginMake srcs        else do
    if (mode == DoInteractive) then beginInteractive srcs else do
 
-       -- for each source file, find which phases to run
-   let lang = hscLang init_dyn_flags
-   pipelines <- mapM (genPipeline mode stop_flag True lang) srcs
-   let src_pipelines = zip srcs pipelines
-
        -- sanity checking
    o_file <- readIORef v_Output_file
    ohi    <- readIORef v_Output_hi
-   if length srcs > 1 && (isJust ohi || (isJust o_file && mode /= DoLink))
+   if length srcs > 1 && (isJust ohi || (isJust o_file && mode /= DoLink && mode /= DoMkDLL))
        then throwDyn (UsageError "can't apply -o or -ohi options to multiple source files")
        else do
 
    if null srcs then throwDyn (UsageError "no input files") else do
 
-   let compileFile (src, phases) = do
+   let compileFile src = do
          writeIORef v_Driver_state saved_driver_state
          writeIORef v_DynFlags init_dyn_flags
-         r <- runPipeline phases src (mode==DoLink) True
+
+         -- We compile in two stages, because the file may have an
+         -- OPTIONS pragma that affects the compilation pipeline (eg. -fvia-C)
+
+         let (basename, suffix) = splitFilename src
+
+         -- just preprocess
+         pp <- if not (haskellish_file src) || mode == StopBefore Hsc
+                       then return src else do
+               phases <- genPipeline (StopBefore Hsc) stop_flag
+                           False{-not persistent-} defaultHscLang src
+               pipeLoop phases src False{-no linking-} False{-no -o flag-}
+                       basename suffix
+
+         -- rest of compilation
+         dyn_flags <- readIORef v_DynFlags
+         phases <- genPipeline mode stop_flag True (hscLang dyn_flags) pp
+         r <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL) True{-use -o flag-}
+                       basename suffix
          return r
 
-   o_files <- mapM compileFile src_pipelines
+   o_files <- mapM compileFile srcs
 
    when (mode == DoMkDependHS) endMkDependHS
    when (mode == DoLink) (doLink o_files)
+   when (mode == DoMkDLL) (doMkDLL o_files)
 
        -- grab the last -B option on the command line, and
        -- set topDir to its value.