From 025733b8367d9108e8992b2db3dbb9f80cad4fa9 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <mnislaih@gmail.com>
Date: Thu, 11 Jan 2007 13:13:59 +0000
Subject: [PATCH] Added the new :breakpoint continue option

Previously, when in a breakpoint, :quit was used to continue execution.
This is not the right thing to do, so this patch restores :quit to its
original meaning whether or not ghci is in an inferior session.

The continue behavior is now provided by ":breakpoint continue".
I added a synonim command in :continue because it is much shorter,
but this is optional
---
 compiler/ghci/Debugger.hs      |   16 ++++++++++------
 compiler/ghci/GhciMonad.hs     |    2 ++
 compiler/ghci/InteractiveUI.hs |   26 +++++++++++++++++++++-----
 compiler/main/GHC.hs           |   10 ++++++++--
 4 files changed, 41 insertions(+), 13 deletions(-)

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index b158d33..0817259 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -297,11 +297,19 @@ stripUnknowns _ id = id
 -----------------------------
 -- | The :breakpoint command
 -----------------------------
-bkptOptions :: String -> GHCi ()
+bkptOptions :: String -> GHCi Bool
+bkptOptions "continue" = -- We want to quit if in an inferior session
+                         liftM not isTopLevel 
+bkptOptions "stop" = do
+  inside_break <- liftM not isTopLevel
+  when inside_break $ throwDyn StopChildSession 
+  return False
+
 bkptOptions cmd = do 
   dflags <- getDynFlags
   bt     <- getBkptTable
   bkptOptions' (words cmd) bt
+  return False
    where
     bkptOptions' ["list"] bt = do 
       let msgs = [ ppr mod <+> colon <+> ppr coords 
@@ -313,10 +321,6 @@ bkptOptions cmd = do
                             else vcat num_msgs
       io$ putStrLn msg
 
-    bkptOptions' ["stop"] bt = do
-        inside_break <- liftM not isTopLevel
-        when inside_break $ throwDyn StopChildSession
-
     bkptOptions' ("add":cmds) bt 
       | [mod_name,line]<- cmds
       , [(lineNum,[])] <- reads line
@@ -373,7 +377,7 @@ bkptOptions cmd = do
                io$ putStrLn delMsg
 
     bkptOptions' _ _ = throwDyn $ CmdLineError $ 
-                         "syntax: :breakpoint (list|stop|add|del)"
+                         "syntax: :breakpoint (list|continue|stop|add|del)"
 
 -- Error messages
     handleBkptEx :: Module -> Debugger.BkptException -> a
diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs
index e536841..df5b119 100644
--- a/compiler/ghci/GhciMonad.hs
+++ b/compiler/ghci/GhciMonad.hs
@@ -124,6 +124,8 @@ showForUser doc = do
 
 data InfSessionException = 
              StopChildSession -- A child session requests to be stopped
+           | StopParentSession -- A child session requests to be stopped 
+                               -- AND that the parent session quits after that
            | ChildSessionStopped String  -- A child session has stopped
   deriving Typeable
 
diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index c2fb51d..d2ed976 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -114,6 +114,11 @@ builtin_commands :: [Command]
 builtin_commands = [
   ("add",	tlC$ keepGoingPaths addModule,	False, completeFilename),
   ("browse",    keepGoing browseCmd,		False, completeModule),
+#ifdef DEBUGGER
+        -- I think that :c should mean :continue rather than :cd, makes more sense
+        --  (pepe 01.11.07)
+  ("continue",  const(bkptOptions "continue"),  False, completeNone),
+#endif
   ("cd",    	tlC$ keepGoing changeDirectory,	False, completeFilename),
   ("def",	keepGoing defineMacro,		False, completeIdentifier),
   ("e", 	keepGoing editFile,		False, completeFilename),
@@ -136,7 +141,7 @@ builtin_commands = [
   ("print",     keepGoing (pprintClosureCommand True False), False, completeIdentifier),
   ("sprint",    keepGoing (pprintClosureCommand False False),False, completeIdentifier),
   ("force",     keepGoing (pprintClosureCommand False True), False, completeIdentifier),
-  ("breakpoint",keepGoing bkptOptions,          False, completeBkpt),
+  ("breakpoint",bkptOptions,                    False, completeBkpt),
 #endif
   ("kind",	keepGoing kindOfType,		False, completeIdentifier),
   ("unset",	keepGoing unsetOptions,		True,  completeSetOptions),
@@ -169,6 +174,7 @@ helpText =
  "   :breakpoint <option>        commands for the GHCi debugger\n" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
+ "   :continue                   equivalent to ':breakpoint continue'\n"  ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
  "   :edit <file>                edit file\n" ++
  "   :edit                       edit last module\n" ++
@@ -211,6 +217,7 @@ helpText =
  "   list                                     list the current breakpoints\n" ++
  "   add Module line [col]                    add a new breakpoint\n" ++
  "   del (breakpoint# | Module line [col])    delete a breakpoint\n" ++
+ "   continue                                 continue execution\n"  ++
  "   stop                   Stop a computation and return to the top level\n" ++
  "   step [count]           Step by step execution (DISABLED)\n"
 
@@ -843,7 +850,11 @@ kindOfType str
 		           io (putStrLn (str ++ " :: " ++ tystr))
 
 quit :: String -> GHCi Bool
-quit _ = return True
+quit _ =  do in_inferior_session <- liftM not isTopLevel 
+             if in_inferior_session 
+               then throwDyn StopParentSession
+               else return True
+          
 
 shellEscape :: String -> GHCi Bool
 shellEscape str = io (system str >> return False)
@@ -1387,6 +1398,10 @@ handler (DynException dyn)
   = do ASSERTM (liftM not isTopLevel) 
        throwDyn StopChildSession
 
+  | Just StopParentSession <- fromDynamic dyn 
+  = do at_topLevel <-  isTopLevel
+       if at_topLevel then return True else throwDyn StopParentSession
+  
   | Just (ChildSessionStopped msg) <- fromDynamic dyn 
      -- Reload modules and display some message
   = do ASSERTM (isTopLevel) 
@@ -1507,9 +1522,10 @@ doBreakpoint ref_bkptTable s@(Session ref) values _ locMsg b = do
                               bkptTable= ref_bkptTable,
                               prelude  = prel_mod,
 			      topLevel = False }
-             `catchDyn` (
-                 \StopChildSession -> evaluate$
-                        throwDyn (ChildSessionStopped "")
+             `catchDyn` (\e -> case e of 
+                           StopChildSession -> evaluate$
+                                               throwDyn (ChildSessionStopped "")
+                           StopParentSession -> throwDyn StopParentSession
            ) `finally` do
              writeIORef ref hsc_env
              putStrLn $ "Returning to normal execution..."
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 5c0dbcd..32bcf25 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -82,6 +82,7 @@ module GHC (
 	RunResult(..),
 	runStmt,
 	showModule,
+        isModuleInterpreted,
 	compileExpr, HValue, dynCompileExpr,
 	lookupName,
 
@@ -2212,10 +2213,15 @@ foreign import "rts_evalStableIO"  {- safe -}
 -- show a module and it's source/object filenames
 
 showModule :: Session -> ModSummary -> IO String
-showModule s mod_summary = withSession s $ \hsc_env -> do
+showModule s mod_summary = withSession s $                        \hsc_env -> 
+                           isModuleInterpreted s mod_summary >>=  \interpreted -> 
+                           return (showModMsg (hscTarget(hsc_dflags hsc_env)) interpreted mod_summary)
+
+isModuleInterpreted :: Session -> ModSummary -> IO Bool
+isModuleInterpreted s mod_summary = withSession s $ \hsc_env -> 
   case lookupUFM (hsc_HPT hsc_env) (ms_mod_name mod_summary) of
 	Nothing	      -> panic "missing linkable"
-	Just mod_info -> return (showModMsg (hscTarget (hsc_dflags hsc_env)) (not obj_linkable) mod_summary)
+	Just mod_info -> return (not obj_linkable)
 		      where
 			 obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
 
-- 
1.7.10.4