X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=afd970214b5f1be4c5c9ac23e396158a0d8d97a1;hb=00fc612dc1e776ef34bd09b4f4ef4f6650d418b0;hp=9bba141e2eebf67784c27369e0b1eb9ebf05e627;hpb=0ebfc8bdb372157c9f238a387b0dadca3bbc667a;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 9bba141..afd9702 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -82,9 +82,10 @@ import Data.Array
 import Control.Monad as Monad
 import Text.Printf
 import Foreign
-import Foreign.C        ( withCStringLen )
+import Foreign.C
 import GHC.Exts		( unsafeCoerce# )
 import GHC.IOBase	( IOErrorType(InvalidArgument) )
+import GHC.TopHandler
 
 import Data.IORef	( IORef, readIORef, writeIORef )
 
@@ -419,14 +420,22 @@ runGHCi paths maybe_exprs = do
         Just exprs -> do
             -- just evaluate the expression we were given
             enqueueCommands exprs
-            let handleEval (ExitException code) = io (exitWith code)
-                handleEval e                    = handler e
-            runCommands' handleEval (return Nothing)
+            let handle e = do st <- getGHCiState
+                                   -- Jump through some hoops to get the
+                                   -- current progname in the exception text:
+                                   -- <progname>: <exception>
+                              io $ withProgName (progname st)
+                                   -- The "fast exit" part just calls exit()
+                                   -- directly instead of doing an orderly
+                                   -- runtime shutdown, otherwise the main
+                                   -- GHCi thread will complain about being
+                                   -- interrupted.
+                                 $ topHandlerFastExit e
+            runCommands' handle (return Nothing)
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
-
 interactiveLoop :: Bool -> Bool -> GHCi ()
 interactiveLoop is_tty show_prompt =
   -- Ignore ^C exceptions caught here