X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=dddbb347038f7e5c62bbe84d7df644217e2d1b1a;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hp=ad708f511f6f3c2dcf42033abde655dfb35fcd92;hpb=e1b8996040150d5b4027ebd50c2df1f24d79a531;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index ad708f5..dddbb34 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -6,10 +6,14 @@
 -- (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"
 
@@ -21,14 +25,17 @@ import Debugger
 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 HscTypes		( implicitTyThings )
 import PprTyThing
 import Outputable       hiding (printForUser)
 import Module           -- for ModuleEnv
+import Name
+import SrcLoc
 
 -- Other random utilities
 import Digraph
@@ -38,13 +45,12 @@ import Config
 import StaticFlags
 import Linker
 import Util
+import NameSet
+import Maybes		( orElse )
 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 )
@@ -74,6 +80,7 @@ import Data.Char
 import Data.Dynamic
 import Data.Array
 import Control.Monad as Monad
+import Text.Printf
 
 import Foreign.StablePtr	( newStablePtr )
 import GHC.Exts		( unsafeCoerce# )
@@ -85,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
@@ -108,7 +112,8 @@ builtin_commands = [
   ("browse",    keepGoing browseCmd,		False, completeModule),
   ("cd",    	keepGoing changeDirectory,	False, completeFilename),
   ("check",	keepGoing checkModule,		False, completeHomeModule),
-  ("continue",  continueCmd,                    False, completeNone),
+  ("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),
@@ -131,9 +136,11 @@ builtin_commands = [
   ("set",	keepGoing setCmd,		True,  completeSetOptions),
   ("show",	keepGoing showCmd,		False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
-  ("step",      stepCmd,                        False, completeIdentifier), 
+  ("step",      keepGoing stepCmd,              False, completeIdentifier), 
+  ("steplocal", keepGoing stepLocalCmd,         False, completeIdentifier), 
+  ("stepmodule",keepGoing stepModuleCmd,        False, completeIdentifier), 
   ("type",	keepGoing typeOfExpr,		False, completeIdentifier),
-  ("trace",     traceCmd,                       False, completeIdentifier), 
+  ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
   ("undef",     keepGoing undefineMacro,	False, completeMacro),
   ("unset",	keepGoing unsetOptions,		True,  completeSetOptions)
   ]
@@ -149,31 +156,51 @@ shortHelpText = "use :? for help.\n"
 helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
- "   <stmt>                      evaluate/run <stmt>\n" ++
+ "   <statement>                 evaluate/run <statement>\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
- "   :abandon                    at a breakpoint, abandon current computation\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" ++
+ "   :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" ++
- "   :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" ++
  "   :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" ++
+ "   :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" ++
+ "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
+ "   :!<command>                 run the shell command <command>\n" ++
+ "\n" ++
+ " -- Commands for debugging:\n" ++
+ "\n" ++
+ "   :abandon                    at a breakpoint, abandon current computation\n" ++
+ "   :back                       go back in the history (after :trace)\n" ++
+ "   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" ++
+ "   :break <name>               set a breakpoint on the specified function\n" ++
+ "   :continue                   resume after a breakpoint\n" ++
+ "   :delete <number>            delete the specified breakpoint\n" ++
+ "   :delete *                   delete all breakpoints\n" ++
+ "   :force <expr>               print <expr>, forcing unevaluated parts\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"++
+ "   :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"++
+
+ "\n" ++
+ " -- Commands for changing settings:\n" ++
  "\n" ++
  "   :set <option> ...           set options\n" ++
  "   :set args <arg> ...         set the arguments returned by System.getArgs\n" ++
@@ -181,29 +208,24 @@ helpText =
  "   :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" ++
- "   :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" ++
- "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :unset <option> ...         unset options\n" ++
- "   :!<command>                 run the shell command <command>\n" ++
  "\n" ++
- " Options for ':set' and ':unset':\n" ++
+ "  Options for ':set' and ':unset':\n" ++
  "\n" ++
  "    +r            revert top-level expressions after each evaluation\n" ++
  "    +s            print timing/memory stats after each evaluation\n" ++
  "    +t            print type after evaluation\n" ++
  "    -<flags>      most GHC command line flags can also be set here\n" ++
  "                         (eg. -v2, -fglasgow-exts, etc.)\n" ++
+ "\n" ++
+ " -- Commands for displaying information:\n" ++
+ "\n" ++
+ "   :show bindings              show the current bindings made at the prompt\n" ++
+ "   :show breaks                show the active breakpoints\n" ++
+ "   :show context               show the breakpoint context\n" ++
+ "   :show modules               show the currently loaded modules\n" ++
+ "   :show <setting>             show anything that can be set with :set (e.g. args)\n" ++
  "\n" 
--- Todo: add help for breakpoint commands here
 
 findEditor = do
   getEnv "EDITOR" 
@@ -229,21 +251,22 @@ interactiveUI session srcs maybe_expr = do
    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
-	-- 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]
 
@@ -274,7 +297,8 @@ interactiveUI session srcs maybe_expr = do
                    prelude = prel_mod,
                    break_ctr = 0,
                    breaks = [],
-                   tickarrays = emptyModuleEnv
+                   tickarrays = emptyModuleEnv,
+                   cmdqueue = []
                  }
 
 #ifdef USE_READLINE
@@ -334,28 +358,28 @@ runGHCi paths maybe_expr = do
   let show_prompt = verbosity dflags > 0 || is_tty
 
   case maybe_expr of
-	Nothing -> 
+        Nothing ->
           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))
-            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
-	    -- 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."
@@ -433,17 +457,9 @@ fileLoop hdl show_prompt = do
 	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
 
-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)
@@ -458,7 +474,7 @@ mkPrompt = do
                    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
@@ -501,17 +517,31 @@ readlineLoop = do
 	    "" -> readlineLoop
 	    l  -> do
         	  io (addHistory l)
-  	  	  quit <- runCommand l
+  	  	  quit <- runCommands l
           	  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
@@ -533,62 +563,86 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
 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
-      afterRunStmt result
-      return False
+      afterRunStmt (const True) 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
-  
+--afterRunStmt :: GHC.RunResult -> GHCi Bool
+                                 -- False <=> the statement failed to compile
+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
+        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
   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.RunBreak threadId names info) = do
-   session <- getSession
-   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 ! GHC.breakInfo_number info
-   printForUser $ ptext SLIT("Stopped at") <+> ppr location
-
-   -- run the command set with ":set stop <cmd>"
-   st <- getGHCiState
-   runCommand (stop st)
-
-   return (Just (True,names))
-
-
-showTypeOfName :: Session -> Name -> GHCi ()
-showTypeOfName session n
+  return (case run_result of GHC.RunOk _ -> True; _ -> False)
+
+      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)
-	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)
@@ -606,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)
-     [] -> case [ c | c@(s,_,_,_) <- cmds, prefixMatch str s ] of
+     [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of
      		[] -> return Nothing
      		c:_ -> return (Just c)
 
@@ -626,6 +680,20 @@ getCurrentBreakSpan = do
                 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
 
@@ -641,30 +709,30 @@ info "" = throwDyn (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
 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
-    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 "") $
-		   [ 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
-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
@@ -675,8 +743,7 @@ pprInfo exts (thing, fixity, insts)
 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
@@ -702,25 +769,47 @@ changeDirectory dir = do
   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
@@ -749,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)
-  stringLoop (lines str)
+  enqueueCommands (lines str)
+  return False
 
 undefineMacro :: String -> GHCi ()
 undefineMacro macro_name = do
@@ -764,6 +854,17 @@ undefineMacro macro_name = do
 	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)
@@ -776,6 +877,7 @@ loadModule' files = do
   session <- getSession
 
   -- unload first
+  discardActiveBreakPoints
   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)
 
@@ -791,15 +893,13 @@ loadModule' files = do
   -- as a ToDo for now.
 
   io (GHC.setTargets session targets)
-  ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
-  return ok
+  doLoad session LoadAllTargets
 
 checkModule :: String -> GHCi ()
 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 (
@@ -814,21 +914,23 @@ checkModule m = do
   afterLoad (successIf (isJust result)) session
 
 reloadModule :: String -> GHCi ()
-reloadModule "" = do
-  io (revertCAFs)		-- always revert CAFs on reload.
-  session <- getSession
-  ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
 reloadModule m = do
-  io (revertCAFs)		-- always revert CAFs on reload.
   session <- getSession
-  ok <- io (GHC.load session (LoadUpTo (GHC.mkModuleName m)))
+  doLoad session $ if null m then LoadAllTargets 
+                             else LoadUpTo (GHC.mkModuleName m)
+  return ()
+
+doLoad session howmuch = do
+  -- turn off breakpoints before we load: we can't turn them off later, because
+  -- the ModBreaks will have gone away.
+  discardActiveBreakPoints
+  ok <- io (GHC.load session howmuch)
   afterLoad ok session
+  return ok
 
 afterLoad ok session = do
   io (revertCAFs)  -- always revert CAFs on load.
   discardTickArrays
-  discardActiveBreakPoints
   graph <- io (GHC.getModuleGraph session)
   graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
   setContextAfterLoad session graph'
@@ -917,8 +1019,8 @@ browseCmd m =
 
 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
@@ -935,16 +1037,16 @@ browseModule m exports_only = do
     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
-	let exts = dopt Opt_GlasgowExts dflags
+	let pefas = dopt Opt_PrintExplicitForalls dflags
 	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:
@@ -1057,6 +1159,19 @@ setEditor cmd = do
   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 }
@@ -1074,8 +1189,10 @@ setOptions wds =
    do -- first, deal with the GHCi opts (+s, +t, etc.)
       let (plus_opts, minus_opts)  = partition isPlus wds
       mapM_ setOpt plus_opts
-
       -- then, dynamic flags
+      newDynFlags minus_opts
+
+newDynFlags minus_opts = do
       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
       (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
@@ -1113,10 +1230,11 @@ unsetOptions str
 
        mapM_ unsetOpt plus_opts
  
-       -- can't do GHC flags for now
-       if (not (null minus_opts))
-	  then throwDyn (CmdLineError "can't unset GHC command-line flags")
-	  else return ()
+       let no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
+           no_flag f = throwDyn (ProgramError ("don't know how to reverse " ++ f))
+
+       no_flags <- mapM no_flag minus_opts
+       newDynFlags no_flags
 
 isMinus ('-':s) = True
 isMinus _ = False
@@ -1148,14 +1266,20 @@ optToStr RevertCAFs = "r"
 -- ---------------------------------------------------------------------------
 -- code for `:show'
 
-showCmd str =
+showCmd str = do
+  st <- getGHCiState
   case words str of
+        ["args"]     -> io $ putStrLn (show (args st))
+        ["prog"]     -> io $ putStrLn (show (progname st))
+        ["prompt"]   -> io $ putStrLn (show (prompt st))
+        ["editor"]   -> io $ putStrLn (show (editor st))
+        ["stop"]     -> io $ putStrLn (show (stop st))
 	["modules" ] -> showModules
 	["bindings"] -> showBindings
 	["linker"]   -> io showLinkerState
-        ["breaks"] -> showBkptTable
-        ["context"] -> showContext
-	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings|breaks]")
+        ["breaks"]   -> showBkptTable
+        ["context"]  -> showContext
+	_ -> throwDyn (CmdLineError "syntax:  :show [args|prog|prompt|editor|stop|modules|bindings|breaks|context]")
 
 showModules = do
   session <- getSession
@@ -1168,19 +1292,30 @@ showBindings = do
   s <- getSession
   unqual <- io (GHC.getPrintUnqual s)
   bindings <- io (GHC.getBindings s)
-  mapM_ showTyThing bindings
+  mapM_ printTyThing $ sortBy compareTyThings bindings
   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)
-  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 dopt Opt_GlasgowExts dflags 
+  if dopt Opt_PrintExplicitForalls dflags 
 	then return ty
 	else return $! GHC.dropForAlls ty
 
@@ -1376,6 +1511,32 @@ expandPath path =
    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
+            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 <>
+                                text " is not interpreted"
+               else and_then n
+
 -- ----------------------------------------------------------------------------
 -- Windows console setup
 
@@ -1411,26 +1572,57 @@ pprintCommand bind force str = do
   session <- getSession
   io $ pprintClosureCommand session bind force str
 
-stepCmd :: String -> GHCi Bool
-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 [] = doContinue GHC.RunToCompletion
-continueCmd other = do
-   io $ putStrLn "The continue command accepts no arguments."
-   return False
-
-doContinue :: SingleStep -> GHCi Bool
-doContinue step = do 
+stepCmd :: String -> GHCi ()
+stepCmd []         = doContinue (const True) GHC.SingleStep
+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 []         = doContinue (const True) GHC.RunAndLogSteps
+traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
+
+continueCmd :: String -> GHCi ()
+continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
+
+-- doContinue :: SingleStep -> GHCi ()
+doContinue pred step = do 
   session <- getSession
   runResult <- io $ GHC.resume session step
-  afterRunStmt runResult
-  return False
+  afterRunStmt pred runResult
+  return ()
 
 abandonCmd :: String -> GHCi ()
 abandonCmd = noArgs $ do
@@ -1457,26 +1649,41 @@ deleteCmd argLine = do
          | otherwise = return ()
 
 historyCmd :: String -> GHCi ()
-historyCmd = noArgs $ 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
-      spans <- mapM (io . GHC.getHistorySpan s) hist
-      printForUser (vcat (map ppr spans))
+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)..]
+        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 "..."
+
+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
-  mapM_ (showTypeOfName s) names
+  printTypeOfNames s names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
-  runCommand (stop st)
-  return ()
+  enqueueCommands [stop st]
 
 forwardCmd :: String -> GHCi ()
 forwardCmd = noArgs $ do
@@ -1485,11 +1692,10 @@ forwardCmd = noArgs $ do
   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
-  runCommand (stop st)
-  return ()
+  enqueueCommands [stop st]
 
 -- handle the "break" command
 breakCmd :: String -> GHCi ()
@@ -1502,7 +1708,7 @@ breakSwitch _session [] = 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 
@@ -1511,50 +1717,34 @@ breakSwitch session args@(arg1:rest)
            [] -> 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) $ 
+   | otherwise = do -- try parsing it as an identifier
+        wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
+        if GHC.isGoodSrcLoc loc
+               then findBreakAndSet (GHC.nameModule name) $ 
                          findBreakByCoord (Just (GHC.srcLocFile loc))
                                           (GHC.srcLocLine 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
 
-
-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
         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)
-   | 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 
@@ -1572,6 +1762,7 @@ findBreakAndSet mod lookupTickTree = do
                              { breakModule = mod
                              , breakLoc = span
                              , breakTick = tick
+                             , onBreakCmd = ""
                              }
                printForUser $
                   text "Breakpoint " <> ppr nm <>
@@ -1592,9 +1783,9 @@ findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
 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
 
@@ -1609,7 +1800,8 @@ findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
 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
 
@@ -1621,26 +1813,74 @@ findBreakByCoord mb_file (line, col) arr
                  | 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 str = do
+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
+    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.srcSpanStart (GHC.nameSrcSpan 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
@@ -1672,19 +1912,36 @@ listAround span do_highlight = do
                    | 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
-            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
-            BS.concat [a, start_bold, b]
+            BS.concat [a, BS.pack start_bold, b]
           | 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
+         where
+           indent = BS.pack "   "
+           nl = BS.singleton '\n'
 
 -- --------------------------------------------------------------------------
 -- Tick arrays
@@ -1712,13 +1969,14 @@ mkTickArray ticks
         [ (line, (nm,span)) | (nm,span) <- ticks,
                               line <- srcSpanLines span ]
     where
-        max_line = maximum (map GHC.srcSpanEndLine (map snd ticks))
+        max_line = foldr max 0 (map GHC.srcSpanEndLine (map snd ticks))
         srcSpanLines span = [ GHC.srcSpanStartLine span .. 
                               GHC.srcSpanEndLine span ]
 
-lookupModule :: Session -> String -> GHCi Module
-lookupModule session modName
-   = io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
+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 ()