From: Ian Lynagh <igloo@earth.li>
Date: Mon, 21 Jan 2008 10:41:42 +0000 (+0000)
Subject: Fix exception message with ghc -e
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=00fc612dc1e776ef34bd09b4f4ef4f6650d418b0

Fix exception message with ghc -e
When running with ghc -e, exceptions should claim to be from the program
that we are running, not ghc.
---

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