From 53c9c9f6d4ba6a533250566d4952c005af56fc74 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Fri, 27 Apr 2007 15:38:52 +0000 Subject: [PATCH] give the statements under evaluation in the ":show context" output --- compiler/ghci/GhciMonad.hs | 18 +++++++++++++----- compiler/ghci/InteractiveUI.hs | 37 +++++++++++++++++++++---------------- 2 files changed, 34 insertions(+), 21 deletions(-) diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs index d63dfb1..f7f2014 100644 --- a/compiler/ghci/GhciMonad.hs +++ b/compiler/ghci/GhciMonad.hs @@ -47,7 +47,7 @@ data GHCiState = GHCiState session :: GHC.Session, options :: [GHCiOption], prelude :: GHC.Module, - resume :: [(SrcSpan, ThreadId, GHC.ResumeHandle)], + resume :: [EvalInProgress], breaks :: !ActiveBreakPoints, tickarrays :: ModuleEnv TickArray -- tickarrays caches the TickArray for loaded modules, @@ -69,6 +69,14 @@ data ActiveBreakPoints , breakLocations :: ![(Int, BreakLocation)] -- break location uniquely numbered } +-- The context of an evaluation in progress that stopped at a breakpoint +data EvalInProgress + = EvalInProgress + { evalStmt :: String, + evalSpan :: SrcSpan, + evalThreadId :: ThreadId, + evalResumeHandle :: GHC.ResumeHandle } + instance Outputable ActiveBreakPoints where ppr activeBrks = prettyLocations $ breakLocations activeBrks @@ -181,18 +189,18 @@ unsetOption opt io :: IO a -> GHCi a io m = GHCi { unGHCi = \s -> m >>= return } -popResume :: GHCi (Maybe (SrcSpan, ThreadId, GHC.ResumeHandle)) +popResume :: GHCi (Maybe EvalInProgress) popResume = do st <- getGHCiState case (resume st) of [] -> return Nothing (x:xs) -> do setGHCiState $ st { resume = xs } ; return (Just x) -pushResume :: SrcSpan -> ThreadId -> GHC.ResumeHandle -> GHCi () -pushResume span threadId resumeAction = do +pushResume :: EvalInProgress -> GHCi () +pushResume eval = do st <- getGHCiState let oldResume = resume st - setGHCiState $ st { resume = (span, threadId, resumeAction) : oldResume } + setGHCiState $ st { resume = eval : oldResume } discardResumeContext :: GHCi () discardResumeContext = do diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index cd08d11..53afbf3 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -451,9 +451,9 @@ mkPrompt toplevs exports resumes prompt f [] = empty perc_s - | (span,_,_):rest <- resumes + | eval:rest <- resumes = (if not (null rest) then text "... " else empty) - <> brackets (ppr span) <+> modules_prompt + <> brackets (ppr (evalSpan eval)) <+> modules_prompt | otherwise = modules_prompt @@ -521,13 +521,13 @@ runStmt stmt session <- getSession result <- io $ withProgName (progname st) $ withArgs (args st) $ GHC.runStmt session stmt - switchOnRunResult result + switchOnRunResult stmt result -switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name])) -switchOnRunResult GHC.RunFailed = return Nothing -switchOnRunResult (GHC.RunException e) = throw e -switchOnRunResult (GHC.RunOk names) = return $ Just (False,names) -switchOnRunResult (GHC.RunBreak threadId names info resume) = do +switchOnRunResult :: String -> GHC.RunResult -> GHCi (Maybe (Bool,[Name])) +switchOnRunResult stmt GHC.RunFailed = return Nothing +switchOnRunResult stmt (GHC.RunException e) = throw e +switchOnRunResult stmt (GHC.RunOk names) = return $ Just (False,names) +switchOnRunResult stmt (GHC.RunBreak threadId names info resume) = do session <- getSession Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info) let modBreaks = GHC.modInfoModBreaks mod_info @@ -537,7 +537,10 @@ switchOnRunResult (GHC.RunBreak threadId names info resume) = do let location = ticks ! GHC.breakInfo_number info printForUser $ ptext SLIT("Stopped at") <+> ppr location - pushResume location threadId resume + pushResume EvalInProgress{ evalStmt = stmt, + evalSpan = location, + evalThreadId = threadId, + evalResumeHandle = resume } -- run the command set with ":set stop " st <- getGHCiState @@ -1150,9 +1153,11 @@ showBkptTable = do showContext :: GHCi () showContext = do st <- getGHCiState - printForUser $ vcat (map pp_resume (resume st)) + printForUser $ vcat (map pp_resume (reverse (resume st))) where - pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span + pp_resume eval = + ptext SLIT("--> ") <> text (evalStmt eval) + $$ nest 2 (ptext SLIT("Stopped at") <+> ppr (evalSpan eval)) -- ----------------------------------------------------------------------------- -- Completion @@ -1386,11 +1391,11 @@ doContinue actionBeforeCont = do Nothing -> do io $ putStrLn "There is no computation running." return False - Just (_,_,handle) -> do + Just eval -> do io $ actionBeforeCont session <- getSession - runResult <- io $ GHC.resume session handle - names <- switchOnRunResult runResult + runResult <- io $ GHC.resume session (evalResumeHandle eval) + names <- switchOnRunResult (evalStmt eval) runResult finishEvalExpr names return False @@ -1400,7 +1405,7 @@ abandonCmd "" = do case mb_res of Nothing -> do io $ putStrLn "There is no computation running." - Just (span,_,_) -> + Just eval -> return () -- the prompt will change to indicate the new context @@ -1570,7 +1575,7 @@ listCmd str = do st <- getGHCiState case resume st of [] -> printForUser $ text "not stopped at a breakpoint; nothing to list" - (span,_,_):_ -> io $ listAround span True + eval:_ -> io $ listAround (evalSpan eval) True -- | list a section of a source file around a particular SrcSpan. -- If the highlight flag is True, also highlight the span using -- 1.7.10.4