[project @ 2001-11-03 01:30:42 by sof]

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

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 9c8827b..fb1556c 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.89 2001/10/25 02:13:13 sof Exp $
+-- $Id: Main.hs,v 1.91 2001/11/03 01:30:42 sof Exp $
 --
 -- GHC Driver program
 --
@@ -43,7 +43,7 @@ import DriverFlags    ( dynFlag, buildStaticHscOpts, dynamic_flags,
                          processArgs, static_flags)
 
 import DriverMkDepend  ( beginMkDependHS, endMkDependHS )
-import DriverPhases    ( Phase(Hsc, HCc), haskellish_src_file, objish_file )
+import DriverPhases    ( Phase(HsPp, Hsc, HCc), haskellish_src_file, objish_file )
 
 import DriverUtil      ( add, handle, handleDyn, later, splitFilename,
                          unknownFlagErr, getFileSuffix )
@@ -113,6 +113,7 @@ import Dynamic              ( toDyn )
 main =
   -- top-level exception handler: any unrecognised exception is a compiler bug.
   handle (\exception -> do
+          hFlush stdout
           case exception of
                -- an IO exception probably isn't our fault, so don't panic
                IOException _ ->  hPutStr stderr (show exception)
@@ -121,11 +122,13 @@ main =
          ) $ 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)
+  handleDyn (\dyn -> do
+               hFlush stdout
+               case dyn of
+                    PhaseFailed _phase code -> exitWith code
+                    Interrupted -> exitWith (ExitFailure 1)
+                    _ -> do hPutStrLn stderr (show (dyn :: GhcException))
+                            exitWith (ExitFailure 1)
            ) $ do
 
    -- make sure we clean up after ourselves
@@ -286,11 +289,12 @@ main =
 
          -- just preprocess (Haskell source only)
          let src_and_suff = (src, getFileSuffix src)
-         pp <- if not (haskellish_src_file src) || mode == StopBefore Hsc
+         let not_hs_file  = not (haskellish_src_file src)
+         pp <- if not_hs_file || mode == StopBefore Hsc || mode == StopBefore HsPp
                        then return src_and_suff else do
                phases <- genPipeline (StopBefore Hsc) stop_flag
-                           False{-not persistent-} defaultHscLang
-                           src_and_suff
+                                     False{-not persistent-} defaultHscLang
+                                     src_and_suff
                pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-}
                        basename suffix