[project @ 2001-01-03 11:13:43 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 23d82e8..5f5024a 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.38 2000/12/12 14:35:08 simonmar Exp $
+-- $Id: Main.hs,v 1.43 2001/01/03 11:13:43 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -84,23 +84,24 @@ 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
 
 -----------------------------------------------------------------------------
 -- Main loop
 
 main =
+  -- top-level exception handler: any unrecognised exception is a compiler bug.
+  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 :: GhcException))
                                  exitWith (ExitFailure 1)
-             ) $ do
-
-  -- top-level exception handler: any unrecognised exception is a compiler bug.
-  handle (\exception -> panic (show exception)) $ do
+           ) $ do
 
    -- make sure we clean up after ourselves
    later (do  forget_it <- readIORef v_Keep_tmp_files
@@ -254,11 +255,6 @@ 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
@@ -268,13 +264,30 @@ main =
 
    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 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) 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)