From ae2b9180cbb5b48af77502c65366bec7b788482b Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Fri, 11 May 2007 12:49:29 +0000 Subject: [PATCH] Support for adding custom commands to an individual breakpoint :set stop N runs when breakpoint N is hit. Note that the command to run might be a macro (defined with :def), and the macro can invoke :continue, so it is now possible to do clever things like conditional breakpoints, or ignoring the next K hits of a breakpoint. --- compiler/ghci/GhciMonad.hs | 14 +++++-- compiler/ghci/InteractiveUI.hs | 85 +++++++++++++++++++++++++++------------- 2 files changed, 69 insertions(+), 30 deletions(-) diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs index 9e31376..f68da83 100644 --- a/compiler/ghci/GhciMonad.hs +++ b/compiler/ghci/GhciMonad.hs @@ -50,10 +50,11 @@ data GHCiState = GHCiState prelude :: GHC.Module, break_ctr :: !Int, breaks :: ![(Int, BreakLocation)], - tickarrays :: ModuleEnv TickArray + tickarrays :: ModuleEnv TickArray, -- tickarrays caches the TickArray for loaded modules, -- so that we don't rebuild it each time the user sets -- a breakpoint. + cmdqueue :: [String] } type TickArray = Array Int [(BreakIndex,SrcSpan)] @@ -69,15 +70,22 @@ data BreakLocation { breakModule :: !GHC.Module , breakLoc :: !SrcSpan , breakTick :: {-# UNPACK #-} !Int + , onBreakCmd :: String } - deriving Eq + +instance Eq BreakLocation where + loc1 == loc2 = breakModule loc1 == breakModule loc2 && + breakTick loc1 == breakTick loc2 prettyLocations :: [(Int, BreakLocation)] -> SDoc prettyLocations [] = text "No active breakpoints." prettyLocations locs = vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ reverse $ locs instance Outputable BreakLocation where - ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) + ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> + if null (onBreakCmd loc) + then empty + else doubleQuotes (text (onBreakCmd loc)) recordBreak :: BreakLocation -> GHCi (Bool{- was already present -}, Int) recordBreak brkLoc = do diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index bc0b3bc..6d0a870 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -287,7 +287,8 @@ interactiveUI session srcs maybe_expr = do prelude = prel_mod, break_ctr = 0, breaks = [], - tickarrays = emptyModuleEnv + tickarrays = emptyModuleEnv, + cmdqueue = [] } #ifdef USE_READLINE @@ -446,17 +447,9 @@ fileLoop hdl show_prompt = do Right l -> case removeSpaces l of "" -> fileLoop hdl show_prompt - l -> do quit <- runCommand l + l -> do quit <- runCommands l if quit then return () else fileLoop hdl show_prompt -stringLoop :: [String] -> GHCi Bool{-True: we quit-} -stringLoop [] = return False -stringLoop (s:ss) = do - case removeSpaces s of - "" -> stringLoop ss - l -> do quit <- runCommand l - if quit then return True else stringLoop ss - mkPrompt = do session <- getSession (toplevs,exports) <- io (GHC.getContext session) @@ -514,17 +507,31 @@ readlineLoop = do "" -> readlineLoop l -> do io (addHistory l) - quit <- runCommand l + quit <- runCommands l if quit then return () else readlineLoop #endif -runCommand :: String -> GHCi Bool -runCommand c = ghciHandle handler (doCommand c) - where - doCommand (':' : command) = specialCommand command - doCommand stmt - = do timeIt $ runStmt stmt GHC.RunToCompletion - return False +runCommands :: String -> GHCi Bool +runCommands cmd = do + q <- ghciHandle handler (doCommand cmd) + if q then return True else runNext + where + runNext = do + st <- getGHCiState + case cmdqueue st of + [] -> return False + c:cs -> do setGHCiState st{ cmdqueue = cs } + runCommands c + + doCommand (':' : cmd) = specialCommand cmd + doCommand stmt = do timeIt $ runStmt stmt GHC.RunToCompletion + return False + +enqueueCommands :: [String] -> GHCi () +enqueueCommands cmds = do + st <- getGHCiState + setGHCiState st{ cmdqueue = cmds ++ cmdqueue st } + -- This version is for the GHC command-line option -e. The only difference -- from runCommand is that it catches the ExitException exception and @@ -563,14 +570,15 @@ afterRunStmt run_result = do GHC.RunOk names -> do show_types <- isOptionSet ShowType when show_types $ mapM_ (showTypeOfName session) names - GHC.RunBreak _ names _ -> do + GHC.RunBreak _ names info -> do resumes <- io $ GHC.getResumeContext session printForUser $ ptext SLIT("Stopped at") <+> ppr (GHC.resumeSpan (head resumes)) mapM_ (showTypeOfName session) names + runBreakCmd info -- run the command set with ":set stop " st <- getGHCiState - runCommand (stop st) + enqueueCommands [stop st] return () _ -> return () @@ -581,6 +589,17 @@ afterRunStmt run_result = do return (case run_result of GHC.RunOk _ -> True; _ -> False) +runBreakCmd :: GHC.BreakInfo -> GHCi () +runBreakCmd info = do + let mod = GHC.breakInfo_module info + nm = GHC.breakInfo_number info + st <- getGHCiState + case [ loc | (i,loc) <- breaks st, + breakModule loc == mod, breakTick loc == nm ] of + [] -> return () + loc:_ | null cmd -> return () + | otherwise -> do enqueueCommands [cmd]; return () + where cmd = onBreakCmd loc showTypeOfName :: Session -> Name -> GHCi () showTypeOfName session n @@ -674,8 +693,7 @@ pprInfo exts (thing, fixity, insts) runMain :: String -> GHCi () runMain args = do let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args)) - runCommand $ '[': ss ++ "] `System.Environment.withArgs` main" - return () + enqueueCommands ['[': ss ++ "] `System.Environment.withArgs` main"] addModule :: [FilePath] -> GHCi () addModule files = do @@ -748,7 +766,8 @@ defineMacro s = do runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool runMacro fun s = do str <- io ((unsafeCoerce# fun :: String -> IO String) s) - stringLoop (lines str) + enqueueCommands (lines str) + return False undefineMacro :: String -> GHCi () undefineMacro macro_name = do @@ -1064,6 +1083,19 @@ setEditor cmd = do st <- getGHCiState setGHCiState st{ editor = cmd } +setStop str@(c:_) | isDigit c + = do let (nm_str,rest) = break (not.isDigit) str + nm = read nm_str + st <- getGHCiState + let old_breaks = breaks st + if all ((/= nm) . fst) old_breaks + then printForUser (text "Breakpoint" <+> ppr nm <+> + text "does not exist") + else do + let new_breaks = map fn old_breaks + fn (i,loc) | i == nm = (i,loc { onBreakCmd = dropWhile isSpace rest }) + | otherwise = (i,loc) + setGHCiState st{ breaks = new_breaks } setStop cmd = do st <- getGHCiState setGHCiState st{ stop = cmd } @@ -1518,8 +1550,7 @@ backCmd = noArgs $ do mapM_ (showTypeOfName s) names -- run the command set with ":set stop " st <- getGHCiState - runCommand (stop st) - return () + enqueueCommands [stop st] forwardCmd :: String -> GHCi () forwardCmd = noArgs $ do @@ -1531,8 +1562,7 @@ forwardCmd = noArgs $ do mapM_ (showTypeOfName s) names -- run the command set with ":set stop " st <- getGHCiState - runCommand (stop st) - return () + enqueueCommands [stop st] -- handle the "break" command breakCmd :: String -> GHCi () @@ -1596,6 +1626,7 @@ findBreakAndSet mod lookupTickTree = do { breakModule = mod , breakLoc = span , breakTick = tick + , onBreakCmd = "" } printForUser $ text "Breakpoint " <> ppr nm <> -- 1.7.10.4