#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.Exception as Exception
+import Data.Array
import Data.Char
-import Data.Dynamic
import Data.Int ( Int64 )
import Data.IORef
import Data.List
args :: [String],
prompt :: String,
editor :: String,
+ stop :: String,
session :: GHC.Session,
options :: [GHCiOption],
prelude :: GHC.Module,
- topLevel :: Bool,
- resume :: [IO GHC.RunResult],
- breaks :: !ActiveBreakPoints
+ break_ctr :: !Int,
+ breaks :: ![(Int, BreakLocation)],
+ 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
| RevertCAFs -- revert CAFs after every evaluation
deriving Eq
-data ActiveBreakPoints
- = ActiveBreakPoints
- { breakCounter :: !Int
- , breakLocations :: ![(Int, BreakLocation)] -- break location uniquely numbered
- }
-
-instance Outputable ActiveBreakPoints where
- ppr activeBrks = prettyLocations $ breakLocations activeBrks
-
-emptyActiveBreakPoints :: ActiveBreakPoints
-emptyActiveBreakPoints
- = ActiveBreakPoints { breakCounter = 0, breakLocations = [] }
-
data BreakLocation
= BreakLocation
{ breakModule :: !GHC.Module
instance Outputable BreakLocation where
ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc)
-getActiveBreakPoints :: GHCi ActiveBreakPoints
-getActiveBreakPoints = liftM breaks getGHCiState
-
--- don't reset the counter back to zero?
-clearActiveBreakPoints :: GHCi ()
-clearActiveBreakPoints = do
- st <- getGHCiState
- let oldActiveBreaks = breaks st
- newActiveBreaks = oldActiveBreaks { breakLocations = [] }
- setGHCiState $ st { breaks = newActiveBreaks }
-
-deleteBreak :: Int -> GHCi ()
-deleteBreak identity = do
- st <- getGHCiState
- let oldActiveBreaks = breaks st
- oldLocations = breakLocations oldActiveBreaks
- newLocations = filter (\loc -> fst loc /= identity) oldLocations
- newActiveBreaks = oldActiveBreaks { breakLocations = newLocations }
- setGHCiState $ st { breaks = newActiveBreaks }
-
recordBreak :: BreakLocation -> GHCi (Bool{- was already present -}, Int)
recordBreak brkLoc = do
st <- getGHCiState
let oldActiveBreaks = breaks st
- let oldLocations = breakLocations oldActiveBreaks
-- don't store the same break point twice
- case [ nm | (nm, loc) <- oldLocations, loc == brkLoc ] of
+ case [ nm | (nm, loc) <- oldActiveBreaks, loc == brkLoc ] of
(nm:_) -> return (True, nm)
[] -> do
- let oldCounter = breakCounter oldActiveBreaks
+ let oldCounter = break_ctr st
newCounter = oldCounter + 1
- newActiveBreaks =
- oldActiveBreaks
- { breakCounter = newCounter
- , breakLocations = (oldCounter, brkLoc) : oldLocations
- }
- setGHCiState $ st { breaks = newActiveBreaks }
+ setGHCiState $ st { break_ctr = newCounter,
+ breaks = (oldCounter, brkLoc) : oldActiveBreaks
+ }
return (False, oldCounter)
newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a }
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