improvements to :history

[ghc-hetmet.git] / compiler / ghci / GhciMonad.hs

diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs
index 3cab56b..d380463 100644 (file)
--- a/compiler/ghci/GhciMonad.hs
+++ b/compiler/ghci/GhciMonad.hs
@@ -11,17 +11,19 @@ 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.Exception as Exception
+import Data.Array
 import Data.Char
-import Data.Dynamic
 import Data.Int         ( Int64 )
 import Data.IORef
 import Data.List
@@ -40,33 +42,26 @@ 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
+        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
@@ -82,43 +77,19 @@ prettyLocations locs = vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $
 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 }
@@ -172,34 +143,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