Reload modules after ':break stop'

This is necessary to revert CAFs. Previously to this patch the user would get a msg "You may need to reload your modules". This patch takes care of that

diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs
index df588aa..d95fc59 100644 (file)
--- a/compiler/ghci/GhciMonad.hs
+++ b/compiler/ghci/GhciMonad.hs
@@ -118,69 +118,16 @@ showForUser doc = do
   unqual <- io (GHC.getPrintUnqual session)
   return $! showSDocForUser unqual doc
 
------------------------------------------------------------------------------
--- User code exception handling
+-- --------------------------------------------------------------------------
+-- Inferior Sessions Exceptions (used by the debugger)
 
--- This hierarchy of exceptions is used to signal interruption of a child session
-data BkptException = StopChildSession -- A child debugging session requests to be stopped
-                   | ChildSessionStopped String  
+data InfSessionException = 
+             StopChildSession -- A child session requests to be stopped
+           | ChildSessionStopped String  -- A child session has stopped
   deriving Typeable
 
--- This is the exception handler for exceptions generated by the
--- user's code and exceptions coming from children sessions; 
--- 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 (DynException dyn)        
-  | Just StopChildSession <- fromDynamic dyn 
- -- propagate to the parent session
-  = do ASSERTM (liftM not isTopLevel) 
-       throwDyn StopChildSession
-
-  | Just (ChildSessionStopped msg) <- fromDynamic dyn 
- -- Revert CAFs and display some message
-  = do ASSERTM (isTopLevel) 
-       io (revertCAFs >> putStrLn msg)
-       return False
-
-handler exception = do
-  flushInterpBuffers
-  io installSignalHandlers
-  ghciHandle handler (showException exception >> return False)
-
-showException (DynException dyn) =
-  case fromDynamic dyn of
-    Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
-    Just Interrupted      -> io (putStrLn "Interrupted.")
-    Just (CmdLineError s) -> io (putStrLn s)    -- omit the location for CmdLineError
-    Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
-    Just other_ghc_ex     -> io (print other_ghc_ex)
-
-showException other_exception
-  = io (putStrLn ("*** Exception: " ++ show other_exception))
-
------------------------------------------------------------------------------
--- recursive exception handlers
-
--- Don't forget to unblock async exceptions in the handler, or if we're
--- in an exception loop (eg. let a = error a in a) the ^C exception
--- may never be delivered.  Thanks to Marcin for pointing out the bug.
 
-ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
-ghciHandle h (GHCi m) = GHCi $ \s -> 
-   Exception.catch (m s) 
-       (\e -> unGHCi (ghciUnblock (h e)) s)
-
-ghciUnblock :: GHCi a -> GHCi a
-ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
-
------------------------------------------------------------------------------
+-- --------------------------------------------------------------------------
 -- timing & statistics
 
 timeIt :: GHCi a -> GHCi a

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index b9b82ac..d6f557d 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -85,6 +85,7 @@ import System.Directory
 import System.IO
 import System.IO.Error as IO
 import Data.Char
+import Data.Dynamic
 import Control.Monad as Monad
 import Foreign.StablePtr       ( newStablePtr )
 
@@ -1366,6 +1367,61 @@ completeHomeModuleOrFile=completeNone
 completeBkpt       = completeNone
 #endif
 
+-- ---------------------------------------------------------------------------
+-- User code exception handling
+
+-- This is the exception handler for exceptions generated by the
+-- user's code and exceptions coming from children sessions; 
+-- 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 (DynException dyn) 
+  | Just StopChildSession <- fromDynamic dyn 
+     -- propagate to the parent session
+  = ASSERTM (liftM not isTopLevel) >> throwDyn StopChildSession
+
+  | Just (ChildSessionStopped msg) <- fromDynamic dyn 
+     -- Reload modules and display some message
+  = ASSERTM (isTopLevel) >> io(putStrLn msg) >> return False
+
+handler exception = do
+  flushInterpBuffers
+  io installSignalHandlers
+  ghciHandle handler (showException exception >> return False)
+
+showException (DynException dyn) =
+  case fromDynamic dyn of
+    Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
+    Just Interrupted      -> io (putStrLn "Interrupted.")
+    Just (CmdLineError s) -> io (putStrLn s)    -- omit the location for CmdLineError
+    Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
+    Just other_ghc_ex     -> io (print other_ghc_ex)
+
+showException other_exception
+  = io (putStrLn ("*** Exception: " ++ show other_exception))
+
+-----------------------------------------------------------------------------
+-- recursive exception handlers
+
+-- Don't forget to unblock async exceptions in the handler, or if we're
+-- in an exception loop (eg. let a = error a in a) the ^C exception
+-- may never be delivered.  Thanks to Marcin for pointing out the bug.
+
+ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
+ghciHandle h (GHCi m) = GHCi $ \s -> 
+   Exception.catch (m s) 
+       (\e -> unGHCi (ghciUnblock (h e)) s)
+
+ghciUnblock :: GHCi a -> GHCi a
+ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
+
+
 -- ----------------------------------------------------------------------------
 -- Utils
 
@@ -1450,8 +1506,8 @@ doBreakpoint ref_bkptTable s@(Session ref) values _ locMsg b = do
                               prelude  = prel_mod,
                              topLevel = False }
              `catchDyn` (
-                 \StopChildSession -> evaluate$ 
-                     throwDyn (ChildSessionStopped "You may need to reload your modules")
+                 \StopChildSession -> evaluate$
+                        throwDyn (ChildSessionStopped "")
            ) `finally` do
              writeIORef ref hsc_env
              putStrLn $ "Returning to normal execution..."