-----------------------------
-- | 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
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
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
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),
("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),
" :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" ++
" 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"
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)
= 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)
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..."
RunResult(..),
runStmt,
showModule,
+ isModuleInterpreted,
compileExpr, HValue, dynCompileExpr,
lookupName,
-- 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))