X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FGhciMonad.hs;h=8de9d386085657da1473606c523ea90c7f3bcb29;hb=c2fd45f3496040a6bc7ce8110ffe9e14bad6564f;hp=9e3137619cda0ed6f2ef7cd8d7b63ce04249bde9;hpb=3211a6a00826b85f732715e59c7c1a81b0586f14;p=ghc-hetmet.git

diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs
index 9e31376..8de9d38 100644
--- a/compiler/ghci/GhciMonad.hs
+++ b/compiler/ghci/GhciMonad.hs
@@ -6,12 +6,19 @@
 --
 -----------------------------------------------------------------------------
 
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module GhciMonad where
 
 #include "HsVersions.h"
 
 import qualified GHC
-import Outputable       hiding (printForUser)
+import Outputable       hiding (printForUser, printForUserPartWay)
 import qualified Outputable
 import Panic            hiding (showException)
 import Util
@@ -20,6 +27,7 @@ import HscTypes
 import SrcLoc
 import Module
 import ObjLink
+import StaticFlags
 
 import Data.Maybe
 import Numeric
@@ -38,6 +46,8 @@ import GHC.Exts
 -----------------------------------------------------------------------------
 -- GHCi monad
 
+type Command = (String, String -> GHCi Bool, Maybe String, String -> IO [String])
+
 data GHCiState = GHCiState
      { 
 	progname       :: String,
@@ -50,10 +60,17 @@ 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.
+        -- ":" at the GHCi prompt repeats the last command, so we
+        -- remember is here:
+        last_command   :: Maybe Command,
+        cmdqueue       :: [String],
+        remembered_ctx :: Maybe ([Module],[Module])
+                -- modules we want to add to the context, but can't
+                -- because they currently have errors.  Set by :reload.
      }
 
 type TickArray = Array Int [(BreakIndex,SrcSpan)]
@@ -69,15 +86,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 +127,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)
@@ -151,6 +178,12 @@ printForUser doc = do
   unqual <- io (GHC.getPrintUnqual session)
   io $ Outputable.printForUser stdout unqual doc
 
+printForUserPartWay :: SDoc -> GHCi ()
+printForUserPartWay doc = do
+  session <- getSession
+  unqual <- io (GHC.getPrintUnqual session)
+  io $ Outputable.printForUserPartWay stdout opt_PprUserLength unqual doc
+
 -- --------------------------------------------------------------------------
 -- timing & statistics