X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FGhciMonad.hs;h=82aade4d26fa5b659fdb0c5734f51c18912d471d;hb=022fc24719ba4b98b8d9f19bfe7f75dd0f19d585;hp=9e3137619cda0ed6f2ef7cd8d7b63ce04249bde9;hpb=3211a6a00826b85f732715e59c7c1a81b0586f14;p=ghc-hetmet.git diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs index 9e31376..82aade4 100644 --- a/compiler/ghci/GhciMonad.hs +++ b/compiler/ghci/GhciMonad.hs @@ -50,10 +50,11 @@ data GHCiState = GHCiState prelude :: GHC.Module, break_ctr :: !Int, breaks :: ![(Int, BreakLocation)], - tickarrays :: ModuleEnv TickArray + tickarrays :: ModuleEnv TickArray, -- tickarrays caches the TickArray for loaded modules, -- so that we don't rebuild it each time the user sets -- a breakpoint. + cmdqueue :: [String] } type TickArray = Array Int [(BreakIndex,SrcSpan)] @@ -69,15 +70,22 @@ data BreakLocation { breakModule :: !GHC.Module , breakLoc :: !SrcSpan , breakTick :: {-# UNPACK #-} !Int + , onBreakCmd :: String } - deriving Eq + +instance Eq BreakLocation where + loc1 == loc2 = breakModule loc1 == breakModule loc2 && + breakTick loc1 == breakTick loc2 prettyLocations :: [(Int, BreakLocation)] -> SDoc prettyLocations [] = text "No active breakpoints." prettyLocations locs = vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ reverse $ locs instance Outputable BreakLocation where - ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) + ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> + if null (onBreakCmd loc) + then empty + else doubleQuotes (text (onBreakCmd loc)) recordBreak :: BreakLocation -> GHCi (Bool{- was already present -}, Int) recordBreak brkLoc = do @@ -103,6 +111,9 @@ instance Monad GHCi where (GHCi m) >>= k = GHCi $ \s -> m s >>= \a -> unGHCi (k a) s return a = GHCi $ \s -> return a +instance Functor GHCi where + fmap f m = m >>= return . f + ghciHandleDyn :: Typeable t => (t -> GHCi a) -> GHCi a -> GHCi a ghciHandleDyn h (GHCi m) = GHCi $ \s -> Exception.catchDyn (m s) (\e -> unGHCi (h e) s)