X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FGhciMonad.hs;h=5086022d05cd43303d7271b2a0b78a97305515d9;hb=86bec4298d582ef1d8f0a201d6a81145e1be9498;hp=3cab56b40ce830990d606066c5cf6590d3a1ed89;hpb=cdce647711c0f46f5799b24de087622cb77e647f;p=ghc-hetmet.git diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs index 3cab56b..5086022 100644 --- a/compiler/ghci/GhciMonad.hs +++ b/compiler/ghci/GhciMonad.hs @@ -11,17 +11,20 @@ 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 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 @@ -40,14 +43,19 @@ data GHCiState = GHCiState args :: [String], prompt :: String, editor :: String, + stop :: String, session :: GHC.Session, options :: [GHCiOption], prelude :: GHC.Module, - topLevel :: Bool, - resume :: [IO GHC.RunResult], - breaks :: !ActiveBreakPoints + 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 +94,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,34 +180,11 @@ 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 = do - st <- getGHCiState - case (resume st) of - [] -> return () - (_:xs) -> setGHCiState $ st { resume = xs } - -pushResume :: IO GHC.RunResult -> GHCi () -pushResume resumeAction = do - st <- getGHCiState - let oldResume = resume st - setGHCiState $ st { resume = resumeAction : oldResume } - -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