[project @ 2001-07-04 15:43:38 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 30dffc3..5d59167 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.76 2001/06/27 11:39:54 simonmar Exp $
+-- $Id: Main.hs,v 1.80 2001/07/04 15:43:38 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -59,7 +59,7 @@ import Panic          ( GhcException(..), panic )
 import IO
 import Directory       ( doesFileExist )
 import IOExts          ( readIORef, writeIORef )
-import Exception       ( throwDyn, Exception(DynException) )
+import Exception       ( throwDyn, Exception(..) )
 import System          ( getArgs, exitWith, ExitCode(..) )
 import Monad
 import List
@@ -67,7 +67,7 @@ import Maybe
 
 #ifndef mingw32_TARGET_OS
 import Concurrent      ( myThreadId )
-#ifdef __GLASGOW_HASKELL__ < 500
+#if __GLASGOW_HASKELL__ < 500
 import Exception        ( raiseInThread )
 #define throwTo  raiseInThread
 #else
@@ -111,8 +111,12 @@ import Dynamic             ( toDyn )
 
 main =
   -- top-level exception handler: any unrecognised exception is a compiler bug.
-  handle (\exception -> do hPutStr stderr (show (Panic (show exception)))
-                          exitWith (ExitFailure 1)
+  handle (\exception -> do
+          case exception of
+               -- an IO exception probably isn't our fault, so don't panic
+               IOException _ ->  hPutStr stderr (show exception)
+               _other        ->  hPutStr stderr (show (Panic (show exception)))
+          exitWith (ExitFailure 1)
          ) $ do
 
   -- all error messages are propagated as exceptions
@@ -156,12 +160,6 @@ main =
    (flags2, mode, stop_flag) <- getGhcMode argv'
    writeIORef v_GhcMode mode
 
-       -- Show the GHCi banner?
-#  ifdef GHCI
-   when (mode == DoInteractive) $
-      hPutStrLn stdout ghciWelcomeMsg
-#  endif
-
        -- process all the other arguments, and get the source files
    non_static <- processArgs static_flags flags2 []
 
@@ -229,9 +227,15 @@ main =
        -- complain about any unknown flags
    mapM unknownFlagErr [ f | f@('-':_) <- srcs ]
 
-       -- Display details of the configuration in verbose mode
    verb <- dynFlag verbosity
 
+       -- Show the GHCi banner
+#  ifdef GHCI
+   when (mode == DoInteractive && verb >= 1) $
+      hPutStrLn stdout ghciWelcomeMsg
+#  endif
+
+       -- Display details of the configuration in verbose mode
    when (verb >= 2) 
        (do hPutStr stderr "Glasgow Haskell Compiler, Version "
            hPutStr stderr cProjectVersion
@@ -314,7 +318,8 @@ beginMake fileish_args
        case mods of
         []    -> throwDyn (UsageError "no input files")
         mod   -> do state <- cmInit Batch
-                    cmLoadModule state mods
+                    (_, ok, _) <- cmLoadModule state mods
+                    when (not ok) (exitWith (ExitFailure 1))
                     return ()