diff options
author | Simon Marlow <simonmar@microsoft.com> | 2007-04-18 11:47:00 +0000 |
---|---|---|
committer | Simon Marlow <simonmar@microsoft.com> | 2007-04-18 11:47:00 +0000 |
commit | 38e7ac3ffa32d75c1922e7247a910e06d9957116 (patch) | |
tree | deb72eb3adc4dc2252c4784932aa6e5da7924ace /compiler/ghci/GhciMonad.hs | |
parent | 71f74505bed49cf595bc9df3d1ba050448793c92 (diff) | |
download | haskell-38e7ac3ffa32d75c1922e7247a910e06d9957116.tar.gz |
Various cleanups and improvements to the breakpoint support
- move parts of the debugger implementation below the GHC API where
they belong. There is still more in Debugger that violates the
layering, hopefully I'll get to that later.
- instead of returning an IO action from runStmt for resuming,
return a ResumeHandle that is passed to GHC.resume.
- breakpoints now return [Name] which is displayed in the same
way as when a binding statement is executed.
- :load, :add, :reload now clear the active breakpoints and context
- :break gives a sensible error when used on a non-interpreted module
- export breakpoint-related types from GHC
- remove a bunch of layer-violating imports from InteractiveUI
- remove some more vestiges of the old breakpoint code (topLevel in
the GHCi state).
- remove TickTree and use a simple array instead, cached per module
Diffstat (limited to 'compiler/ghci/GhciMonad.hs')
-rw-r--r-- | compiler/ghci/GhciMonad.hs | 46 |
1 files changed, 24 insertions, 22 deletions
diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs index 3cab56b40c..d56a581d04 100644 --- a/compiler/ghci/GhciMonad.hs +++ b/compiler/ghci/GhciMonad.hs @@ -17,11 +17,13 @@ import Util import DynFlags import HscTypes import SrcLoc +import Module import Numeric +import Control.Concurrent import Control.Exception as Exception +import Data.Array import Data.Char -import Data.Dynamic import Data.Int ( Int64 ) import Data.IORef import Data.List @@ -43,11 +45,16 @@ data GHCiState = GHCiState session :: GHC.Session, options :: [GHCiOption], prelude :: GHC.Module, - topLevel :: Bool, - resume :: [IO GHC.RunResult], - breaks :: !ActiveBreakPoints + resume :: [(SrcSpan, ThreadId, GHC.ResumeHandle)], + breaks :: !ActiveBreakPoints, + tickarrays :: ModuleEnv TickArray + -- tickarrays caches the TickArray for loaded modules, + -- so that we don't rebuild it each time the user sets + -- a breakpoint. } +type TickArray = Array Int [(BreakIndex,SrcSpan)] + data GHCiOption = ShowTiming -- show time/allocs after evaluation | ShowType -- show the type of expressions @@ -86,8 +93,8 @@ getActiveBreakPoints :: GHCi ActiveBreakPoints getActiveBreakPoints = liftM breaks getGHCiState -- don't reset the counter back to zero? -clearActiveBreakPoints :: GHCi () -clearActiveBreakPoints = do +discardActiveBreakPoints :: GHCi () +discardActiveBreakPoints = do st <- getGHCiState let oldActiveBreaks = breaks st newActiveBreaks = oldActiveBreaks { breakLocations = [] } @@ -172,28 +179,23 @@ unsetOption opt io :: IO a -> GHCi a io m = GHCi { unGHCi = \s -> m >>= return } -isTopLevel :: GHCi Bool -isTopLevel = getGHCiState >>= return . topLevel - -getResume :: GHCi (Maybe (IO GHC.RunResult)) -getResume = do - st <- getGHCiState - case (resume st) of - [] -> return Nothing - (x:_) -> return $ Just x - -popResume :: GHCi () +popResume :: GHCi (Maybe (SrcSpan, ThreadId, GHC.ResumeHandle)) popResume = do st <- getGHCiState case (resume st) of - [] -> return () - (_:xs) -> setGHCiState $ st { resume = xs } + [] -> return Nothing + (x:xs) -> do setGHCiState $ st { resume = xs } ; return (Just x) -pushResume :: IO GHC.RunResult -> GHCi () -pushResume resumeAction = do +pushResume :: SrcSpan -> ThreadId -> GHC.ResumeHandle -> GHCi () +pushResume span threadId resumeAction = do st <- getGHCiState let oldResume = resume st - setGHCiState $ st { resume = resumeAction : oldResume } + setGHCiState $ st { resume = (span, threadId, resumeAction) : oldResume } + +discardResumeContext :: GHCi () +discardResumeContext = do + st <- getGHCiState + setGHCiState st { resume = [] } showForUser :: SDoc -> GHCi String showForUser doc = do |