From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 2 Jun 2010 08:23:45 +0000 (+0000)
Subject: Use UserInterrupt rather than our own Interrupted exception (#4100)
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=d529d596a1256bb48bda45ec343631c879c8d56d

Use UserInterrupt rather than our own Interrupted exception (#4100)
---

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 64042e2..f532061 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -334,6 +334,7 @@ defaultErrorHandler dflags inner =
                 Just (ioe :: IOException) ->
                   fatalErrorMsg dflags (text (show ioe))
                 _ -> case fromException exception of
+		     Just UserInterrupt -> exitWith (ExitFailure 1)
                      Just StackOverflow ->
                          fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
                      _ -> case fromException exception of
@@ -350,7 +351,6 @@ defaultErrorHandler dflags inner =
   		hFlush stdout
   		case ge of
 		     PhaseFailed _ code -> exitWith code
-		     Interrupted -> exitWith (ExitFailure 1)
 		     Signal _ -> exitWith (ExitFailure 1)
 		     _ -> do fatalErrorMsg dflags (text (show ge))
 			     exitWith (ExitFailure 1)
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 45519ff..38f0998 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -380,9 +380,9 @@ rethrow dflags io = Exception.catch io $ \se -> do
                    not (dopt Opt_BreakOnException dflags)
                     then poke exceptionFlag 1
                     else case fromException se of
-                         -- If it is an "Interrupted" exception, we allow
+                         -- If it is a "UserInterrupt" exception, we allow
                          --  a possible break by way of -fbreak-on-exception
-                         Just Interrupted -> return ()
+                         Just UserInterrupt -> return ()
                          -- In any other case, we don't want to break
                          _ -> poke exceptionFlag 0
 
diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
index ee06777..e11b28f 100644
--- a/compiler/utils/Panic.lhs
+++ b/compiler/utils/Panic.lhs
@@ -63,7 +63,6 @@ ghcError e = Exception.throw e
 data GhcException
   = PhaseFailed String		-- name of phase 
   		ExitCode	-- an external phase (eg. cpp) failed
-  | Interrupted			-- someone pressed ^C
   | Signal Int                  -- some other fatal signal (SIGHUP,SIGTERM)
   | UsageError String		-- prints the short usage msg after the error
   | CmdLineError String		-- cmdline prob, but doesn't print usage
@@ -107,8 +106,6 @@ showGhcException (ProgramError str)
    = showString str
 showGhcException (InstallationError str)
    = showString str
-showGhcException (Interrupted)
-   = showString "interrupted"
 showGhcException (Signal n)
    = showString "signal: " . shows n
 showGhcException (Panic s)
@@ -151,7 +148,7 @@ assertPanic file line =
 \end{code}
 
 \begin{code}
--- | tryMost is like try, but passes through Interrupted and Panic
+-- | tryMost is like try, but passes through UserInterrupt and Panic
 -- exceptions.  Used when we want soft failures when reading interface
 -- files, for example.
 
@@ -162,7 +159,6 @@ tryMost action = do r <- try action
                         Left se ->
                             case fromException se of
                                 -- Some GhcException's we rethrow,
-                                Just Interrupted -> throwIO se
                                 Just (Signal _)  -> throwIO se
                                 Just (Panic _)   -> throwIO se
                                 -- others we return
@@ -189,7 +185,7 @@ installSignalHandlers = do
   modifyMVar_ interruptTargetThread (return . (main_thread :))
 
   let
-      interrupt_exn = (toException Interrupted)
+      interrupt_exn = (toException UserInterrupt)
 
       interrupt = do
 	withMVar interruptTargetThread $ \targets ->
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 22bff85..fb8bcb1 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -572,9 +572,14 @@ runCommands = runCommands' handler
 runCommands' :: (SomeException -> GHCi Bool) -- Exception handler
              -> InputT GHCi (Maybe String) -> InputT GHCi ()
 runCommands' eh getCmd = do
-    b <- handleGhcException (\e -> case e of
-                    Interrupted -> return False
-                    _other -> liftIO (print e) >> return True)
+    b <- ghandle (\e -> case fromException e of
+                          Just UserInterrupt -> return False
+                          _ -> case fromException e of
+                                 Just ghc_e ->
+                                   do liftIO (print (ghc_e :: GhcException))
+                                      return True
+                                 _other ->
+                                   liftIO (Exception.throwIO e))
             (runOneCommand eh getCmd)
     if b then return () else runCommands' eh getCmd
 
@@ -1726,13 +1731,15 @@ handler exception = do
 showException :: SomeException -> GHCi ()
 showException se =
   io $ case fromException se of
-       Just Interrupted         -> putStrLn "Interrupted."
        -- omit the location for CmdLineError:
        Just (CmdLineError s)    -> putStrLn s
        -- ditto:
        Just ph@(PhaseFailed {}) -> putStrLn (showGhcException ph "")
        Just other_ghc_ex        -> print other_ghc_ex
-       Nothing                  -> putStrLn ("*** Exception: " ++ show se)
+       Nothing                  -> 
+         case fromException se of
+           Just UserInterrupt -> putStrLn "Interrupted."
+           _other             -> putStrLn ("*** Exception: " ++ show se)
 
 -----------------------------------------------------------------------------
 -- recursive exception handlers