Added the new :breakpoint continue option
authorPepe Iborra <mnislaih@gmail.com>
Thu, 11 Jan 2007 13:13:59 +0000 (13:13 +0000)
committerPepe Iborra <mnislaih@gmail.com>
Thu, 11 Jan 2007 13:13:59 +0000 (13:13 +0000)
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
compiler/ghci/GhciMonad.hs
compiler/ghci/InteractiveUI.hs
compiler/main/GHC.hs

index b158d33..0817259 100644 (file)
@@ -297,11 +297,19 @@ stripUnknowns _ id = id
 -----------------------------
 -- | The :breakpoint command
 -----------------------------
 -----------------------------
 -- | 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
 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 
    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
 
                             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
     bkptOptions' ("add":cmds) bt 
       | [mod_name,line]<- cmds
       , [(lineNum,[])] <- reads line
@@ -373,7 +377,7 @@ bkptOptions cmd = do
                io$ putStrLn delMsg
 
     bkptOptions' _ _ = throwDyn $ CmdLineError $ 
                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
 
 -- Error messages
     handleBkptEx :: Module -> Debugger.BkptException -> a
index e536841..df5b119 100644 (file)
@@ -124,6 +124,8 @@ showForUser doc = do
 
 data InfSessionException = 
              StopChildSession -- A child session requests to be stopped
 
 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
 
            | ChildSessionStopped String  -- A child session has stopped
   deriving Typeable
 
index c2fb51d..d2ed976 100644 (file)
@@ -114,6 +114,11 @@ builtin_commands :: [Command]
 builtin_commands = [
   ("add",      tlC$ keepGoingPaths addModule,  False, completeFilename),
   ("browse",    keepGoing browseCmd,           False, completeModule),
 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),
   ("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),
   ("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),
 #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" ++
  "   :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" ++
  "   :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" ++
  "   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"
 
  "   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
                           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)
 
 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
 
   = 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) 
   | 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 }
                               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..."
            ) `finally` do
              writeIORef ref hsc_env
              putStrLn $ "Returning to normal execution..."
index 5c0dbcd..32bcf25 100644 (file)
@@ -82,6 +82,7 @@ module GHC (
        RunResult(..),
        runStmt,
        showModule,
        RunResult(..),
        runStmt,
        showModule,
+        isModuleInterpreted,
        compileExpr, HValue, dynCompileExpr,
        lookupName,
 
        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
 -- 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"
   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))
 
                      where
                         obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))