[project @ 2002-12-12 13:21:46 by ross]

[ghc-hetmet.git] / ghc / compiler / ghci / InteractiveUI.hs

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index af140e5..5801a38 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.137 2002/10/17 14:49:52 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.139 2002/12/12 13:21:46 ross Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -295,7 +295,7 @@ fileLoop hdl prompt = do
    l <- io (IO.try (hGetLine hdl))
    case l of
        Left e | isEOFError e -> return ()
-              | otherwise    -> throw e
+              | otherwise    -> io (ioError e)
        Right l -> 
          case remove_spaces l of
            "" -> fileLoop hdl prompt
@@ -334,16 +334,22 @@ readlineLoop = do
                  if quit then return () else readlineLoop
 #endif
 
--- Top level exception handler, just prints out the exception 
--- and carries on.
 runCommand :: String -> GHCi Bool
-runCommand c = 
-  ghciHandle ( \exception -> do
-               flushInterpBuffers
-               showException exception
-               return False
-            ) $
-  doCommand c
+runCommand c = ghciHandle handler (doCommand c)
+
+-- This is the exception handler for exceptions generated by the
+-- user's code; it normally just prints out the exception.  The
+-- handler must be recursive, in case showing the exception causes
+-- more exceptions to be raised.
+--
+-- Bugfix: if the user closed stdout or stderr, the flushing will fail,
+-- raising another exception.  We therefore don't put the recursive
+-- handler arond the flushing operation, so if stderr is closed
+-- GHCi will just die gracefully rather than going into an infinite loop.
+handler :: Exception -> GHCi Bool
+handler exception = do
+  flushInterpBuffers
+  ghciHandle handler (showException exception >> return False)
 
 showException (DynException dyn) =
   case fromDynamic dyn of
@@ -1009,7 +1015,7 @@ io m = GHCi { unGHCi = \s -> m >>= return }
 ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
 ghciHandle h (GHCi m) = GHCi $ \s -> 
    Exception.catch (m s) 
-       (\e -> unGHCi (ghciHandle h (ghciUnblock (h e))) s)
+       (\e -> unGHCi (ghciUnblock (h e)) s)
 
 ghciUnblock :: GHCi a -> GHCi a
 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)