improvements to :history

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

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 4d7658e..a1d803c 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -21,7 +21,7 @@ import Debugger
 import qualified GHC
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
                           Type, Module, ModuleName, TyThing(..), Phase,
 import qualified GHC
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
                           Type, Module, ModuleName, TyThing(..), Phase,

-                          BreakIndex, Name, SrcSpan )
+                          BreakIndex, Name, SrcSpan, Resume, SingleStep )

 import DynFlags
 import Packages
 import PackageConfig
 import DynFlags
 import Packages
 import PackageConfig

@@ -34,11 +34,11 @@ import Module           -- for ModuleEnv
 import Digraph
 import BasicTypes hiding (isTopLevel)
 import Panic      hiding (showException)
 import Digraph
 import BasicTypes hiding (isTopLevel)
 import Panic      hiding (showException)

-import FastString       ( unpackFS )

 import Config
 import StaticFlags
 import Linker
 import Util
 import Config
 import StaticFlags
 import Linker
 import Util

+import FastString

 
 #ifndef mingw32_HOST_OS
 import System.Posix
 
 #ifndef mingw32_HOST_OS
 import System.Posix

@@ -74,6 +74,7 @@ import Data.Char
 import Data.Dynamic
 import Data.Array
 import Control.Monad as Monad
 import Data.Dynamic
 import Data.Array
 import Control.Monad as Monad

+import Text.Printf

 
 import Foreign.StablePtr       ( newStablePtr )
 import GHC.Exts                ( unsafeCoerce# )
 
 import Foreign.StablePtr       ( newStablePtr )
 import GHC.Exts                ( unsafeCoerce# )

@@ -88,9 +89,9 @@ import System.Posix.Internals ( setNonBlockingFD )
 ghciWelcomeMsg =
  "   ___         ___ _\n"++
  "  / _ \\ /\\  /\\/ __(_)\n"++
 ghciWelcomeMsg =
  "   ___         ___ _\n"++
  "  / _ \\ /\\  /\\/ __(_)\n"++

- " / /_\\// /_/ / /  | |      GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
- "/ /_\\\\/ __  / /___| |      http://www.haskell.org/ghc/\n"++
- "\\____/\\/ /_/\\____/|_|      Type :? for help.\n"
+ " / /_\\// /_/ / /  | |    GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
+ "/ /_\\\\/ __  / /___| |    http://www.haskell.org/ghc/\n"++
+ "\\____/\\/ /_/\\____/|_|    Type :? for help.\n"

 
 type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
 cmdName (n,_,_,_) = n
 
 type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
 cmdName (n,_,_,_) = n

@@ -104,6 +105,7 @@ builtin_commands = [
   ("add",      keepGoingPaths addModule,       False, completeFilename),
   ("abandon",   keepGoing abandonCmd,           False, completeNone),
   ("break",     keepGoing breakCmd,             False, completeIdentifier),
   ("add",      keepGoingPaths addModule,       False, completeFilename),
   ("abandon",   keepGoing abandonCmd,           False, completeNone),
   ("break",     keepGoing breakCmd,             False, completeIdentifier),

+  ("back",      keepGoing backCmd,              False, completeNone),

   ("browse",    keepGoing browseCmd,           False, completeModule),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("check",    keepGoing checkModule,          False, completeHomeModule),
   ("browse",    keepGoing browseCmd,           False, completeModule),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("check",    keepGoing checkModule,          False, completeHomeModule),

@@ -115,7 +117,9 @@ builtin_commands = [
   ("edit",     keepGoing editFile,             False, completeFilename),
   ("etags",    keepGoing createETagsFileCmd,   False, completeFilename),
   ("force",     keepGoing forceCmd,             False, completeIdentifier),
   ("edit",     keepGoing editFile,             False, completeFilename),
   ("etags",    keepGoing createETagsFileCmd,   False, completeFilename),
   ("force",     keepGoing forceCmd,             False, completeIdentifier),

+  ("forward",   keepGoing forwardCmd,           False, completeNone),

   ("help",     keepGoing help,                 False, completeNone),
   ("help",     keepGoing help,                 False, completeNone),

+  ("history",   keepGoing historyCmd,           False, completeNone), 

   ("info",      keepGoing info,                        False, completeIdentifier),
   ("kind",     keepGoing kindOfType,           False, completeIdentifier),
   ("load",     keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),
   ("info",      keepGoing info,                        False, completeIdentifier),
   ("kind",     keepGoing kindOfType,           False, completeIdentifier),
   ("load",     keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),

@@ -130,6 +134,7 @@ builtin_commands = [
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      stepCmd,                        False, completeIdentifier), 
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      stepCmd,                        False, completeIdentifier), 
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),

+  ("trace",     traceCmd,                       False, completeIdentifier), 

   ("undef",     keepGoing undefineMacro,       False, completeMacro),
   ("unset",    keepGoing unsetOptions,         True,  completeSetOptions)
   ]
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
   ("unset",    keepGoing unsetOptions,         True,  completeSetOptions)
   ]

@@ -268,8 +273,8 @@ interactiveUI session srcs maybe_expr = do
                   session = session,
                   options = [],
                    prelude = prel_mod,
                   session = session,
                   options = [],
                    prelude = prel_mod,

-                   resume = [],
-                   breaks = emptyActiveBreakPoints,
+                   break_ctr = 0,
+                   breaks = [],

                    tickarrays = emptyModuleEnv
                  }
 
                    tickarrays = emptyModuleEnv
                  }
 

@@ -413,10 +418,9 @@ checkPerms name =
 
 fileLoop :: Handle -> Bool -> GHCi ()
 fileLoop hdl show_prompt = do
 
 fileLoop :: Handle -> Bool -> GHCi ()
 fileLoop hdl show_prompt = do

-   session <- getSession
-   (mod,imports) <- io (GHC.getContext session)
-   st <- getGHCiState
-   when show_prompt (io (putStr (mkPrompt mod imports (resume st) (prompt st))))
+   when show_prompt $ do
+        prompt <- mkPrompt
+        (io (putStr prompt))

    l <- io (IO.try (hGetLine hdl))
    case l of
        Left e | isEOFError e              -> return ()
    l <- io (IO.try (hGetLine hdl))
    case l of
        Left e | isEOFError e              -> return ()

@@ -441,25 +445,40 @@ stringLoop (s:ss) = do
        l  -> do quit <- runCommand l
                  if quit then return True else stringLoop ss
 
        l  -> do quit <- runCommand l
                  if quit then return True else stringLoop ss
 

-mkPrompt toplevs exports resumes prompt
-  = showSDoc $ f prompt
-    where
-        f ('%':'s':xs) = perc_s <> f xs
-        f ('%':'%':xs) = char '%' <> f xs
-        f (x:xs) = char x <> f xs
-        f [] = empty
-    
-        perc_s
-          | (span,_,_):rest <- resumes 
-          = (if not (null rest) then text "... " else empty)
-            <> brackets (ppr span) <+> modules_prompt
-          | otherwise
-          = modules_prompt
-
-        modules_prompt = 
+mkPrompt = do
+  session <- getSession
+  (toplevs,exports) <- io (GHC.getContext session)
+  resumes <- io $ GHC.getResumeContext session
+
+  context_bit <-
+        case resumes of
+            [] -> return empty
+            r:rs -> do
+                let ix = GHC.resumeHistoryIx r
+                if ix == 0
+                   then return (brackets (ppr (GHC.resumeSpan r)) <> space)
+                   else do
+                        let hist = GHC.resumeHistory r !! (ix-1)
+                        span <- io $ GHC.getHistorySpan session hist
+                        return (brackets (ppr (negate ix) <> char ':' 
+                                          <+> ppr span) <> space)
+  let
+        dots | r:rs <- resumes, not (null rs) = text "... "
+             | otherwise = empty
+
+        modules_bit = 

              hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
              hsep (map (ppr . GHC.moduleName) exports)
 
              hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
              hsep (map (ppr . GHC.moduleName) exports)
 

+        deflt_prompt = dots <> context_bit <> modules_bit
+
+        f ('%':'s':xs) = deflt_prompt <> f xs
+        f ('%':'%':xs) = char '%' <> f xs
+        f (x:xs) = char x <> f xs
+        f [] = empty
+   --
+  st <- getGHCiState
+  return (showSDoc (f (prompt st)))

 
 
 #ifdef USE_READLINE
 
 
 #ifdef USE_READLINE

@@ -470,8 +489,9 @@ readlineLoop = do
    io yield
    saveSession -- for use by completion
    st <- getGHCiState
    io yield
    saveSession -- for use by completion
    st <- getGHCiState

-   l <- io (readline (mkPrompt mod imports (resume st) (prompt st))
-               `finally` setNonBlockingFD 0)
+   mb_span <- getCurrentBreakSpan
+   prompt <- mkPrompt
+   l <- io (readline prompt `finally` setNonBlockingFD 0)

                -- readline sometimes puts stdin into blocking mode,
                -- so we need to put it back for the IO library
    splatSavedSession
                -- readline sometimes puts stdin into blocking mode,
                -- so we need to put it back for the IO library
    splatSavedSession

@@ -491,7 +511,7 @@ runCommand c = ghciHandle handler (doCommand c)
   where 
     doCommand (':' : command) = specialCommand command
     doCommand stmt
   where 
     doCommand (':' : command) = specialCommand command
     doCommand stmt

-       = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
+       = do timeIt $ runStmt stmt GHC.RunToCompletion

             return False
 
 -- This version is for the GHC command-line option -e.  The only difference
             return False
 
 -- This version is for the GHC command-line option -e.  The only difference

@@ -505,28 +525,49 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
 
     doCommand (':' : command) = specialCommand command
     doCommand stmt
 
     doCommand (':' : command) = specialCommand command
     doCommand stmt

-       = do nms <- runStmt stmt
-           case nms of 
-               Nothing -> io (exitWith (ExitFailure 1))
+       = do r <- runStmt stmt GHC.RunToCompletion
+           case r of 
+               False -> io (exitWith (ExitFailure 1))

                  -- failure to run the command causes exit(1) for ghc -e.
                  -- failure to run the command causes exit(1) for ghc -e.

-               _       -> do finishEvalExpr nms
-                              return True
+               _       -> return True

 
 

-runStmt :: String -> GHCi (Maybe (Bool,[Name]))
-runStmt stmt
- | null (filter (not.isSpace) stmt) = return (Just (False,[]))
+runStmt :: String -> SingleStep -> GHCi Bool
+runStmt stmt step
+ | null (filter (not.isSpace) stmt) = return False

  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $

-                    GHC.runStmt session stmt
-      switchOnRunResult result
+                    GHC.runStmt session stmt step
+      afterRunStmt result
+      return (isRunResultOk result)
+
+
+afterRunStmt :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
+afterRunStmt run_result = do
+  mb_result <- switchOnRunResult run_result
+  -- possibly print the type and revert CAFs after evaluating an expression
+  show_types <- isOptionSet ShowType
+  session <- getSession
+  case mb_result of
+    Nothing    -> return ()      
+    Just (is_break,names) -> 
+            when (is_break || show_types) $
+                  mapM_ (showTypeOfName session) names
+  
+  flushInterpBuffers
+  io installSignalHandlers
+  b <- isOptionSet RevertCAFs
+  io (when b revertCAFs)
+
+  return mb_result
+

 
 switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
 switchOnRunResult GHC.RunFailed = return Nothing
 switchOnRunResult (GHC.RunException e) = throw e
 switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
 
 switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
 switchOnRunResult GHC.RunFailed = return Nothing
 switchOnRunResult (GHC.RunException e) = throw e
 switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)

-switchOnRunResult (GHC.RunBreak threadId names info resume) = do
+switchOnRunResult (GHC.RunBreak threadId names info) = do

    session <- getSession
    Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info) 
    let modBreaks  = GHC.modInfoModBreaks mod_info
    session <- getSession
    Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info) 
    let modBreaks  = GHC.modInfoModBreaks mod_info

@@ -536,28 +577,17 @@ switchOnRunResult (GHC.RunBreak threadId names info resume) = do
    let location = ticks ! GHC.breakInfo_number info
    printForUser $ ptext SLIT("Stopped at") <+> ppr location
 
    let location = ticks ! GHC.breakInfo_number info
    printForUser $ ptext SLIT("Stopped at") <+> ppr location
 

-   pushResume location threadId resume
-

    -- run the command set with ":set stop <cmd>"
    st <- getGHCiState
    runCommand (stop st)
 
    return (Just (True,names))
 
    -- run the command set with ":set stop <cmd>"
    st <- getGHCiState
    runCommand (stop st)
 
    return (Just (True,names))
 

--- possibly print the type and revert CAFs after evaluating an expression
-finishEvalExpr mb_names
- = do show_types <- isOptionSet ShowType
-      session <- getSession
-      case mb_names of
-       Nothing    -> return ()      
-       Just (is_break,names) -> 
-                when (is_break || show_types) $
-                      mapM_ (showTypeOfName session) names

 
 

-      flushInterpBuffers
-      io installSignalHandlers
-      b <- isOptionSet RevertCAFs
-      io (when b revertCAFs)
+isRunResultOk :: GHC.RunResult -> Bool
+isRunResultOk (GHC.RunOk _) = True
+isRunResultOk _             = False
+

 
 showTypeOfName :: Session -> Name -> GHCi ()
 showTypeOfName session n
 
 showTypeOfName :: Session -> Name -> GHCi ()
 showTypeOfName session n

@@ -586,9 +616,29 @@ lookupCommand str = do
                [] -> return Nothing
                c:_ -> return (Just c)
 
                [] -> return Nothing
                c:_ -> return (Just c)
 

+
+getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
+getCurrentBreakSpan = do
+  session <- getSession
+  resumes <- io $ GHC.getResumeContext session
+  case resumes of
+    [] -> return Nothing
+    (r:rs) -> do
+        let ix = GHC.resumeHistoryIx r
+        if ix == 0
+           then return (Just (GHC.resumeSpan r))
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                span <- io $ GHC.getHistorySpan session hist
+                return (Just span)
+

 -----------------------------------------------------------------------------
 -- Commands
 
 -----------------------------------------------------------------------------
 -- Commands
 

+noArgs :: GHCi () -> String -> GHCi ()
+noArgs m "" = m
+noArgs m _ = io $ putStrLn "This command takes no arguments"
+

 help :: String -> GHCi ()
 help _ = io (putStr helpText)
 
 help :: String -> GHCi ()
 help _ = io (putStr helpText)
 

@@ -783,7 +833,6 @@ reloadModule m = do
 
 afterLoad ok session = do
   io (revertCAFs)  -- always revert CAFs on load.
 
 afterLoad ok session = do
   io (revertCAFs)  -- always revert CAFs on load.

-  discardResumeContext

   discardTickArrays
   discardActiveBreakPoints
   graph <- io (GHC.getModuleGraph session)
   discardTickArrays
   discardActiveBreakPoints
   graph <- io (GHC.getModuleGraph session)

@@ -874,8 +923,8 @@ browseCmd m =
 
 browseModule m exports_only = do
   s <- getSession
 
 browseModule m exports_only = do
   s <- getSession

-  modl <- if exports_only then lookupModule s m
-                          else wantInterpretedModule s m
+  modl <- if exports_only then lookupModule m
+                          else wantInterpretedModule m

 
   -- Temporarily set the context to the module we're interested in,
   -- just so we can get an appropriate PrintUnqualified
 
   -- Temporarily set the context to the module we're interested in,
   -- just so we can get an appropriate PrintUnqualified

@@ -1143,15 +1192,19 @@ cleanType ty = do
 
 showBkptTable :: GHCi ()
 showBkptTable = do
 
 showBkptTable :: GHCi ()
 showBkptTable = do

-   activeBreaks <- getActiveBreakPoints 
-   printForUser $ ppr activeBreaks 
+  st <- getGHCiState
+  printForUser $ prettyLocations (breaks st)

 
 showContext :: GHCi ()
 showContext = do
 
 showContext :: GHCi ()
 showContext = do

-   st <- getGHCiState
-   printForUser $ vcat (map pp_resume (resume st))
+   session <- getSession
+   resumes <- io $ GHC.getResumeContext session
+   printForUser $ vcat (map pp_resume (reverse resumes))

   where
   where

-   pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span
+   pp_resume resume =
+        ptext SLIT("--> ") <> text (GHC.resumeStmt resume)
+        $$ nest 2 (ptext SLIT("Stopped at") <+> ppr (GHC.resumeSpan resume))
+

 
 -- -----------------------------------------------------------------------------
 -- Completion
 
 -- -----------------------------------------------------------------------------
 -- Completion

@@ -1329,6 +1382,28 @@ expandPath path =
    other -> 
        return other
 
    other -> 
        return other
 

+wantInterpretedModule :: String -> GHCi Module
+wantInterpretedModule str = do
+   session <- getSession
+   modl <- lookupModule str
+   is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+   when (not is_interpreted) $
+       throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
+   return modl
+
+wantNameFromInterpretedModule noCanDo str and_then = do
+   session <- getSession
+   names <- io $ GHC.parseName session str
+   case names of
+      []    -> return ()
+      (n:_) -> do
+            let modl = GHC.nameModule n
+            is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+            if not is_interpreted
+               then noCanDo n $ text "module " <> ppr modl <>
+                                text " is not interpreted"
+               else and_then n
+

 -- ----------------------------------------------------------------------------
 -- Windows console setup
 
 -- ----------------------------------------------------------------------------
 -- Windows console setup
 

@@ -1364,44 +1439,33 @@ pprintCommand bind force str = do
   session <- getSession
   io $ pprintClosureCommand session bind force str
 
   session <- getSession
   io $ pprintClosureCommand session bind force str
 

-foreign import ccall "rts_setStepFlag" setStepFlag :: IO () 
-

 stepCmd :: String -> GHCi Bool
 stepCmd :: String -> GHCi Bool

-stepCmd [] = doContinue setStepFlag 
-stepCmd expression = do
-   io $ setStepFlag
-   runCommand expression
+stepCmd []         = doContinue GHC.SingleStep
+stepCmd expression = runStmt expression GHC.SingleStep
+
+traceCmd :: String -> GHCi Bool
+traceCmd []         = doContinue GHC.RunAndLogSteps
+traceCmd expression = runStmt expression GHC.RunAndLogSteps

 
 continueCmd :: String -> GHCi Bool
 
 continueCmd :: String -> GHCi Bool

-continueCmd [] = doContinue $ return () 
+continueCmd [] = doContinue GHC.RunToCompletion

 continueCmd other = do
    io $ putStrLn "The continue command accepts no arguments."
    return False
 
 continueCmd other = do
    io $ putStrLn "The continue command accepts no arguments."
    return False
 

-doContinue :: IO () -> GHCi Bool
-doContinue actionBeforeCont = do 
-   resumeAction <- popResume
-   case resumeAction of
-      Nothing -> do 
-         io $ putStrLn "There is no computation running."
-         return False
-      Just (_,_,handle) -> do
-         io $ actionBeforeCont
-         session <- getSession
-         runResult <- io $ GHC.resume session handle
-         names <- switchOnRunResult runResult
-         finishEvalExpr names
-         return False
+doContinue :: SingleStep -> GHCi Bool
+doContinue step = do 
+  session <- getSession
+  runResult <- io $ GHC.resume session step
+  afterRunStmt runResult
+  return False

 
 abandonCmd :: String -> GHCi ()
 
 abandonCmd :: String -> GHCi ()

-abandonCmd "" = do
-   mb_res <- popResume
-   case mb_res of
-      Nothing -> do 
-         io $ putStrLn "There is no computation running."
-      Just (span,_,_) ->
-         return ()
-         -- the prompt will change to indicate the new context
+abandonCmd = noArgs $ do
+  s <- getSession
+  b <- io $ GHC.abandon s -- the prompt will change to indicate the new context
+  when (not b) $ io $ putStrLn "There is no computation running."
+  return ()

 
 deleteCmd :: String -> GHCi ()
 deleteCmd argLine = do
 
 deleteCmd :: String -> GHCi ()
 deleteCmd argLine = do

@@ -1420,6 +1484,49 @@ deleteCmd argLine = do
          | all isDigit str = deleteBreak (read str)
          | otherwise = return ()
 
          | all isDigit str = deleteBreak (read str)
          | otherwise = return ()
 

+historyCmd :: String -> GHCi ()
+historyCmd arg
+  | null arg        = history 20
+  | all isDigit arg = history (read arg)
+  | otherwise       = io $ putStrLn "Syntax:  :history [num]"
+  where
+  history num = do
+    s <- getSession
+    resumes <- io $ GHC.getResumeContext s
+    case resumes of
+      [] -> io $ putStrLn "Not stopped at a breakpoint"
+      (r:rs) -> do
+        let hist = GHC.resumeHistory r
+            (took,rest) = splitAt num hist
+        spans <- mapM (io . GHC.getHistorySpan s) took
+        let nums = map (printf "-%-3d:") [(1::Int)..]
+        printForUser (vcat (zipWith (<+>) (map text nums) (map ppr spans)))
+        io $ putStrLn $ if null rest then "<end of history>" else "..."
+
+backCmd :: String -> GHCi ()
+backCmd = noArgs $ do
+  s <- getSession
+  (names, ix, span) <- io $ GHC.back s
+  printForUser $ ptext SLIT("Logged breakpoint at") <+> ppr span
+  mapM_ (showTypeOfName s) names
+   -- run the command set with ":set stop <cmd>"
+  st <- getGHCiState
+  runCommand (stop st)
+  return ()
+
+forwardCmd :: String -> GHCi ()
+forwardCmd = noArgs $ do
+  s <- getSession
+  (names, ix, span) <- io $ GHC.forward s
+  printForUser $ (if (ix == 0)
+                    then ptext SLIT("Stopped at")
+                    else ptext SLIT("Logged breakpoint at")) <+> ppr span
+  mapM_ (showTypeOfName s) names
+   -- run the command set with ":set stop <cmd>"
+  st <- getGHCiState
+  runCommand (stop st)
+  return ()
+

 -- handle the "break" command
 breakCmd :: String -> GHCi ()
 breakCmd argLine = do
 -- handle the "break" command
 breakCmd :: String -> GHCi ()
 breakCmd argLine = do

@@ -1431,7 +1538,7 @@ breakSwitch _session [] = do
    io $ putStrLn "The break command requires at least one argument."
 breakSwitch session args@(arg1:rest) 
    | looksLikeModuleName arg1 = do
    io $ putStrLn "The break command requires at least one argument."
 breakSwitch session args@(arg1:rest) 
    | looksLikeModuleName arg1 = do

-        mod <- wantInterpretedModule session arg1
+        mod <- wantInterpretedModule arg1

         breakByModule session mod rest
    | all isDigit arg1 = do
         (toplevel, _) <- io $ GHC.getContext session 
         breakByModule session mod rest
    | all isDigit arg1 = do
         (toplevel, _) <- io $ GHC.getContext session 

@@ -1440,37 +1547,19 @@ breakSwitch session args@(arg1:rest)
            [] -> do 
               io $ putStrLn "Cannot find default module for breakpoint." 
               io $ putStrLn "Perhaps no modules are loaded for debugging?"
            [] -> do 
               io $ putStrLn "Cannot find default module for breakpoint." 
               io $ putStrLn "Perhaps no modules are loaded for debugging?"

-   | otherwise = do -- assume it's a name
-        names <- io $ GHC.parseName session arg1
-        case names of
-          []    -> return ()
-          (n:_) -> do
-            let loc  = GHC.nameSrcLoc n
-                modl = GHC.nameModule n
-            is_interpreted <- io (GHC.moduleIsInterpreted session modl)
-            if not is_interpreted
-               then noCanDo $ text "module " <> ppr modl <>
-                              text " is not interpreted"
-               else do
-            if GHC.isGoodSrcLoc loc
-               then findBreakAndSet (GHC.nameModule n) $ 
-                         findBreakByCoord (GHC.srcLocLine loc, 
+   | otherwise = do -- try parsing it as an identifier
+        wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
+        let loc = GHC.nameSrcLoc name
+        if GHC.isGoodSrcLoc loc
+               then findBreakAndSet (GHC.nameModule name) $ 
+                         findBreakByCoord (Just (GHC.srcLocFile loc))
+                                          (GHC.srcLocLine loc, 

                                            GHC.srcLocCol loc)
                                            GHC.srcLocCol loc)

-               else noCanDo $ text "can't find its location: " <>
-                              ppr loc
-           where
-             noCanDo why = printForUser $
+               else noCanDo name $ text "can't find its location: " <> ppr loc
+       where
+          noCanDo n why = printForUser $

                 text "cannot set breakpoint on " <> ppr n <> text ": " <> why
 
                 text "cannot set breakpoint on " <> ppr n <> text ": " <> why
 

-
-wantInterpretedModule :: Session -> String -> GHCi Module
-wantInterpretedModule session str = do
-   modl <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
-   is_interpreted <- io (GHC.moduleIsInterpreted session modl)
-   when (not is_interpreted) $
-       throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
-   return modl
-

 breakByModule :: Session -> Module -> [String] -> GHCi () 
 breakByModule session mod args@(arg1:rest)
    | all isDigit arg1 = do  -- looks like a line number
 breakByModule :: Session -> Module -> [String] -> GHCi () 
 breakByModule session mod args@(arg1:rest)
    | all isDigit arg1 = do  -- looks like a line number

@@ -1481,7 +1570,7 @@ breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
 breakByModuleLine mod line args
    | [] <- args = findBreakAndSet mod $ findBreakByLine line
    | [col] <- args, all isDigit col =
 breakByModuleLine mod line args
    | [] <- args = findBreakAndSet mod $ findBreakByLine line
    | [col] <- args, all isDigit col =

-        findBreakAndSet mod $ findBreakByCoord (line, read col)
+        findBreakAndSet mod $ findBreakByCoord Nothing (line, read col)

    | otherwise = io $ putStrLn "Invalid arguments to :break"
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
    | otherwise = io $ putStrLn "Invalid arguments to :break"
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()

@@ -1532,8 +1621,9 @@ findBreakByLine line arr
         (complete,incomplete) = partition ends_here starts_here
             where ends_here (nm,span) = GHC.srcSpanEndLine span == line
 
         (complete,incomplete) = partition ends_here starts_here
             where ends_here (nm,span) = GHC.srcSpanEndLine span == line
 

-findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan)
-findBreakByCoord (line, col) arr
+findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
+                 -> Maybe (BreakIndex,SrcSpan)
+findBreakByCoord mb_file (line, col) arr

   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
     listToMaybe (sortBy rightmost contains)
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
     listToMaybe (sortBy rightmost contains)

@@ -1541,7 +1631,13 @@ findBreakByCoord (line, col) arr
         ticks = arr ! line
 
         -- the ticks that span this coordinate
         ticks = arr ! line
 
         -- the ticks that span this coordinate

-        contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col) ]
+        contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col),
+                            is_correct_file span ]
+
+        is_correct_file span
+                 | Just f <- mb_file = GHC.srcSpanFile span == f
+                 | otherwise         = True
+

 
 leftmost_smallest  (_,a) (_,b) = a `compare` b
 leftmost_largest   (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)
 
 leftmost_smallest  (_,a) (_,b) = a `compare` b
 leftmost_largest   (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)

@@ -1557,11 +1653,54 @@ start_bold = BS.pack "\ESC[1m"
 end_bold   = BS.pack "\ESC[0m"
 
 listCmd :: String -> GHCi ()
 end_bold   = BS.pack "\ESC[0m"
 
 listCmd :: String -> GHCi ()

-listCmd str = do
-   st <- getGHCiState
-   case resume st of
-      []  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
-      (span,_,_):_ -> io $ listAround span True
+listCmd "" = do
+   mb_span <- getCurrentBreakSpan
+   case mb_span of
+      Nothing  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
+      Just span -> io $ listAround span True
+listCmd str = list2 (words str)
+
+list2 [arg] | all isDigit arg = do
+    session <- getSession
+    (toplevel, _) <- io $ GHC.getContext session 
+    case toplevel of
+        [] -> io $ putStrLn "No module to list"
+        (mod : _) -> listModuleLine mod (read arg)
+list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
+        mod <- wantInterpretedModule arg1
+        listModuleLine mod (read arg2)
+list2 [arg] = do
+        wantNameFromInterpretedModule noCanDo arg $ \name -> do
+        let loc = GHC.nameSrcLoc name
+        if GHC.isGoodSrcLoc loc
+               then do
+                  tickArray <- getTickArray (GHC.nameModule name)
+                  let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
+                                        (GHC.srcLocLine loc, GHC.srcLocCol loc)
+                                        tickArray
+                  case mb_span of
+                    Nothing       -> io $ listAround (GHC.srcLocSpan loc) False
+                    Just (_,span) -> io $ listAround span False
+               else
+                  noCanDo name $ text "can't find its location: " <>
+                                 ppr loc
+    where
+        noCanDo n why = printForUser $
+            text "cannot list source code for " <> ppr n <> text ": " <> why
+list2  _other = 
+        io $ putStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
+
+listModuleLine :: Module -> Int -> GHCi ()
+listModuleLine modl line = do
+   session <- getSession
+   graph <- io (GHC.getModuleGraph session)
+   let this = filter ((== modl) . GHC.ms_mod) graph
+   case this of
+     [] -> panic "listModuleLine"
+     summ:_ -> do
+           let filename = fromJust (ml_hs_file (GHC.ms_location summ))
+               loc = GHC.mkSrcLoc (mkFastString (filename)) line 0
+           io $ listAround (GHC.srcLocSpan loc) False

 
 -- | list a section of a source file around a particular SrcSpan.
 -- If the highlight flag is True, also highlight the span using
 
 -- | list a section of a source file around a particular SrcSpan.
 -- If the highlight flag is True, also highlight the span using

@@ -1637,6 +1776,34 @@ mkTickArray ticks
         srcSpanLines span = [ GHC.srcSpanStartLine span .. 
                               GHC.srcSpanEndLine span ]
 
         srcSpanLines span = [ GHC.srcSpanStartLine span .. 
                               GHC.srcSpanEndLine span ]
 

+lookupModule :: String -> GHCi Module
+lookupModule modName
+   = do session <- getSession 
+        io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
+
+-- don't reset the counter back to zero?
+discardActiveBreakPoints :: GHCi ()
+discardActiveBreakPoints = do
+   st <- getGHCiState
+   mapM (turnOffBreak.snd) (breaks st)
+   setGHCiState $ st { breaks = [] }
+
+deleteBreak :: Int -> GHCi ()
+deleteBreak identity = do
+   st <- getGHCiState
+   let oldLocations    = breaks st
+       (this,rest)     = partition (\loc -> fst loc == identity) oldLocations
+   if null this 
+      then printForUser (text "Breakpoint" <+> ppr identity <+>
+                         text "does not exist")
+      else do
+           mapM (turnOffBreak.snd) this
+           setGHCiState $ st { breaks = rest }
+
+turnOffBreak loc = do
+  (arr, _) <- getModBreak (breakModule loc)
+  io $ setBreakFlag False arr (breakTick loc)
+

 getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
 getModBreak mod = do
    session <- getSession
 getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
 getModBreak mod = do
    session <- getSession

@@ -1646,28 +1813,8 @@ getModBreak mod = do
    let ticks      = GHC.modBreaks_locs  modBreaks
    return (array, ticks)
 
    let ticks      = GHC.modBreaks_locs  modBreaks
    return (array, ticks)
 

-lookupModule :: Session -> String -> GHCi Module
-lookupModule session modName
-   = io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
-

 setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool 
 setBreakFlag toggle array index
    | toggle    = GHC.setBreakOn array index 
    | otherwise = GHC.setBreakOff array index
 
 setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool 
 setBreakFlag toggle array index
    | toggle    = GHC.setBreakOn array index 
    | otherwise = GHC.setBreakOff array index
 

-
-{- these should probably go to the GHC API at some point -}
-enableBreakPoint  :: Session -> Module -> Int -> IO ()
-enableBreakPoint session mod index = return ()
-
-disableBreakPoint :: Session -> Module -> Int -> IO ()
-disableBreakPoint session mod index = return ()
-
-activeBreakPoints :: Session -> IO [(Module,Int)]
-activeBreakPoints session = return []
-
-enableSingleStep  :: Session -> IO ()
-enableSingleStep session = return ()
-
-disableSingleStep :: Session -> IO ()
-disableSingleStep session = return ()