X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FGhciMonad.hs;h=f7f2014ea29c5d25d6483cbc8b44845a5fcaedca;hb=53c9c9f6d4ba6a533250566d4952c005af56fc74;hp=d56a581d04f9e960c6d5ab2e7a65cc0d3ca77ab8;hpb=38e7ac3ffa32d75c1922e7247a910e06d9957116;p=ghc-hetmet.git diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs index d56a581..f7f2014 100644 --- a/compiler/ghci/GhciMonad.hs +++ b/compiler/ghci/GhciMonad.hs @@ -11,8 +11,9 @@ module GhciMonad where #include "HsVersions.h" import qualified GHC -import Outputable -import Panic hiding (showException) +import Outputable hiding (printForUser) +import qualified Outputable +import Panic hiding (showException) import Util import DynFlags import HscTypes @@ -42,10 +43,11 @@ data GHCiState = GHCiState args :: [String], prompt :: String, editor :: String, + stop :: String, 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, @@ -67,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 @@ -179,29 +189,29 @@ 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 st <- getGHCiState setGHCiState st { resume = [] } -showForUser :: SDoc -> GHCi String -showForUser doc = do +printForUser :: SDoc -> GHCi () +printForUser doc = do session <- getSession unqual <- io (GHC.getPrintUnqual session) - return $! showSDocForUser unqual doc + io $ Outputable.printForUser stdout unqual doc -- -------------------------------------------------------------------------- -- timing & statistics