Use OPTIONS rather than OPTIONS_GHC for pragmas

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

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 3de1c7b..dddbb34 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -6,10 +6,14 @@
 -- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------
 -- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------

-module InteractiveUI ( 
-       interactiveUI,
-       ghciWelcomeMsg
-   ) where
+{-# 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/CodingStyle#Warnings
+-- for details
+
+module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where

 
 #include "HsVersions.h"
 
 
 #include "HsVersions.h"
 

@@ -21,14 +25,17 @@ 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, Resume, SingleStep )
+                          BreakIndex, SrcSpan, Resume, SingleStep )

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

+import HscTypes                ( implicitTyThings )

 import PprTyThing
 import Outputable       hiding (printForUser)
 import Module           -- for ModuleEnv
 import PprTyThing
 import Outputable       hiding (printForUser)
 import Module           -- for ModuleEnv

+import Name
+import SrcLoc

 
 -- Other random utilities
 import Digraph
 
 -- Other random utilities
 import Digraph

@@ -38,13 +45,12 @@ import Config
 import StaticFlags
 import Linker
 import Util
 import StaticFlags
 import Linker
 import Util

+import NameSet
+import Maybes          ( orElse )

 import FastString
 
 #ifndef mingw32_HOST_OS
 import FastString
 
 #ifndef mingw32_HOST_OS

-import System.Posix
-#if __GLASGOW_HASKELL__ > 504
-       hiding (getEnv)
-#endif
+import System.Posix hiding (getEnv)

 #else
 import GHC.ConsoleHandler ( flushConsole )
 import System.Win32      ( setConsoleCP, setConsoleOutputCP )
 #else
 import GHC.ConsoleHandler ( flushConsole )
 import System.Win32      ( setConsoleCP, setConsoleOutputCP )

@@ -86,12 +92,9 @@ import System.Posix.Internals ( setNonBlockingFD )
 
 -----------------------------------------------------------------------------
 
 
 -----------------------------------------------------------------------------
 

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

 
 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

@@ -110,6 +113,7 @@ builtin_commands = [
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("check",    keepGoing checkModule,          False, completeHomeModule),
   ("continue",  keepGoing continueCmd,          False, completeNone),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("check",    keepGoing checkModule,          False, completeHomeModule),
   ("continue",  keepGoing continueCmd,          False, completeNone),

+  ("cmd",       keepGoing cmdCmd,               False, completeIdentifier),

   ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
   ("def",      keepGoing defineMacro,          False, completeIdentifier),
   ("delete",    keepGoing deleteCmd,            False, completeNone),
   ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
   ("def",      keepGoing defineMacro,          False, completeIdentifier),
   ("delete",    keepGoing deleteCmd,            False, completeNone),

@@ -133,6 +137,8 @@ builtin_commands = [
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      keepGoing stepCmd,              False, completeIdentifier), 
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      keepGoing stepCmd,              False, completeIdentifier), 

+  ("steplocal", keepGoing stepLocalCmd,         False, completeIdentifier), 
+  ("stepmodule",keepGoing stepModuleCmd,        False, completeIdentifier), 

   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
   ("undef",     keepGoing undefineMacro,       False, completeMacro),

@@ -154,6 +160,7 @@ helpText =
  "   :add <filename> ...         add module(s) to the current target set\n" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++

+ "   :cmd <expr>                 run the commands returned by <expr>::IO String\n" ++

  "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
  "   :edit <file>                edit file\n" ++
  "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
  "   :edit <file>                edit file\n" ++

@@ -163,8 +170,8 @@ helpText =
  "   :info [<name> ...]          display information about the given names\n" ++
  "   :kind <type>                show the kind of <type>\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++
  "   :info [<name> ...]          display information about the given names\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" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++

+ "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++

  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "   :type <expr>                show the type of <expr>\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "   :type <expr>                show the type of <expr>\n" ++

@@ -184,11 +191,13 @@ helpText =
  "   :forward                    go forward in the history (after :back)\n" ++
  "   :history [<n>]              show the last <n> items in the history (after :trace)\n" ++
  "   :print [<name> ...]         prints a value without forcing its computation\n" ++
  "   :forward                    go forward in the history (after :back)\n" ++
  "   :history [<n>]              show the last <n> items in the history (after :trace)\n" ++
  "   :print [<name> ...]         prints a value without forcing its computation\n" ++

+ "   :sprint [<name> ...]        simplifed version of :print\n" ++

  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++

+ "   :steplocal                  single-step restricted to the current top level decl.\n"++
+ "   :stepmodule                 single-step restricted to the current module\n"++

  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++
  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++

- "   :sprint [<name> ...]        simplifed version of :print\n" ++

 
  "\n" ++
  " -- Commands for changing settings:\n" ++
 
  "\n" ++
  " -- Commands for changing settings:\n" ++

@@ -242,21 +251,22 @@ interactiveUI session srcs maybe_expr = do
    newStablePtr stdout
    newStablePtr stderr
 
    newStablePtr stdout
    newStablePtr stderr
 

-       -- Initialise buffering for the *interpreted* I/O system
+    -- Initialise buffering for the *interpreted* I/O system

    initInterpBuffering session
 
    when (isNothing maybe_expr) $ do
    initInterpBuffering session
 
    when (isNothing maybe_expr) $ do

-       -- Only for GHCi (not runghc and ghc -e):
-       -- Turn buffering off for the compiled program's stdout/stderr
-       turnOffBuffering
-       -- Turn buffering off for GHCi's stdout
-       hFlush stdout
-       hSetBuffering stdout NoBuffering
-       -- We don't want the cmd line to buffer any input that might be
-       -- intended for the program, so unbuffer stdin.
-       hSetBuffering stdin NoBuffering
-
-       -- initial context is just the Prelude
+        -- Only for GHCi (not runghc and ghc -e):
+
+        -- Turn buffering off for the compiled program's stdout/stderr
+        turnOffBuffering
+        -- Turn buffering off for GHCi's stdout
+        hFlush stdout
+        hSetBuffering stdout NoBuffering
+        -- We don't want the cmd line to buffer any input that might be
+        -- intended for the program, so unbuffer stdin.
+        hSetBuffering stdin NoBuffering
+
+        -- initial context is just the Prelude

    prel_mod <- GHC.findModule session prel_name (Just basePackageId)
    GHC.setContext session [] [prel_mod]
 
    prel_mod <- GHC.findModule session prel_name (Just basePackageId)
    GHC.setContext session [] [prel_mod]
 

@@ -287,7 +297,8 @@ interactiveUI session srcs maybe_expr = do
                    prelude = prel_mod,
                    break_ctr = 0,
                    breaks = [],
                    prelude = prel_mod,
                    break_ctr = 0,
                    breaks = [],

-                   tickarrays = emptyModuleEnv
+                   tickarrays = emptyModuleEnv,
+                   cmdqueue = []

                  }
 
 #ifdef USE_READLINE
                  }
 
 #ifdef USE_READLINE

@@ -347,28 +358,28 @@ runGHCi paths maybe_expr = do
   let show_prompt = verbosity dflags > 0 || is_tty
 
   case maybe_expr of
   let show_prompt = verbosity dflags > 0 || is_tty
 
   case maybe_expr of

-       Nothing -> 
+        Nothing ->

           do
 #if defined(mingw32_HOST_OS)
           do
 #if defined(mingw32_HOST_OS)

-            -- The win32 Console API mutates the first character of 
+            -- The win32 Console API mutates the first character of

             -- type-ahead when reading from it in a non-buffered manner. Work
             -- around this by flushing the input buffer of type-ahead characters,
             -- but only if stdin is available.
             flushed <- io (IO.try (GHC.ConsoleHandler.flushConsole stdin))
             -- type-ahead when reading from it in a non-buffered manner. Work
             -- around this by flushing the input buffer of type-ahead characters,
             -- but only if stdin is available.
             flushed <- io (IO.try (GHC.ConsoleHandler.flushConsole stdin))

-            case flushed of 
-            Left err | isDoesNotExistError err -> return ()
-                     | otherwise -> io (ioError err)
-            Right () -> return ()
+            case flushed of
+             Left err | isDoesNotExistError err -> return ()
+                      | otherwise -> io (ioError err)
+             Right () -> return ()

 #endif
 #endif

-           -- initialise the console if necessary
-           io setUpConsole
+            -- initialise the console if necessary
+            io setUpConsole

 
 

-           -- enter the interactive loop
-           interactiveLoop is_tty show_prompt
-       Just expr -> do
-           -- just evaluate the expression we were given
-           runCommandEval expr
-           return ()
+            -- enter the interactive loop
+            interactiveLoop is_tty show_prompt
+        Just expr -> do
+            -- just evaluate the expression we were given
+            runCommandEval expr
+            return ()

 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."

@@ -446,17 +457,9 @@ fileLoop hdl show_prompt = do
        Right l -> 
          case removeSpaces l of
             "" -> fileLoop hdl show_prompt
        Right l -> 
          case removeSpaces l of
             "" -> fileLoop hdl show_prompt

-           l  -> do quit <- runCommand l
+           l  -> do quit <- runCommands l

                      if quit then return () else fileLoop hdl show_prompt
 
                      if quit then return () else fileLoop hdl show_prompt
 

-stringLoop :: [String] -> GHCi Bool{-True: we quit-}
-stringLoop [] = return False
-stringLoop (s:ss) = do
-   case removeSpaces s of
-       "" -> stringLoop ss
-       l  -> do quit <- runCommand l
-                 if quit then return True else stringLoop ss
-

 mkPrompt = do
   session <- getSession
   (toplevs,exports) <- io (GHC.getContext session)
 mkPrompt = do
   session <- getSession
   (toplevs,exports) <- io (GHC.getContext session)

@@ -471,7 +474,7 @@ mkPrompt = do
                    then return (brackets (ppr (GHC.resumeSpan r)) <> space)
                    else do
                         let hist = GHC.resumeHistory r !! (ix-1)
                    then return (brackets (ppr (GHC.resumeSpan r)) <> space)
                    else do
                         let hist = GHC.resumeHistory r !! (ix-1)

-                        span <- io $ GHC.getHistorySpan session hist
+                        span <- io$ GHC.getHistorySpan session hist

                         return (brackets (ppr (negate ix) <> char ':' 
                                           <+> ppr span) <> space)
   let
                         return (brackets (ppr (negate ix) <> char ':' 
                                           <+> ppr span) <> space)
   let

@@ -514,17 +517,31 @@ readlineLoop = do
            "" -> readlineLoop
            l  -> do
                  io (addHistory l)
            "" -> readlineLoop
            l  -> do
                  io (addHistory l)

-                 quit <- runCommand l
+                 quit <- runCommands l

                  if quit then return () else readlineLoop
 #endif
 
                  if quit then return () else readlineLoop
 #endif
 

-runCommand :: String -> GHCi Bool
-runCommand c = ghciHandle handler (doCommand c)
-  where 
-    doCommand (':' : command) = specialCommand command
-    doCommand stmt
-       = do timeIt $ runStmt stmt GHC.RunToCompletion
-            return False
+runCommands :: String -> GHCi Bool
+runCommands cmd = do
+        q <- ghciHandle handler (doCommand cmd)
+        if q then return True else runNext
+  where
+       runNext = do
+          st <- getGHCiState
+          case cmdqueue st of
+            []   -> return False
+            c:cs -> do setGHCiState st{ cmdqueue = cs }
+                       runCommands c
+
+       doCommand (':' : cmd) = specialCommand cmd
+       doCommand stmt        = do timeIt $ runStmt stmt GHC.RunToCompletion
+                                  return False
+
+enqueueCommands :: [String] -> GHCi ()
+enqueueCommands cmds = do
+  st <- getGHCiState
+  setGHCiState st{ cmdqueue = cmds ++ cmdqueue st }
+

 
 -- This version is for the GHC command-line option -e.  The only difference
 -- from runCommand is that it catches the ExitException exception and
 
 -- This version is for the GHC command-line option -e.  The only difference
 -- from runCommand is that it catches the ExitException exception and

@@ -546,32 +563,39 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
 runStmt :: String -> SingleStep -> GHCi Bool
 runStmt stmt step
  | null (filter (not.isSpace) stmt) = return False
 runStmt :: String -> SingleStep -> GHCi Bool
 runStmt stmt step
  | null (filter (not.isSpace) stmt) = return False

+ | ["import", mod] <- words stmt    = keepGoing setContext ('+':mod)

  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt step
  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt step

-      afterRunStmt result
+      afterRunStmt (const True) result

 
 
 
 

-afterRunStmt :: GHC.RunResult -> GHCi Bool
+--afterRunStmt :: GHC.RunResult -> GHCi Bool

                                  -- False <=> the statement failed to compile
                                  -- False <=> the statement failed to compile

-afterRunStmt (GHC.RunException e) = throw e
-afterRunStmt run_result = do
-  session <- getSession
+afterRunStmt _ (GHC.RunException e) = throw e
+afterRunStmt step_here run_result = do
+  session     <- getSession
+  resumes <- io $ GHC.getResumeContext session

   case run_result of
      GHC.RunOk names -> do
         show_types <- isOptionSet ShowType
   case run_result of
      GHC.RunOk names -> do
         show_types <- isOptionSet ShowType

-        when show_types $ mapM_ (showTypeOfName session) names
-     GHC.RunBreak _ names _ -> do
-        resumes <- io $ GHC.getResumeContext session
-        printForUser $ ptext SLIT("Stopped at") <+> 
-                       ppr (GHC.resumeSpan (head resumes))
-        mapM_ (showTypeOfName session) names
-        -- run the command set with ":set stop <cmd>"
-        st <- getGHCiState
-        runCommand (stop st)
-        return ()
+        when show_types $ printTypeOfNames session names
+     GHC.RunBreak _ names mb_info 
+         | isNothing  mb_info || 
+           step_here (GHC.resumeSpan $ head resumes) -> do
+               printForUser $ ptext SLIT("Stopped at") <+> 
+                       ppr (GHC.resumeSpan $ head resumes)
+--               printTypeOfNames session names
+               printTypeAndContentOfNames session names
+               maybe (return ()) runBreakCmd mb_info
+               -- run the command set with ":set stop <cmd>"
+               st <- getGHCiState
+               enqueueCommands [stop st]
+               return ()
+         | otherwise -> io(GHC.resume session GHC.SingleStep) >>= 
+                        afterRunStmt step_here >> return ()

      _ -> return ()
 
   flushInterpBuffers
      _ -> return ()
 
   flushInterpBuffers

@@ -581,13 +605,44 @@ afterRunStmt run_result = do
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 

-
-showTypeOfName :: Session -> Name -> GHCi ()
-showTypeOfName session n
+      where printTypeAndContentOfNames session names = do
+              let namesSorted = sortBy compareNames names
+              tythings <- catMaybes `liftM` 
+                              io (mapM (GHC.lookupName session) namesSorted)
+              docs_ty  <- mapM showTyThing tythings
+              terms    <- mapM (io . GHC.obtainTermB session 10 False)
+                               [ id | (AnId id, Just _) <- zip tythings docs_ty]
+              docs_terms <- mapM (io . showTerm session) terms                                   
+              printForUser $ vcat $ zipWith (\ty cts -> ty <> text " = " <> cts)
+                                            (catMaybes docs_ty)
+                                            docs_terms
+
+runBreakCmd :: GHC.BreakInfo -> GHCi ()
+runBreakCmd info = do
+  let mod = GHC.breakInfo_module info
+      nm  = GHC.breakInfo_number info
+  st <- getGHCiState
+  case  [ loc | (i,loc) <- breaks st,
+                breakModule loc == mod, breakTick loc == nm ] of
+        []  -> return ()
+        loc:_ | null cmd  -> return ()
+              | otherwise -> do enqueueCommands [cmd]; return ()
+              where cmd = onBreakCmd loc
+
+printTypeOfNames :: Session -> [Name] -> GHCi ()
+printTypeOfNames session names
+ = mapM_ (printTypeOfName session) $ sortBy compareNames names
+
+compareNames :: Name -> Name -> Ordering
+n1 `compareNames` n2 = compareWith n1 `compare` compareWith n2
+    where compareWith n = (getOccString n, getSrcSpan n)
+
+printTypeOfName :: Session -> Name -> GHCi ()
+printTypeOfName session n

    = do maybe_tything <- io (GHC.lookupName session n)
    = do maybe_tything <- io (GHC.lookupName session n)

-       case maybe_tything of
-         Nothing    -> return ()
-         Just thing -> showTyThing thing
+        case maybe_tything of
+            Nothing    -> return ()
+            Just thing -> printTyThing thing

 
 specialCommand :: String -> GHCi Bool
 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
 
 specialCommand :: String -> GHCi Bool
 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)

@@ -605,7 +660,7 @@ lookupCommand str = do
   -- look for exact match first, then the first prefix match
   case [ c | c <- cmds, str == cmdName c ] of
      c:_ -> return (Just c)
   -- look for exact match first, then the first prefix match
   case [ c | c <- cmds, str == cmdName c ] of
      c:_ -> return (Just c)

-     [] -> case [ c | c@(s,_,_,_) <- cmds, prefixMatch str s ] of
+     [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of

                [] -> return Nothing
                c:_ -> return (Just c)
 
                [] -> return Nothing
                c:_ -> return (Just c)
 

@@ -625,6 +680,20 @@ getCurrentBreakSpan = do
                 span <- io $ GHC.getHistorySpan session hist
                 return (Just span)
 
                 span <- io $ GHC.getHistorySpan session hist
                 return (Just span)
 

+getCurrentBreakModule :: GHCi (Maybe Module)
+getCurrentBreakModule = 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 (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                return $ Just $ GHC.getHistoryModule  hist
+

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

@@ -640,30 +709,30 @@ info "" = throwDyn (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
 info s  = do { let names = words s
             ; session <- getSession
             ; dflags <- getDynFlags
 info s  = do { let names = words s
             ; session <- getSession
             ; dflags <- getDynFlags

-            ; let exts = dopt Opt_GlasgowExts dflags
-            ; mapM_ (infoThing exts session) names }
+            ; let pefas = dopt Opt_PrintExplicitForalls dflags
+            ; mapM_ (infoThing pefas session) names }

   where
   where

-    infoThing exts session str = io $ do
-       names <- GHC.parseName session str
-       let filtered = filterOutChildren names
-       mb_stuffs <- mapM (GHC.getInfo session) filtered
+    infoThing pefas session str = io $ do
+       names     <- GHC.parseName session str
+       mb_stuffs <- mapM (GHC.getInfo session) names
+       let filtered = filterOutChildren (\(t,f,i) -> t) (catMaybes mb_stuffs)

        unqual <- GHC.getPrintUnqual session
        putStrLn (showSDocForUser unqual $
                   vcat (intersperse (text "") $
        unqual <- GHC.getPrintUnqual session
        putStrLn (showSDocForUser unqual $
                   vcat (intersperse (text "") $

-                  [ pprInfo exts stuff | Just stuff <-  mb_stuffs ]))
+                        map (pprInfo pefas) filtered))

 
   -- Filter out names whose parent is also there Good
   -- example is '[]', which is both a type and data
   -- constructor in the same type
 
   -- Filter out names whose parent is also there Good
   -- example is '[]', which is both a type and data
   -- constructor in the same type

-filterOutChildren :: [Name] -> [Name]
-filterOutChildren names = filter (not . parent_is_there) names
- where parent_is_there n 
---      | Just p <- GHC.nameParent_maybe n = p `elem` names
--- ToDo!!
-        | otherwise                       = False
-
-pprInfo exts (thing, fixity, insts)
-  =  pprTyThingInContextLoc exts thing 
+filterOutChildren :: (a -> TyThing) -> [a] -> [a]
+filterOutChildren get_thing xs 
+  = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
+  where
+    implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
+
+pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
+pprInfo pefas (thing, fixity, insts)
+  =  pprTyThingInContextLoc pefas thing

   $$ show_fixity fixity
   $$ vcat (map GHC.pprInstance insts)
   where
   $$ show_fixity fixity
   $$ vcat (map GHC.pprInstance insts)
   where

@@ -674,8 +743,7 @@ pprInfo exts (thing, fixity, insts)
 runMain :: String -> GHCi ()
 runMain args = do
   let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))
 runMain :: String -> GHCi ()
 runMain args = do
   let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))

-  runCommand $ '[': ss ++ "] `System.Environment.withArgs` main"
-  return ()
+  enqueueCommands  ['[': ss ++ "] `System.Environment.withArgs` main"]

 
 addModule :: [FilePath] -> GHCi ()
 addModule files = do
 
 addModule :: [FilePath] -> GHCi ()
 addModule files = do

@@ -701,25 +769,47 @@ changeDirectory dir = do
   io (setCurrentDirectory dir)
 
 editFile :: String -> GHCi ()
   io (setCurrentDirectory dir)
 
 editFile :: String -> GHCi ()

-editFile str
-  | null str  = do
-       -- find the name of the "topmost" file loaded
-     session <- getSession
-     graph0 <- io (GHC.getModuleGraph session)
-     graph1 <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph0
-     let graph2 = flattenSCCs (GHC.topSortModuleGraph True graph1 Nothing)
-     case GHC.ml_hs_file (GHC.ms_location (last graph2)) of
-       Just file -> do_edit file
-       Nothing   -> throwDyn (CmdLineError "unknown file name")
-  | otherwise = do_edit str
-  where
-       do_edit file = do
-          st <- getGHCiState
-          let cmd = editor st
-          when (null cmd) $ 
-               throwDyn (CmdLineError "editor not set, use :set editor")
-          io $ system (cmd ++ ' ':file)
-           return ()
+editFile str =
+  do file <- if null str then chooseEditFile else return str
+     st <- getGHCiState
+     let cmd = editor st
+     when (null cmd) 
+       $ throwDyn (CmdLineError "editor not set, use :set editor")
+     io $ system (cmd ++ ' ':file)
+     return ()
+
+-- The user didn't specify a file so we pick one for them.
+-- Our strategy is to pick the first module that failed to load,
+-- or otherwise the first target.
+--
+-- XXX: Can we figure out what happened if the depndecy analysis fails
+--      (e.g., because the porgrammeer mistyped the name of a module)?
+-- XXX: Can we figure out the location of an error to pass to the editor?
+-- XXX: if we could figure out the list of errors that occured during the
+-- last load/reaload, then we could start the editor focused on the first
+-- of those.
+chooseEditFile :: GHCi String
+chooseEditFile =
+  do session <- getSession
+     let hasFailed x = io $ fmap not $ GHC.isLoaded session $ GHC.ms_mod_name x
+
+     graph <- io (GHC.getModuleGraph session)
+     failed_graph <- filterM hasFailed graph
+     let order g  = flattenSCCs $ GHC.topSortModuleGraph True g Nothing
+         pick xs  = case xs of
+                      x : _ -> GHC.ml_hs_file (GHC.ms_location x)
+                      _     -> Nothing
+
+     case pick (order failed_graph) of
+       Just file -> return file
+       Nothing   -> 
+         do targets <- io (GHC.getTargets session)
+            case msum (map fromTarget targets) of
+              Just file -> return file
+              Nothing   -> throwDyn (CmdLineError "No files to edit.")
+          
+  where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f
+        fromTarget _ = Nothing -- when would we get a module target?

 
 defineMacro :: String -> GHCi ()
 defineMacro s = do
 
 defineMacro :: String -> GHCi ()
 defineMacro s = do

@@ -748,7 +838,8 @@ defineMacro s = do
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
   str <- io ((unsafeCoerce# fun :: String -> IO String) s)
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
   str <- io ((unsafeCoerce# fun :: String -> IO String) s)

-  stringLoop (lines str)
+  enqueueCommands (lines str)
+  return False

 
 undefineMacro :: String -> GHCi ()
 undefineMacro macro_name = do
 
 undefineMacro :: String -> GHCi ()
 undefineMacro macro_name = do

@@ -763,6 +854,17 @@ undefineMacro macro_name = do
        else do
   io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
 
        else do
   io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
 

+cmdCmd :: String -> GHCi ()
+cmdCmd str = do
+  let expr = '(' : str ++ ") :: IO String"
+  session <- getSession
+  maybe_hv <- io (GHC.compileExpr session expr)
+  case maybe_hv of
+    Nothing -> return ()
+    Just hv -> do 
+        cmds <- io $ (unsafeCoerce# hv :: IO String)
+        enqueueCommands (lines cmds)
+        return ()

 
 loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule fs = timeIt (loadModule' fs)
 
 loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule fs = timeIt (loadModule' fs)

@@ -797,7 +899,7 @@ checkModule :: String -> GHCi ()
 checkModule m = do
   let modl = GHC.mkModuleName m
   session <- getSession
 checkModule m = do
   let modl = GHC.mkModuleName m
   session <- getSession

-  result <- io (GHC.checkModule session modl)
+  result <- io (GHC.checkModule session modl False)

   case result of
     Nothing -> io $ putStrLn "Nothing"
     Just r  -> io $ putStrLn (showSDoc (
   case result of
     Nothing -> io $ putStrLn "Nothing"
     Just r  -> io $ putStrLn (showSDoc (

@@ -812,17 +914,10 @@ checkModule m = do
   afterLoad (successIf (isJust result)) session
 
 reloadModule :: String -> GHCi ()
   afterLoad (successIf (isJust result)) session
 
 reloadModule :: String -> GHCi ()

-reloadModule "" = do
-  io (revertCAFs)              -- always revert CAFs on reload.
-  discardActiveBreakPoints
-  session <- getSession
-  doLoad session LoadAllTargets
-  return ()

 reloadModule m = do
 reloadModule m = do

-  io (revertCAFs)              -- always revert CAFs on reload.
-  discardActiveBreakPoints

   session <- getSession
   session <- getSession

-  doLoad session (LoadUpTo (GHC.mkModuleName m))
+  doLoad session $ if null m then LoadAllTargets 
+                             else LoadUpTo (GHC.mkModuleName m)

   return ()
 
 doLoad session howmuch = do
   return ()
 
 doLoad session howmuch = do

@@ -942,16 +1037,16 @@ browseModule m exports_only = do
     Just mod_info -> do
         let names
               | exports_only = GHC.modInfoExports mod_info
     Just mod_info -> do
         let names
               | exports_only = GHC.modInfoExports mod_info

-              | otherwise    = fromMaybe [] (GHC.modInfoTopLevelScope mod_info)
+              | otherwise    = GHC.modInfoTopLevelScope mod_info
+                               `orElse` []

 
 

-           filtered = filterOutChildren names
-       
-        things <- io $ mapM (GHC.lookupName s) filtered
+        mb_things <- io $ mapM (GHC.lookupName s) names
+       let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things)

 
         dflags <- getDynFlags
 
         dflags <- getDynFlags

-       let exts = dopt Opt_GlasgowExts dflags
+       let pefas = dopt Opt_PrintExplicitForalls dflags

        io (putStrLn (showSDocForUser unqual (
        io (putStrLn (showSDocForUser unqual (

-               vcat (map (pprTyThingInContext exts) (catMaybes things))
+               vcat (map (pprTyThingInContext pefas) filtered_things)

           )))
        -- ToDo: modInfoInstances currently throws an exception for
        -- package modules.  When it works, we can do this:
           )))
        -- ToDo: modInfoInstances currently throws an exception for
        -- package modules.  When it works, we can do this:

@@ -1064,6 +1159,19 @@ setEditor cmd = do
   st <- getGHCiState
   setGHCiState st{ editor = cmd }
 
   st <- getGHCiState
   setGHCiState st{ editor = cmd }
 

+setStop str@(c:_) | isDigit c
+  = do let (nm_str,rest) = break (not.isDigit) str
+           nm = read nm_str
+       st <- getGHCiState
+       let old_breaks = breaks st
+       if all ((/= nm) . fst) old_breaks
+              then printForUser (text "Breakpoint" <+> ppr nm <+>
+                                 text "does not exist")
+              else do
+       let new_breaks = map fn old_breaks
+           fn (i,loc) | i == nm   = (i,loc { onBreakCmd = dropWhile isSpace rest })
+                      | otherwise = (i,loc)
+       setGHCiState st{ breaks = new_breaks }

 setStop cmd = do
   st <- getGHCiState
   setGHCiState st{ stop = cmd }
 setStop cmd = do
   st <- getGHCiState
   setGHCiState st{ stop = cmd }

@@ -1184,19 +1292,30 @@ showBindings = do
   s <- getSession
   unqual <- io (GHC.getPrintUnqual s)
   bindings <- io (GHC.getBindings s)
   s <- getSession
   unqual <- io (GHC.getPrintUnqual s)
   bindings <- io (GHC.getBindings s)

-  mapM_ showTyThing bindings
+  mapM_ printTyThing $ sortBy compareTyThings bindings

   return ()
 
   return ()
 

-showTyThing (AnId id) = do 
+compareTyThings :: TyThing -> TyThing -> Ordering
+t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
+
+showTyThing :: TyThing -> GHCi (Maybe SDoc)
+showTyThing (AnId id) = do

   ty' <- cleanType (GHC.idType id)
   ty' <- cleanType (GHC.idType id)

-  printForUser $ ppr id <> text " :: " <> ppr ty'
-showTyThing _  = return ()
+  return $ Just $ ppr id <> text " :: " <> ppr ty'
+showTyThing _ = return Nothing
+
+printTyThing :: TyThing -> GHCi ()
+printTyThing tyth = do
+  mb_x <- showTyThing tyth
+  case mb_x of
+    Just x  -> printForUser x
+    Nothing -> return ()

 
 -- if -fglasgow-exts is on we show the foralls, otherwise we don't.
 cleanType :: Type -> GHCi Type
 cleanType ty = do
   dflags <- getDynFlags
 
 -- if -fglasgow-exts is on we show the foralls, otherwise we don't.
 cleanType :: Type -> GHCi Type
 cleanType ty = do
   dflags <- getDynFlags

-  if dopt Opt_GlasgowExts dflags 
+  if dopt Opt_PrintExplicitForalls dflags 

        then return ty
        else return $! GHC.dropForAlls ty
 
        then return ty
        else return $! GHC.dropForAlls ty
 

@@ -1408,6 +1527,10 @@ wantNameFromInterpretedModule noCanDo str and_then = do
       []    -> return ()
       (n:_) -> do
             let modl = GHC.nameModule n
       []    -> return ()
       (n:_) -> do
             let modl = GHC.nameModule n

+            if not (GHC.isExternalName n)
+               then noCanDo n $ ppr n <>
+                                text " is not defined in an interpreted module"
+               else do

             is_interpreted <- io (GHC.moduleIsInterpreted session modl)
             if not is_interpreted
                then noCanDo n $ text "module " <> ppr modl <>
             is_interpreted <- io (GHC.moduleIsInterpreted session modl)
             if not is_interpreted
                then noCanDo n $ text "module " <> ppr modl <>

@@ -1450,21 +1573,55 @@ pprintCommand bind force str = do
   io $ pprintClosureCommand session bind force str
 
 stepCmd :: String -> GHCi ()
   io $ pprintClosureCommand session bind force str
 
 stepCmd :: String -> GHCi ()

-stepCmd []         = doContinue GHC.SingleStep
+stepCmd []         = doContinue (const True) GHC.SingleStep

 stepCmd expression = do runStmt expression GHC.SingleStep; return ()
 
 stepCmd expression = do runStmt expression GHC.SingleStep; return ()
 

+stepLocalCmd :: String -> GHCi ()
+stepLocalCmd  [] = do 
+  mb_span <- getCurrentBreakSpan
+  case mb_span of
+    Nothing  -> stepCmd []
+    Just loc -> do
+       Just mod <- getCurrentBreakModule
+       current_toplevel_decl <- enclosingTickSpan mod loc
+       doContinue (`isSubspanOf` current_toplevel_decl) GHC.SingleStep
+
+stepLocalCmd expression = stepCmd expression
+
+stepModuleCmd :: String -> GHCi ()
+stepModuleCmd  [] = do 
+  mb_span <- getCurrentBreakSpan
+  case mb_span of
+    Nothing  -> stepCmd []
+    Just loc -> do
+       Just span <- getCurrentBreakSpan
+       let f some_span = optSrcSpanFileName span == optSrcSpanFileName some_span
+       doContinue f GHC.SingleStep
+
+stepModuleCmd expression = stepCmd expression
+
+-- | Returns the span of the largest tick containing the srcspan given
+enclosingTickSpan :: Module -> SrcSpan -> GHCi SrcSpan
+enclosingTickSpan mod src = do
+  ticks <- getTickArray mod
+  let line = srcSpanStartLine src
+  ASSERT (inRange (bounds ticks) line) do
+  let enclosing_spans = [ span | (_,span) <- ticks ! line
+                               , srcSpanEnd span >= srcSpanEnd src]
+  return . head . sortBy leftmost_largest $ enclosing_spans
+

 traceCmd :: String -> GHCi ()
 traceCmd :: String -> GHCi ()

-traceCmd []         = doContinue GHC.RunAndLogSteps
+traceCmd []         = doContinue (const True) GHC.RunAndLogSteps

 traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
 
 continueCmd :: String -> GHCi ()
 traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
 
 continueCmd :: String -> GHCi ()

-continueCmd = noArgs $ doContinue GHC.RunToCompletion
+continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion

 
 

-doContinue :: SingleStep -> GHCi ()
-doContinue step = do 
+-- doContinue :: SingleStep -> GHCi ()
+doContinue pred step = do 

   session <- getSession
   runResult <- io $ GHC.resume session step
   session <- getSession
   runResult <- io $ GHC.resume session step

-  afterRunStmt runResult
+  afterRunStmt pred runResult

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

@@ -1506,20 +1663,27 @@ historyCmd arg
         let hist = GHC.resumeHistory r
             (took,rest) = splitAt num hist
         spans <- mapM (io . GHC.getHistorySpan s) took
         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)))
+        let nums  = map (printf "-%-3d:") [(1::Int)..]
+        let names = map GHC.historyEnclosingDecl took
+        printForUser (vcat(zipWith3 
+                             (\x y z -> x <+> y <+> z) 
+                             (map text nums) 
+                             (map (bold . ppr) names)
+                             (map (parens . ppr) spans)))

         io $ putStrLn $ if null rest then "<end of history>" else "..."
 
         io $ putStrLn $ if null rest then "<end of history>" else "..."
 

+bold c | do_bold   = text start_bold <> c <> text end_bold
+       | otherwise = c
+

 backCmd :: String -> GHCi ()
 backCmd = noArgs $ do
   s <- getSession
   (names, ix, span) <- io $ GHC.back s
   printForUser $ ptext SLIT("Logged breakpoint at") <+> ppr span
 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
+  printTypeOfNames s names

    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState

-  runCommand (stop st)
-  return ()
+  enqueueCommands [stop st]

 
 forwardCmd :: String -> GHCi ()
 forwardCmd = noArgs $ do
 
 forwardCmd :: String -> GHCi ()
 forwardCmd = noArgs $ do

@@ -1528,11 +1692,10 @@ forwardCmd = noArgs $ do
   printForUser $ (if (ix == 0)
                     then ptext SLIT("Stopped at")
                     else ptext SLIT("Logged breakpoint at")) <+> ppr span
   printForUser $ (if (ix == 0)
                     then ptext SLIT("Stopped at")
                     else ptext SLIT("Logged breakpoint at")) <+> ppr span

-  mapM_ (showTypeOfName s) names
+  printTypeOfNames s names

    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState

-  runCommand (stop st)
-  return ()
+  enqueueCommands [stop st]

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

@@ -1556,7 +1719,7 @@ breakSwitch session args@(arg1:rest)
               io $ putStrLn "Perhaps no modules are loaded for debugging?"
    | otherwise = do -- try parsing it as an identifier
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
               io $ putStrLn "Perhaps no modules are loaded for debugging?"
    | otherwise = do -- try parsing it as an identifier
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do

-        let loc = GHC.nameSrcLoc name
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)

         if GHC.isGoodSrcLoc loc
                then findBreakAndSet (GHC.nameModule name) $ 
                          findBreakByCoord (Just (GHC.srcLocFile loc))
         if GHC.isGoodSrcLoc loc
                then findBreakAndSet (GHC.nameModule name) $ 
                          findBreakByCoord (Just (GHC.srcLocFile loc))

@@ -1571,14 +1734,17 @@ 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
 breakByModule session mod args@(arg1:rest)
    | all isDigit arg1 = do  -- looks like a line number
         breakByModuleLine mod (read arg1) rest

-   | otherwise = io $ putStrLn "Invalid arguments to :break"
+breakByModule session mod _
+   = breakSyntax

 
 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
 breakByModuleLine mod line args
    | [] <- args = findBreakAndSet mod $ findBreakByLine line
    | [col] <- args, all isDigit col =
         findBreakAndSet mod $ findBreakByCoord Nothing (line, read col)
 
 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
 breakByModuleLine mod line args
    | [] <- args = findBreakAndSet mod $ findBreakByLine line
    | [col] <- args, all isDigit col =
         findBreakAndSet mod $ findBreakByCoord Nothing (line, read col)

-   | otherwise = io $ putStrLn "Invalid arguments to :break"
+   | otherwise = breakSyntax
+
+breakSyntax = throwDyn (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")

 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet mod lookupTickTree = do 
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet mod lookupTickTree = do 

@@ -1596,6 +1762,7 @@ findBreakAndSet mod lookupTickTree = do
                              { breakModule = mod
                              , breakLoc = span
                              , breakTick = tick
                              { breakModule = mod
                              , breakLoc = span
                              , breakTick = tick

+                             , onBreakCmd = ""

                              }
                printForUser $
                   text "Breakpoint " <> ppr nm <>
                              }
                printForUser $
                   text "Breakpoint " <> ppr nm <>

@@ -1616,9 +1783,9 @@ findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
 findBreakByLine line arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
 findBreakByLine line arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =

-    listToMaybe (sortBy leftmost_largest  complete)   `mplus`
-    listToMaybe (sortBy leftmost_smallest incomplete) `mplus`
-    listToMaybe (sortBy rightmost ticks)
+    listToMaybe (sortBy (leftmost_largest `on` snd)  complete)   `mplus`
+    listToMaybe (sortBy (leftmost_smallest `on` snd) incomplete) `mplus`
+    listToMaybe (sortBy (rightmost `on` snd) ticks)

   where 
         ticks = arr ! line
 
   where 
         ticks = arr ! line
 

@@ -1633,7 +1800,8 @@ findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
 findBreakByCoord mb_file (line, col) arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
 findBreakByCoord mb_file (line, col) arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =

-    listToMaybe (sortBy rightmost contains)
+    listToMaybe (sortBy (rightmost `on` snd) contains ++
+                 sortBy (leftmost_smallest `on` snd) after_here)

   where 
         ticks = arr ! line
 
   where 
         ticks = arr ! line
 

@@ -1645,26 +1813,31 @@ findBreakByCoord mb_file (line, col) arr
                  | Just f <- mb_file = GHC.srcSpanFile span == f
                  | otherwise         = True
 
                  | Just f <- mb_file = GHC.srcSpanFile span == f
                  | otherwise         = True
 

+        after_here = [ tick | tick@(nm,span) <- ticks,
+                              GHC.srcSpanStartLine span == line,
+                              GHC.srcSpanStartCol span >= col ]
+
+-- for now, use ANSI bold on Unixy systems.  On Windows, we add a line
+-- of carets under the active expression instead.  The Windows console
+-- doesn't support ANSI escape sequences, and most Unix terminals
+-- (including xterm) do, so this is a reasonable guess until we have a
+-- proper termcap/terminfo library.
+#if !defined(mingw32_TARGET_OS)
+do_bold = True
+#else
+do_bold = False
+#endif

 
 

-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) = 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"
+start_bold = "\ESC[1m"
+end_bold   = "\ESC[0m"

 
 listCmd :: String -> GHCi ()
 listCmd "" = do
    mb_span <- getCurrentBreakSpan
    case mb_span of
       Nothing  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
 
 listCmd :: String -> GHCi ()
 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
+      Just span | GHC.isGoodSrcSpan span -> io $ listAround span True
+                | otherwise              -> printForUser $ text "unable to list source for" <+> ppr span

 listCmd str = list2 (words str)
 
 list2 [arg] | all isDigit arg = do
 listCmd str = list2 (words str)
 
 list2 [arg] | all isDigit arg = do

@@ -1678,7 +1851,7 @@ list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
         listModuleLine mod (read arg2)
 list2 [arg] = do
         wantNameFromInterpretedModule noCanDo arg $ \name -> do
         listModuleLine mod (read arg2)
 list2 [arg] = do
         wantNameFromInterpretedModule noCanDo arg $ \name -> do

-        let loc = GHC.nameSrcLoc name
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)

         if GHC.isGoodSrcLoc loc
                then do
                   tickArray <- getTickArray (GHC.nameModule name)
         if GHC.isGoodSrcLoc loc
                then do
                   tickArray <- getTickArray (GHC.nameModule name)

@@ -1739,19 +1912,36 @@ listAround span do_highlight = do
                    | otherwise  = 1
         pad_after = 1
 
                    | otherwise  = 1
         pad_after = 1
 

-        highlight no line
+        highlight | do_bold   = highlight_bold
+                  | otherwise = highlight_carets
+
+        highlight_bold no line

           | no == line1 && no == line2
           = let (a,r) = BS.splitAt col1 line
                 (b,c) = BS.splitAt (col2-col1) r
             in
           | 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]
+            BS.concat [a,BS.pack start_bold,b,BS.pack end_bold,c]

           | no == line1
           = let (a,b) = BS.splitAt col1 line in
           | no == line1
           = let (a,b) = BS.splitAt col1 line in

-            BS.concat [a, start_bold, b]
+            BS.concat [a, BS.pack start_bold, b]

           | no == line2
           = let (a,b) = BS.splitAt col2 line in
           | no == line2
           = let (a,b) = BS.splitAt col2 line in

-            BS.concat [a, end_bold, b]
+            BS.concat [a, BS.pack end_bold, b]
+          | otherwise   = line
+
+        highlight_carets no line
+          | no == line1 && no == line2
+          = BS.concat [line, nl, indent, BS.replicate col1 ' ',
+                                         BS.replicate (col2-col1) '^']
+          | no == line1
+          = BS.concat [line, nl, indent, BS.replicate col1 ' ',
+                                         BS.replicate (BS.length line-col1) '^']
+          | no == line2
+          = BS.concat [line, nl, indent, BS.replicate col2 '^']

           | otherwise   = line
           | otherwise   = line

+         where
+           indent = BS.pack "   "
+           nl = BS.singleton '\n'

 
 -- --------------------------------------------------------------------------
 -- Tick arrays
 
 -- --------------------------------------------------------------------------
 -- Tick arrays