X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=8066aa4c082c350d078462ed541592c8ff3fd99e;hb=c5f6a3c65987b467cb64be30abd7a10ea6280b67;hp=ddd6a139e37f5749f8a0a171a3eb83f63c3f542b;hpb=0855975c5e81b1ef9a7871a436af3f34c55dfd87;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index ddd6a13..8066aa4 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -14,12 +14,13 @@ module InteractiveUI (
 #include "HsVersions.h"
 
 import GhciMonad
+import GhciTags
 
 -- The GHC interface
 import qualified GHC
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
                           Type, Module, ModuleName, TyThing(..), Phase,
-                          BreakIndex )
+                          BreakIndex, Name, SrcSpan )
 import Debugger
 import DynFlags
 import Packages
@@ -29,15 +30,11 @@ import PprTyThing
 import Outputable       hiding (printForUser)
 import Module           -- for ModuleEnv
 
--- for createtags
-import Name
-import OccName
-import SrcLoc
-
 -- Other random utilities
 import Digraph
 import BasicTypes hiding (isTopLevel)
 import Panic      hiding (showException)
+import FastString       ( unpackFS )
 import Config
 import StaticFlags
 import Linker
@@ -64,6 +61,7 @@ import System.Console.Readline as Readline
 import Control.Exception as Exception
 -- import Control.Concurrent
 
+import qualified Data.ByteString.Char8 as BS
 import Data.List
 import Data.Maybe
 import System.Cmd
@@ -79,17 +77,12 @@ import Control.Monad as Monad
 
 import Foreign.StablePtr	( newStablePtr )
 import GHC.Exts		( unsafeCoerce# )
-import GHC.IOBase	( IOErrorType(InvalidArgument), IO(IO) )
+import GHC.IOBase	( IOErrorType(InvalidArgument) )
 
 import Data.IORef	( IORef, readIORef, writeIORef )
 
 import System.Posix.Internals ( setNonBlockingFD )
 
--- these are needed by the new ghci debugger
-import ByteCodeLink (HValue)
-import ByteCodeInstr (BreakInfo (..))
-import BreakArray
-
 -----------------------------------------------------------------------------
 
 ghciWelcomeMsg =
@@ -109,14 +102,14 @@ builtin_commands = [
 	-- Hugs users are accustomed to :e, so make sure it doesn't overlap
   ("?",		keepGoing help,			False, completeNone),
   ("add",	keepGoingPaths addModule,	False, completeFilename),
-  ("break",     breakCmd, False, completeNone),   
+  ("break",     keepGoing breakCmd,             False, completeIdentifier),
   ("browse",    keepGoing browseCmd,		False, completeModule),
   ("cd",    	keepGoing changeDirectory,	False, completeFilename),
   ("check",	keepGoing checkModule,		False, completeHomeModule),
-  ("continue",  continueCmd, False, completeNone),
+  ("continue",  continueCmd,                    False, completeNone),
   ("ctags",	keepGoing createCTagsFileCmd, 	False, completeFilename),
   ("def",	keepGoing defineMacro,		False, completeIdentifier),
-  ("delete",    deleteCmd, False, completeNone),   
+  ("delete",    keepGoing deleteCmd,            False, completeNone),
   ("e", 	keepGoing editFile,		False, completeFilename),
   ("edit",	keepGoing editFile,		False, completeFilename),
   ("etags",	keepGoing createETagsFileCmd,	False, completeFilename),
@@ -124,7 +117,8 @@ builtin_commands = [
   ("help",	keepGoing help,			False, completeNone),
   ("info",      keepGoing info,			False, completeIdentifier),
   ("kind",	keepGoing kindOfType,		False, completeIdentifier),
-  ("load",	keepGoingPaths loadModule_,False, completeHomeModuleOrFile),
+  ("load",	keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),
+  ("list",	keepGoing listCmd,              False, completeNone),
   ("module",	keepGoing setContext,		False, completeModule),
   ("main",	keepGoing runMain,		False, completeIdentifier),
   ("print",     keepGoing (pprintClosureCommand True False), False, completeIdentifier),
@@ -133,7 +127,7 @@ builtin_commands = [
   ("set",	keepGoing setCmd,		True,  completeSetOptions),
   ("show",	keepGoing showCmd,		False, completeNone),
   ("sprint",    keepGoing (pprintClosureCommand False False),False, completeIdentifier),
-  ("step",      stepCmd, False, completeNone), 
+  ("step",      stepCmd,                        False, completeIdentifier), 
   ("type",	keepGoing typeOfExpr,		False, completeIdentifier),
   ("undef",     keepGoing undefineMacro,	False, completeMacro),
   ("unset",	keepGoing unsetOptions,		True,  completeSetOptions)
@@ -147,24 +141,32 @@ keepGoingPaths a str = a (toArgs str) >> return False
 
 shortHelpText = "use :? for help.\n"
 
--- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
 helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
  "   <stmt>                      evaluate/run <stmt>\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
+ "   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" ++
+ "   :break <name>               set a breakpoint on the specified function\n" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
+ "   :continue                   resume after a breakpoint\n" ++
+ "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
+ "   :delete <number>            delete the specified breakpoint\n" ++
+ "   :delete *                   delete all breakpoints\n" ++
  "   :edit <file>                edit file\n" ++
  "   :edit                       edit last module\n" ++
+ "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
+-- "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
- "   :print [<name> ...]         prints a value without forcing its computation\n" ++
- "   :sprint [<name> ...]        simplified version of :print\n" ++
+ "   :kind <type>                show the kind of <type>\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
+ "   :print [<name> ...]         prints a value without forcing its computation\n" ++
+ "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "\n" ++
  "   :set <option> ...           set options\n" ++
@@ -172,17 +174,19 @@ helpText =
  "   :set prog <progname>        set the value returned by System.getProgName\n" ++
  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
  "   :set editor <cmd>           set the command used for :edit\n" ++
+ "   :set stop <cmd>             set the command to run when a breakpoint is hit\n" ++
  "\n" ++
+ "   :show breaks                show active breakpoints\n" ++
+ "   :show context               show the breakpoint context\n" ++
  "   :show modules               show the currently loaded modules\n" ++
  "   :show bindings              show the current bindings made at the prompt\n" ++
  "\n" ++
- "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
- "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
+ "   :sprint [<name> ...]        simplifed version of :print\n" ++
+ "   :step                       single-step after stopping at a breakpoint\n"++
+ "   :step <expr>                single-step into <expr>\n"++
  "   :type <expr>                show the type of <expr>\n" ++
- "   :kind <type>                show the kind of <type>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :unset <option> ...         unset options\n" ++
- "   :quit                       exit GHCi\n" ++
  "   :!<command>                 run the shell command <command>\n" ++
  "\n" ++
  " Options for ':set' and ':unset':\n" ++
@@ -257,6 +261,7 @@ interactiveUI session srcs maybe_expr = do
 	GHCiState{ progname = "<interactive>",
 		   args = [],
                    prompt = "%s> ",
+                   stop = "",
 		   editor = default_editor,
 		   session = session,
 		   options = [],
@@ -409,7 +414,7 @@ fileLoop hdl show_prompt = do
    session <- getSession
    (mod,imports) <- io (GHC.getContext session)
    st <- getGHCiState
-   when show_prompt (io (putStr (mkPrompt mod imports (prompt st))))
+   when show_prompt (io (putStr (mkPrompt mod imports (resume st) (prompt st))))
    l <- io (IO.try (hGetLine hdl))
    case l of
 	Left e | isEOFError e		   -> return ()
@@ -434,7 +439,7 @@ stringLoop (s:ss) = do
 	l  -> do quit <- runCommand l
                  if quit then return True else stringLoop ss
 
-mkPrompt toplevs exports prompt
+mkPrompt toplevs exports resumes prompt
   = showSDoc $ f prompt
     where
         f ('%':'s':xs) = perc_s <> f xs
@@ -442,8 +447,17 @@ mkPrompt toplevs exports prompt
         f (x:xs) = char x <> f xs
         f [] = empty
     
-        perc_s = hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
-                 hsep (map (ppr . GHC.moduleName) exports)
+        perc_s
+          | (span,_,_):rest <- resumes 
+          = (if not (null rest) then text "... " else empty)
+            <> brackets (ppr span) <+> modules_prompt
+          | otherwise
+          = modules_prompt
+
+        modules_prompt = 
+             hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
+             hsep (map (ppr . GHC.moduleName) exports)
+
 
 
 #ifdef USE_READLINE
@@ -454,7 +468,7 @@ readlineLoop = do
    io yield
    saveSession -- for use by completion
    st <- getGHCiState
-   l <- io (readline (mkPrompt mod imports (prompt st))
+   l <- io (readline (mkPrompt mod imports (resume st) (prompt st))
 	  	`finally` setNonBlockingFD 0)
 		-- readline sometimes puts stdin into blocking mode,
 		-- so we need to put it back for the IO library
@@ -493,7 +507,8 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
 	    case nms of 
 		Nothing -> io (exitWith (ExitFailure 1))
 		  -- failure to run the command causes exit(1) for ghc -e.
-		_       -> finishEvalExpr nms
+		_       -> do finishEvalExpr nms
+                              return True
 
 runStmt :: String -> GHCi (Maybe (Bool,[Name]))
 runStmt stmt
@@ -511,15 +526,20 @@ switchOnRunResult (GHC.RunException e) = throw e
 switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
 switchOnRunResult (GHC.RunBreak threadId names info resume) = do
    session <- getSession
-   Just mod_info <- io $ GHC.getModuleInfo session (breakInfo_module info) 
+   Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info) 
    let modBreaks  = GHC.modInfoModBreaks mod_info
    let ticks      = GHC.modBreaks_locs modBreaks
 
    -- display information about the breakpoint
-   let location = ticks ! breakInfo_number info
+   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))
 
 -- possibly print the type and revert CAFs after evaluating an expression
@@ -536,7 +556,6 @@ finishEvalExpr mb_names
       io installSignalHandlers
       b <- isOptionSet RevertCAFs
       io (when b revertCAFs)
-      return True
 
 showTypeOfName :: Session -> Name -> GHCi ()
 showTypeOfName session n
@@ -607,9 +626,6 @@ pprInfo exts (thing, fixity, insts)
 	| fix == GHC.defaultFixity = empty
 	| otherwise		   = ppr fix <+> ppr (GHC.getName thing)
 
------------------------------------------------------------------------------
--- Commands
-
 runMain :: String -> GHCi ()
 runMain args = do
   let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))
@@ -845,118 +861,6 @@ shellEscape :: String -> GHCi Bool
 shellEscape str = io (system str >> return False)
 
 -----------------------------------------------------------------------------
--- create tags file for currently loaded modules.
-
-createETagsFileCmd, createCTagsFileCmd :: String -> GHCi ()
-
-createCTagsFileCmd ""   = ghciCreateTagsFile CTags "tags"
-createCTagsFileCmd file = ghciCreateTagsFile CTags file
-
-createETagsFileCmd ""    = ghciCreateTagsFile ETags "TAGS"
-createETagsFileCmd file  = ghciCreateTagsFile ETags file
-
-data TagsKind = ETags | CTags
-
-ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
-ghciCreateTagsFile kind file = do
-  session <- getSession
-  io $ createTagsFile session kind file
-
--- ToDo: 
--- 	- remove restriction that all modules must be interpreted
---	  (problem: we don't know source locations for entities unless
---	  we compiled the module.
---
---	- extract createTagsFile so it can be used from the command-line
---	  (probably need to fix first problem before this is useful).
---
-createTagsFile :: Session -> TagsKind -> FilePath -> IO ()
-createTagsFile session tagskind tagFile = do
-  graph <- GHC.getModuleGraph session
-  let ms = map GHC.ms_mod graph
-      tagModule m = do 
-        is_interpreted <- GHC.moduleIsInterpreted session m
-        -- should we just skip these?
-        when (not is_interpreted) $
-          throwDyn (CmdLineError ("module '" 
-                                ++ GHC.moduleNameString (GHC.moduleName m)
-                                ++ "' is not interpreted"))
-        mbModInfo <- GHC.getModuleInfo session m
-        let unqual 
-	      | Just modinfo <- mbModInfo,
-		Just unqual <- GHC.modInfoPrintUnqualified modinfo = unqual
-	      | otherwise = GHC.alwaysQualify
-
-        case mbModInfo of 
-          Just modInfo -> return $! listTags unqual modInfo 
-          _            -> return []
-
-  mtags <- mapM tagModule ms
-  either_res <- collateAndWriteTags tagskind tagFile $ concat mtags
-  case either_res of
-    Left e  -> hPutStrLn stderr $ ioeGetErrorString e
-    Right _ -> return ()
-
-listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
-listTags unqual modInfo =
-	   [ tagInfo unqual name loc 
-           | name <- GHC.modInfoExports modInfo
-           , let loc = nameSrcLoc name
-           , isGoodSrcLoc loc
-           ]
-
-type TagInfo = (String -- tag name
-               ,String -- file name
-               ,Int    -- line number
-               ,Int    -- column number
-               )
-
--- get tag info, for later translation into Vim or Emacs style
-tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo
-tagInfo unqual name loc
-    = ( showSDocForUser unqual $ pprOccName (nameOccName name)
-      , showSDocForUser unqual $ ftext (srcLocFile loc)
-      , srcLocLine loc
-      , srcLocCol loc
-      )
-
-collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
-collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al
-  let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos
-  IO.try (writeFile file tags)
-collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
-  let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2
-      groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
-  tagGroups <- mapM tagFileGroup groups 
-  IO.try (writeFile file $ concat tagGroups)
-  where
-    tagFileGroup group@[] = throwDyn (CmdLineError "empty tag file group??")
-    tagFileGroup group@((_,fileName,_,_):_) = do
-      file <- readFile fileName -- need to get additional info from sources..
-      let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
-          sortedGroup = sortLe byLine group
-          tags = unlines $ perFile sortedGroup 1 0 $ lines file
-      return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
-    perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos (line:lines) | lNo>count =
-      perFile (tagInfo:tags) (count+1) (pos+length line) lines
-    perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count =
-      showETag tagInfo line pos : perFile tags count pos lines
-    perFile tags count pos lines = []
-
--- simple ctags format, for Vim et al
-showTag :: TagInfo -> String
-showTag (tag,file,lineNo,colNo)
-    =  tag ++ "\t" ++ file ++ "\t" ++ show lineNo
-
--- etags format, for Emacs/XEmacs
-showETag :: TagInfo -> String -> Int -> String
-showETag (tag,file,lineNo,colNo) line charPos
-    =  take colNo line ++ tag
-    ++ "\x7f" ++ tag
-    ++ "\x01" ++ show lineNo
-    ++ "," ++ show charPos
-
------------------------------------------------------------------------------
 -- Browsing a module's contents
 
 browseCmd :: String -> GHCi ()
@@ -1090,6 +994,7 @@ setCmd str
 	("prog":prog) -> setProg prog
         ("prompt":prompt) -> setPrompt (after 6)
         ("editor":cmd) -> setEditor (after 6)
+        ("stop":cmd) -> setStop (after 4)
 	wds -> setOptions wds
    where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str
 
@@ -1107,6 +1012,10 @@ setEditor cmd = do
   st <- getGHCiState
   setGHCiState st{ editor = cmd }
 
+setStop cmd = do
+  st <- getGHCiState
+  setGHCiState st{ stop = cmd }
+
 setPrompt value = do
   st <- getGHCiState
   if null value
@@ -1442,7 +1351,9 @@ setUpConsole = do
 #endif
 	return ()
 
+-- -----------------------------------------------------------------------------
 -- commands for debugger
+
 foreign import ccall "rts_setStepFlag" setStepFlag :: IO () 
 
 stepCmd :: String -> GHCi Bool
@@ -1470,12 +1381,11 @@ doContinue actionBeforeCont = do
          runResult <- io $ GHC.resume session handle
          names <- switchOnRunResult runResult
          finishEvalExpr names
-         return False 
+         return False
 
-deleteCmd :: String -> GHCi Bool
+deleteCmd :: String -> GHCi ()
 deleteCmd argLine = do
    deleteSwitch $ words argLine
-   return False
    where
    deleteSwitch :: [String] -> GHCi ()
    deleteSwitch [] = 
@@ -1491,33 +1401,47 @@ deleteCmd argLine = do
          | otherwise = return ()
 
 -- handle the "break" command
-breakCmd :: String -> GHCi Bool
+breakCmd :: String -> GHCi ()
 breakCmd argLine = do
    session <- getSession
    breakSwitch session $ words argLine
 
-breakSwitch :: Session -> [String] -> GHCi Bool
+breakSwitch :: Session -> [String] -> GHCi ()
 breakSwitch _session [] = do
    io $ putStrLn "The break command requires at least one argument."
-   return False
 breakSwitch session args@(arg1:rest) 
-   | looksLikeModule arg1 = do
+   | looksLikeModuleName arg1 = do
         mod <- wantInterpretedModule session arg1
-        breakByModule mod rest
-        return False
-   | otherwise = do
+        breakByModule session mod rest
+   | all isDigit arg1 = do
         (toplevel, _) <- io $ GHC.getContext session 
         case toplevel of
-           (mod : _) -> breakByModule mod args 
+           (mod : _) -> breakByModuleLine mod (read arg1) rest
            [] -> do 
               io $ putStrLn "Cannot find default module for breakpoint." 
               io $ putStrLn "Perhaps no modules are loaded for debugging?"
-        return False
-   where
-   -- Todo there may be a nicer way to test this
-   looksLikeModule :: String -> Bool
-   looksLikeModule []    = False
-   looksLikeModule (x:_) = isUpper x
+   | 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, 
+                                           GHC.srcLocCol loc)
+               else noCanDo $ text "can't find its location: " <>
+                              ppr loc
+           where
+             noCanDo why = printForUser $
+                text "cannot set breakpoint on " <> ppr n <> text ": " <> why
+
 
 wantInterpretedModule :: Session -> String -> GHCi Module
 wantInterpretedModule session str = do
@@ -1527,26 +1451,18 @@ wantInterpretedModule session str = do
        throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
    return modl
 
-breakByModule :: Module -> [String] -> GHCi () 
-breakByModule mod args@(arg1:rest)
+breakByModule :: Session -> Module -> [String] -> GHCi () 
+breakByModule session mod args@(arg1:rest)
    | all isDigit arg1 = do  -- looks like a line number
         breakByModuleLine mod (read arg1) rest
-   | looksLikeVar arg1 = do
-        -- break by a function definition
-        io $ putStrLn "Break by function definition not implemented."
-   | otherwise = io $ putStrLn "Invalid arguments to break command."
-   where
-   -- Todo there may be a nicer way to test this
-   looksLikeVar :: String -> Bool
-   looksLikeVar [] = False
-   looksLikeVar (x:_) = isLower x || x `elem` "~!@#$%^&*-+"
+   | otherwise = io $ putStrLn "Invalid arguments to :break"
 
 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
 breakByModuleLine mod line args
    | [] <- args = findBreakAndSet mod $ findBreakByLine line
    | [col] <- args, all isDigit col =
         findBreakAndSet mod $ findBreakByCoord (line, read col)
-   | otherwise = io $ putStrLn "Invalid arguments to break command."
+   | otherwise = io $ putStrLn "Invalid arguments to :break"
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet mod lookupTickTree = do 
@@ -1584,17 +1500,17 @@ findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
 findBreakByLine line arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
-    listToMaybe (sortBy leftmost complete)   `mplus`
-    listToMaybe (sortBy leftmost incomplete) `mplus`
+    listToMaybe (sortBy leftmost_largest  complete)   `mplus`
+    listToMaybe (sortBy leftmost_smallest incomplete) `mplus`
     listToMaybe (sortBy rightmost ticks)
   where 
         ticks = arr ! line
 
         starts_here = [ tick | tick@(nm,span) <- ticks,
-                               srcSpanStartLine span == line ]
+                               GHC.srcSpanStartLine span == line ]
 
         (complete,incomplete) = partition ends_here starts_here
-            where ends_here (nm,span) = srcSpanEndLine span == line
+            where ends_here (nm,span) = GHC.srcSpanEndLine span == line
 
 findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan)
 findBreakByCoord (line, col) arr
@@ -1607,13 +1523,69 @@ findBreakByCoord (line, col) arr
         -- the ticks that span this coordinate
         contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col) ]
 
-leftmost  (_,a) (_,b) = a `compare` b
+leftmost_smallest  (_,a) (_,b) = a `compare` b
+leftmost_largest   (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)
+                                `thenCmp`
+                                 (GHC.srcSpanEnd b `compare` GHC.srcSpanEnd a)
 rightmost (_,a) (_,b) = b `compare` a
 
 spans :: SrcSpan -> (Int,Int) -> Bool
-spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
-   where loc = mkSrcLoc (srcSpanFile span) l c
+spans span (l,c) = GHC.srcSpanStart span <= loc && loc <= GHC.srcSpanEnd span
+   where loc = GHC.mkSrcLoc (GHC.srcSpanFile span) l c
+
+start_bold = BS.pack "\ESC[1m"
+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
+
+-- | list a section of a source file around a particular SrcSpan.
+-- If the highlight flag is True, also highlight the span using
+-- start_bold/end_bold.
+listAround span do_highlight = do
+      contents <- BS.readFile (unpackFS file)
+      let 
+          lines = BS.split '\n' contents
+          these_lines = take (line2 - line1 + 1 + pad_before + pad_after) $ 
+                        drop (line1 - 1 - pad_before) $ lines
+          fst_line = max 1 (line1 - pad_before)
+          line_nos = [ fst_line .. ]
+
+          highlighted | do_highlight = zipWith highlight line_nos these_lines
+                      | otherwise   = these_lines
+
+          bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
+          prefixed = zipWith BS.append bs_line_nos highlighted
+      --
+      BS.putStrLn (BS.join (BS.pack "\n") prefixed)
+  where
+        file  = GHC.srcSpanFile span
+        line1 = GHC.srcSpanStartLine span
+        col1  = GHC.srcSpanStartCol span
+        line2 = GHC.srcSpanEndLine span
+        col2  = GHC.srcSpanEndCol span
+
+        pad_before | line1 == 1 = 0
+                   | otherwise  = 1
+        pad_after = 1
+
+        highlight no line
+          | no == line1 && no == line2
+          = let (a,r) = BS.splitAt col1 line
+                (b,c) = BS.splitAt (col2-col1) r
+            in
+            BS.concat [a,start_bold,b,end_bold,c]
+          | no == line1
+          = let (a,b) = BS.splitAt col1 line in
+            BS.concat [a, start_bold, b]
+          | no == line2
+          = let (a,b) = BS.splitAt col2 line in
+            BS.concat [a, end_bold, b]
+          | otherwise   = line
 
 -- --------------------------------------------------------------------------
 -- Tick arrays
@@ -1641,10 +1613,11 @@ mkTickArray ticks
         [ (line, (nm,span)) | (nm,span) <- ticks,
                               line <- srcSpanLines span ]
     where
-        max_line = maximum (map srcSpanEndLine (map snd ticks))
-        srcSpanLines span = [ srcSpanStartLine span .. srcSpanEndLine span ]
+        max_line = maximum (map GHC.srcSpanEndLine (map snd ticks))
+        srcSpanLines span = [ GHC.srcSpanStartLine span .. 
+                              GHC.srcSpanEndLine span ]
 
-getModBreak :: Module -> GHCi (BreakArray, Array Int SrcSpan)
+getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
 getModBreak mod = do
    session <- getSession
    Just mod_info <- io $ GHC.getModuleInfo session mod
@@ -1657,10 +1630,10 @@ lookupModule :: Session -> String -> GHCi Module
 lookupModule session modName
    = io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
 
-setBreakFlag :: Bool -> BreakArray -> Int -> IO Bool 
+setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool 
 setBreakFlag toggle array index
-   | toggle    = setBreakOn array index 
-   | otherwise = setBreakOff array index
+   | toggle    = GHC.setBreakOn array index 
+   | otherwise = GHC.setBreakOff array index
 
 
 {- these should probably go to the GHC API at some point -}