X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=91ce0f444f60af516a6027a45f02b6ef5c9b33f5;hb=90b9566607ef837329434657c8fabc4bdffdf1af;hp=573aaa01cc49fb4a75746534d2f81e0b7d80133a;hpb=d0a4736028a4834f6ce643a0629c7b5f1f451d34;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 573aaa0..26c4a88 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -6,29 +6,35 @@
 -- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------
-module InteractiveUI ( 
-	interactiveUI,
-	ghciWelcomeMsg
-   ) where
+
+module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
 
 #include "HsVersions.h"
 
-import GhciMonad
+import qualified GhciMonad
+import GhciMonad hiding (runStmt)
+import GhciTags
+import Debugger
 
 -- The GHC interface
-import qualified GHC
+import qualified GHC hiding (resume, runStmt)
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
-                          Type, Module, ModuleName, TyThing(..), Phase )
+                          Module, ModuleName, TyThing(..), Phase,
+                          BreakIndex, SrcSpan, Resume, SingleStep )
+import PprTyThing
 import DynFlags
+
 import Packages
+#ifdef USE_EDITLINE
 import PackageConfig
 import UniqFM
-import PprTyThing
-import Outputable
+#endif
 
--- for createtags
+import HscTypes		( implicitTyThings )
+import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
+import Outputable       hiding (printForUser, printForUserPartWay)
+import Module           -- for ModuleEnv
 import Name
-import OccName
 import SrcLoc
 
 -- Other random utilities
@@ -39,34 +45,21 @@ import Config
 import StaticFlags
 import Linker
 import Util
-
--- The debugger
-import Breakpoints
-import Debugger hiding  ( addModule )
-import HscTypes
-import Id
-import Var       ( globaliseId )
-import IdInfo
-import NameEnv
-import RdrName
-import Module
-import Type
-import TcType
+import NameSet
+import Maybes		( orElse )
+import FastString
+import Encoding
 
 #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 )
 import qualified System.Win32
 #endif
 
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
 import Control.Concurrent	( yield )	-- Used in readline loop
-import System.Console.Readline as Readline
+import System.Console.Editline.Readline as Readline
 #endif
 
 --import SystemExts
@@ -74,10 +67,10 @@ import System.Console.Readline as Readline
 import Control.Exception as Exception
 -- import Control.Concurrent
 
-import Numeric
+import System.FilePath
+import qualified Data.ByteString.Char8 as BS
 import Data.List
-import Data.Int		( Int64 )
-import Data.Maybe	( isJust, isNothing, fromMaybe, catMaybes )
+import Data.Maybe
 import System.Cmd
 import System.Environment
 import System.Exit	( exitWith, ExitCode(..) )
@@ -86,153 +79,215 @@ import System.IO
 import System.IO.Error as IO
 import Data.Char
 import Data.Dynamic
+import Data.Array
 import Control.Monad as Monad
-import Foreign.StablePtr	( newStablePtr )
-
+import Text.Printf
+import Foreign
+import Foreign.C
 import GHC.Exts		( unsafeCoerce# )
 import GHC.IOBase	( IOErrorType(InvalidArgument) )
+import GHC.TopHandler
 
-import Data.IORef	( IORef, newIORef, readIORef, writeIORef )
+import Data.IORef	( IORef, readIORef, writeIORef )
 
+#ifdef USE_EDITLINE
 import System.Posix.Internals ( setNonBlockingFD )
+#endif
 
 -----------------------------------------------------------------------------
 
-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 :: Command -> String
 cmdName (n,_,_,_) = n
 
-GLOBAL_VAR(commands, builtin_commands, [Command])
+GLOBAL_VAR(macros_ref, [], [Command])
 
 builtin_commands :: [Command]
 builtin_commands = [
-  ("add",	tlC$ keepGoingPaths addModule,	False, completeFilename),
-  ("browse",    keepGoing browseCmd,		False, completeModule),
-#ifdef DEBUGGER
-        -- I think that :c should mean :continue rather than :cd, makes more sense
-        --  (pepe 01.11.07)
-  ("continue",  const(bkptOptions "continue"),  False, completeNone),
-#endif
-  ("cd",    	tlC$ keepGoing changeDirectory,	False, completeFilename),
-  ("def",	keepGoing defineMacro,		False, completeIdentifier),
-  ("e", 	keepGoing editFile,		False, completeFilename),
 	-- Hugs users are accustomed to :e, so make sure it doesn't overlap
-  ("edit",	keepGoing editFile,		False, completeFilename),
-  ("help",	keepGoing help,			False, completeNone),
-  ("?",		keepGoing help,			False, completeNone),
-  ("info",      keepGoing info,			False, completeIdentifier),
-  ("load",	tlC$ keepGoingPaths loadModule_,False, completeHomeModuleOrFile),
-  ("module",	keepGoing setContext,		False, completeModule),
-  ("main",	tlC$ keepGoing runMain,		False, completeIdentifier),
-  ("reload", 	tlC$ keepGoing reloadModule,  	False, completeNone),
-  ("check",	keepGoing checkModule,		False, completeHomeModule),
-  ("set",	keepGoing setCmd,		True,  completeSetOptions),
-  ("show",	keepGoing showCmd,		False, completeNone),
-  ("etags",	keepGoing createETagsFileCmd,	False, completeFilename),
-  ("ctags",	keepGoing createCTagsFileCmd, 	False, completeFilename),
-  ("type",	keepGoing typeOfExpr,		False, completeIdentifier),
-#if defined(DEBUGGER)
-  ("print",     keepGoing (pprintClosureCommand True False), False, completeIdentifier),
-  ("sprint",    keepGoing (pprintClosureCommand False False),False, completeIdentifier),
-  ("force",     keepGoing (pprintClosureCommand False True), False, completeIdentifier),
-  ("breakpoint",bkptOptions,                    False, completeBkpt),
-#endif
-  ("kind",	keepGoing kindOfType,		False, completeIdentifier),
-  ("unset",	keepGoing unsetOptions,		True,  completeSetOptions),
-  ("undef",     keepGoing undefineMacro,	False, completeMacro),
-  ("quit",	quit,				False, completeNone)
+  ("?",		keepGoing help,			Nothing, completeNone),
+  ("add",	keepGoingPaths addModule,	Just filenameWordBreakChars, completeFilename),
+  ("abandon",   keepGoing abandonCmd,           Nothing, completeNone),
+  ("break",     keepGoing breakCmd,             Nothing, completeIdentifier),
+  ("back",      keepGoing backCmd,              Nothing, completeNone),
+  ("browse",    keepGoing (browseCmd False),	Nothing, completeModule),
+  ("browse!",   keepGoing (browseCmd True),	Nothing, completeModule),
+  ("cd",    	keepGoing changeDirectory,	Just filenameWordBreakChars, completeFilename),
+  ("check",	keepGoing checkModule,		Nothing, completeHomeModule),
+  ("continue",  keepGoing continueCmd,          Nothing, completeNone),
+  ("cmd",       keepGoing cmdCmd,               Nothing, completeIdentifier),
+  ("ctags",	keepGoing createCTagsFileCmd, 	Just filenameWordBreakChars, completeFilename),
+  ("def",	keepGoing (defineMacro False),  Nothing, completeIdentifier),
+  ("def!",	keepGoing (defineMacro True),   Nothing, completeIdentifier),
+  ("delete",    keepGoing deleteCmd,            Nothing, completeNone),
+  ("e", 	keepGoing editFile,		Just filenameWordBreakChars, completeFilename),
+  ("edit",	keepGoing editFile,		Just filenameWordBreakChars, completeFilename),
+  ("etags",	keepGoing createETagsFileCmd,	Just filenameWordBreakChars, completeFilename),
+  ("force",     keepGoing forceCmd,             Nothing, completeIdentifier),
+  ("forward",   keepGoing forwardCmd,           Nothing, completeNone),
+  ("help",	keepGoing help,			Nothing, completeNone),
+  ("history",   keepGoing historyCmd,           Nothing, completeNone), 
+  ("info",      keepGoing info,			Nothing, completeIdentifier),
+  ("kind",	keepGoing kindOfType,		Nothing, completeIdentifier),
+  ("load",	keepGoingPaths loadModule_,     Just filenameWordBreakChars, completeHomeModuleOrFile),
+  ("list",	keepGoing listCmd,              Nothing, completeNone),
+  ("module",	keepGoing setContext,		Nothing, completeModule),
+  ("main",	keepGoing runMain,		Nothing, completeIdentifier),
+  ("print",     keepGoing printCmd,             Nothing, completeIdentifier),
+  ("quit",	quit,				Nothing, completeNone),
+  ("reload", 	keepGoing reloadModule,  	Nothing, completeNone),
+  ("run",	keepGoing runRun,		Nothing, completeIdentifier),
+  ("set",	keepGoing setCmd,		Just flagWordBreakChars, completeSetOptions),
+  ("show",	keepGoing showCmd,		Nothing, completeNone),
+  ("sprint",    keepGoing sprintCmd,            Nothing, completeIdentifier),
+  ("step",      keepGoing stepCmd,              Nothing, completeIdentifier), 
+  ("steplocal", keepGoing stepLocalCmd,         Nothing, completeIdentifier), 
+  ("stepmodule",keepGoing stepModuleCmd,        Nothing, completeIdentifier), 
+  ("type",	keepGoing typeOfExpr,		Nothing, completeIdentifier),
+  ("trace",     keepGoing traceCmd,             Nothing, completeIdentifier), 
+  ("undef",     keepGoing undefineMacro,	Nothing, completeMacro),
+  ("unset",	keepGoing unsetOptions,		Just flagWordBreakChars,  completeSetOptions)
   ]
 
+
+-- We initialize readline (in the interactiveUI function) to use 
+-- word_break_chars as the default set of completion word break characters.
+-- This can be overridden for a particular command (for example, filename
+-- expansion shouldn't consider '/' to be a word break) by setting the third
+-- entry in the Command tuple above.
+-- 
+-- NOTE: in order for us to override the default correctly, any custom entry
+-- must be a SUBSET of word_break_chars.
+#ifdef USE_EDITLINE
+word_break_chars :: String
+word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~"
+                       specials = "(),;[]`{}"
+                       spaces = " \t\n"
+                   in spaces ++ specials ++ symbols
+#endif
+
+flagWordBreakChars, filenameWordBreakChars :: String
+flagWordBreakChars = " \t\n"
+filenameWordBreakChars = " \t\n\\`@$><=;|&{(" -- bash defaults
+
+
 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
 keepGoing a str = a str >> return False
 
--- tlC: Top Level Command, not allowed in inferior sessions
-tlC ::  (String -> GHCi Bool) -> (String -> GHCi Bool)
-tlC a str = do 
-    top_level <- isTopLevel
-    if not top_level
-       then throwDyn (CmdLineError "Command only allowed at Top Level")
-       else a str
-
 keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
-keepGoingPaths a str = a (toArgs str) >> return False
+keepGoingPaths a str
+ = do case toArgs str of
+          Left err -> io (hPutStrLn stderr err)
+          Right args -> a args
+      return False
 
+shortHelpText :: String
 shortHelpText = "use :? for help.\n"
 
--- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
+helpText :: String
 helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
- "   <stmt>                      evaluate/run <stmt>\n" ++
+ "   <statement>                 evaluate/run <statement>\n" ++
+ "   :                           repeat last command\n" ++
+ "   :{\\n ..lines.. \\n:}\\n       multiline command\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
- "   :breakpoint <option>        commands for the GHCi debugger\n" ++
- "   :browse [*]<module>         display the names defined by <module>\n" ++
+ "   :browse[!] [[*]<mod>]       display the names defined by module <mod>\n" ++
+ "                               (!: more details; *: all top-level names)\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
- "   :continue                   equivalent to ':breakpoint continue'\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" ++
  "   :edit                       edit last module\n" ++
+ "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
- "   :print [<name> ...]         prints a value without forcing its computation\n" ++
- "   :sprint [<name> ...]        simplified version of :print\n" ++
+ "   :kind <type>                show the kind of <type>\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++
- "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
+ "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
+ "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
+ "   :run function [<arguments> ...] run the function with the given arguments\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>]              after :trace, show the execution history\n" ++
+ "   :list                       show the source code around current breakpoint\n" ++
+ "   :list identifier            show the source code for <identifier>\n" ++
+ "   :list [<module>] <line>     show the source code around line number <line>\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 within the current top-level binding\n"++
+ "   :stepmodule                 single-step restricted to the current module\n"++
+ "   :trace                      trace after stopping at a breakpoint\n"++
+ "   :trace <expr>               evaluate <expr> with tracing on (see :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" ++
  "   :set prog <progname>        set the value returned by System.getProgName\n" ++
  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
  "   :set editor <cmd>           set the command used for :edit\n" ++
- "\n" ++
- "   :show modules               show the currently loaded modules\n" ++
- "   :show bindings              show the current bindings made at the prompt\n" ++
- "\n" ++
- "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
- "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
- "   :type <expr>                show the type of <expr>\n" ++
- "   :kind <type>                show the kind of <type>\n" ++
- "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
+ "   :set stop <cmd>             set the command to run when a breakpoint is hit\n" ++
  "   :unset <option> ...         unset options\n" ++
- "   :quit                       exit GHCi\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" ++
+ "                    for GHCi-specific flags, see User's Guide,\n"++
+ "                    Flag reference, Interactive-mode options\n" ++
+ "\n" ++
+ " -- Commands for displaying information:\n" ++
  "\n" ++
- " Options for ':breakpoint':\n" ++
- "   list                                     list the current breakpoints\n" ++
- "   add Module line [col]                    add a new breakpoint\n" ++
- "   del (breakpoint# | Module line [col])    delete a breakpoint\n" ++
- "   continue                                 continue execution\n"  ++
- "   stop                   Stop a computation and return to the top level\n" ++
- "   step [count]           Step by step execution (DISABLED)\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 packages              show the currently active package flags\n" ++
+ "   :show languages             show the currently active language flags\n" ++
+ "   :show <setting>             show value of <setting>, which is one of\n" ++
+ "                                  [args, prog, prompt, editor, stop]\n" ++
+ "\n" 
 
+findEditor :: IO String
 findEditor = do
   getEnv "EDITOR" 
     `IO.catch` \_ -> do
 #if mingw32_HOST_OS
-	win <- System.Win32.getWindowsDirectory
-	return (win `joinFileName` "notepad.exe")
+        win <- System.Win32.getWindowsDirectory
+        return (win </> "notepad.exe")
 #else
-	return ""
+        return ""
 #endif
 
-interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
-interactiveUI session srcs maybe_expr = do
+interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe [String]
+              -> IO ()
+interactiveUI session srcs maybe_exprs = do
    -- HACK! If we happen to get into an infinite loop (eg the user
    -- types 'let x=x in x' at the prompt), then the thread will block
    -- on a blackhole, and become unreachable during GC.  The GC will
@@ -245,103 +300,129 @@ 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
-   prel_mod <- GHC.findModule session prel_name Nothing
-   GHC.setContext session [] [prel_mod]
-
-#ifdef USE_READLINE
-   Readline.initialize
-   Readline.setAttemptedCompletionFunction (Just completeWord)
-   --Readline.parseAndBind "set show-all-if-ambiguous 1"
-
-   let symbols = "!#$%&*+/<=>?@\\^|-~"
-       specials = "(),;[]`{}"
-       spaces = " \t\n"
-       word_break_chars = spaces ++ specials ++ symbols
-
-   Readline.setBasicWordBreakCharacters word_break_chars
-   Readline.setCompleterWordBreakCharacters word_break_chars
+   when (isNothing maybe_exprs) $ 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
+
+#ifdef USE_EDITLINE
+        is_tty <- hIsTerminalDevice stdin
+        when is_tty $ do
+            Readline.initialize
+
+            withGhcAppData
+                 (\dir -> Readline.readHistory (dir </> "ghci_history"))
+                 (return True)
+            
+            Readline.setAttemptedCompletionFunction (Just completeWord)
+            --Readline.parseAndBind "set show-all-if-ambiguous 1"
+
+            Readline.setBasicWordBreakCharacters word_break_chars
+            Readline.setCompleterWordBreakCharacters word_break_chars
+            Readline.setCompletionAppendCharacter Nothing
 #endif
 
-   bkptTable <- newIORef emptyBkptTable
-   GHC.setBreakpointHandler session (instrumentationBkptHandler bkptTable)
+   -- initial context is just the Prelude
+   prel_mod <- GHC.findModule session (GHC.mkModuleName "Prelude") 
+                                      (Just basePackageId)
+   GHC.setContext session [] [prel_mod]
+
    default_editor <- findEditor
 
-   startGHCi (runGHCi srcs maybe_expr)
-	GHCiState{ progname = "<interactive>",
-		   args = [],
+   cwd <- getCurrentDirectory
+
+   startGHCi (runGHCi srcs maybe_exprs)
+        GHCiState{ progname = "<interactive>",
+                   args = [],
                    prompt = "%s> ",
-		   editor = default_editor,
-		   session = session,
-		   options = [],
+                   stop = "",
+                   editor = default_editor,
+                   session = session,
+                   options = [],
                    prelude = prel_mod,
-                   bkptTable = bkptTable,
-		   topLevel  = True
+                   break_ctr = 0,
+                   breaks = [],
+                   tickarrays = emptyModuleEnv,
+                   last_command = Nothing,
+                   cmdqueue = [],
+                   remembered_ctx = [],
+                   virtual_path   = cwd,
+                   ghc_e = isJust maybe_exprs
                  }
 
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
+   Readline.stifleHistory 100
+   withGhcAppData (\dir -> Readline.writeHistory (dir </> "ghci_history"))
+                  (return True)
    Readline.resetTerminal Nothing
 #endif
 
    return ()
 
-prel_name = GHC.mkModuleName "Prelude"
+withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a
+withGhcAppData right left = do
+   either_dir <- IO.try (getAppUserDataDirectory "ghc")
+   case either_dir of
+      Right dir -> right dir
+      _ -> left
 
-runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi ()
-runGHCi paths maybe_expr = do
-  let read_dot_files = not opt_IgnoreDotGhci
 
-  when (read_dot_files) $ do
-    -- Read in ./.ghci.
-    let file = "./.ghci"
-    exists <- io (doesFileExist file)
-    when exists $ do
-       dir_ok  <- io (checkPerms ".")
-       file_ok <- io (checkPerms file)
+runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
+runGHCi paths maybe_exprs = do
+  let 
+   read_dot_files = not opt_IgnoreDotGhci
+
+   current_dir = return (Just ".ghci")
+
+   app_user_dir = io $ withGhcAppData 
+                    (\dir -> return (Just (dir </> "ghci.conf")))
+                    (return Nothing)
+
+   home_dir = do
+    either_dir <- io $ IO.try (getEnv "HOME")
+    case either_dir of
+      Right home -> return (Just (home </> ".ghci"))
+      _ -> return Nothing
+
+   sourceConfigFile :: FilePath -> GHCi ()
+   sourceConfigFile file = do
+     exists <- io $ doesFileExist file
+     when exists $ do
+       dir_ok  <- io $ checkPerms (getDirectory file)
+       file_ok <- io $ checkPerms file
        when (dir_ok && file_ok) $ do
-  	  either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
-  	  case either_hdl of
-  	     Left e    -> return ()
-  	     Right hdl -> fileLoop hdl False
-    
+         either_hdl <- io $ IO.try (openFile file ReadMode)
+         case either_hdl of
+           Left _e   -> return ()
+           Right hdl -> runCommands (fileLoop hdl False False)
+     where
+      getDirectory f = case takeDirectory f of "" -> "."; d -> d
+
   when (read_dot_files) $ do
-    -- Read in $HOME/.ghci
-    either_dir <- io (IO.try (getEnv "HOME"))
-    case either_dir of
-       Left e -> return ()
-       Right dir -> do
-  	  cwd <- io (getCurrentDirectory)
-  	  when (dir /= cwd) $ do
-  	     let file = dir ++ "/.ghci"
-  	     ok <- io (checkPerms file)
-  	     when ok $ do
-  	       either_hdl <- io (IO.try (openFile file ReadMode))
-  	       case either_hdl of
-  		  Left e    -> return ()
-  		  Right hdl -> fileLoop hdl False
+    cfgs0 <- sequence [ current_dir, app_user_dir, home_dir ]
+    cfgs <- io $ mapM canonicalizePath (catMaybes cfgs0)
+    mapM_ sourceConfigFile (nub cfgs)
+        -- nub, because we don't want to read .ghci twice if the
+        -- CWD is $HOME.
 
   -- Perform a :load for files given on the GHCi command line
   -- When in -e mode, if the load fails then we want to stop
   -- immediately rather than going on to evaluate the expression.
   when (not (null paths)) $ do
-     ok <- ghciHandle (\e -> do showException e; return Failed) $ 
-		loadModule paths
-     when (isJust maybe_expr && failed ok) $
-	io (exitWith (ExitFailure 1))
+     ok <- ghciHandle (\e -> do showException e; return Failed) $
+                loadModule paths
+     when (isJust maybe_exprs && failed ok) $
+        io (exitWith (ExitFailure 1))
 
   -- if verbosity is greater than 0, or we are connected to a
   -- terminal, display the prompt in the interactive loop.
@@ -349,34 +430,38 @@ runGHCi paths maybe_expr = do
   dflags <- getDynFlags
   let show_prompt = verbosity dflags > 0 || is_tty
 
-  case maybe_expr of
-	Nothing -> 
+  case maybe_exprs of
+        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
-
-	    -- 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 exprs -> do
+            -- just evaluate the expression we were given
+            enqueueCommands exprs
+            let handle e = do st <- getGHCiState
+                                   -- Jump through some hoops to get the
+                                   -- current progname in the exception text:
+                                   -- <progname>: <exception>
+                              io $ withProgName (progname st)
+                                   -- this used to be topHandlerFastExit, see #2228
+                                 $ topHandler e
+            runCommands' handle (return Nothing)
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
-
+interactiveLoop :: Bool -> Bool -> GHCi ()
 interactiveLoop is_tty show_prompt =
   -- Ignore ^C exceptions caught here
   ghciHandleDyn (\e -> case e of 
@@ -391,12 +476,12 @@ interactiveLoop is_tty show_prompt =
 		   -- exception handler above.
 
   -- read commands from stdin
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
   if (is_tty) 
-	then readlineLoop
-	else fileLoop stdin show_prompt
+	then runCommands readlineLoop
+	else runCommands (fileLoop stdin show_prompt is_tty)
 #else
-  fileLoop stdin show_prompt
+  runCommands (fileLoop stdin show_prompt is_tty)
 #endif
 
 
@@ -410,10 +495,11 @@ interactiveLoop is_tty show_prompt =
 -- the same directory while a process is running.
 
 checkPerms :: String -> IO Bool
-checkPerms name =
 #ifdef mingw32_HOST_OS
+checkPerms _ =
   return True
 #else
+checkPerms name =
   Util.handle (\_ -> return False) $ do
      st <- getFileStatus name
      me <- getRealUserID
@@ -431,154 +517,326 @@ checkPerms name =
    	  else return True
 #endif
 
-fileLoop :: Handle -> Bool -> GHCi ()
-fileLoop hdl show_prompt = do
-   session <- getSession
-   (mod,imports) <- io (GHC.getContext session)
-   st <- getGHCiState
-   when show_prompt (io (putStr (mkPrompt mod imports (prompt st))))
+fileLoop :: Handle -> Bool -> Bool -> GHCi (Maybe String)
+fileLoop hdl show_prompt is_tty = do
+   when show_prompt $ do
+        prompt <- mkPrompt
+        (io (putStr prompt))
    l <- io (IO.try (hGetLine hdl))
    case l of
-	Left e | isEOFError e		   -> return ()
-	       | InvalidArgument <- etype  -> return ()
-	       | otherwise		   -> io (ioError e)
-		where etype = ioeGetErrorType e
-		-- treat InvalidArgument in the same way as EOF:
-		-- this can happen if the user closed stdin, or
-		-- perhaps did getContents which closes stdin at
-		-- EOF.
-	Right l -> 
-	  case removeSpaces l of
-            "" -> fileLoop hdl show_prompt
-	    l  -> do quit <- runCommand 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 toplevs exports prompt
-  = showSDoc $ f prompt
-    where
-        f ('%':'s':xs) = perc_s <> f xs
+        Left e | isEOFError e              -> return Nothing
+               | InvalidArgument <- etype  -> return Nothing
+               | otherwise                 -> io (ioError e)
+                where etype = ioeGetErrorType e
+                -- treat InvalidArgument in the same way as EOF:
+                -- this can happen if the user closed stdin, or
+                -- perhaps did getContents which closes stdin at
+                -- EOF.
+        Right l -> do
+                   str <- io $ consoleInputToUnicode is_tty l
+                   return (Just str)
+
+#ifdef mingw32_HOST_OS
+-- Convert the console input into Unicode according to the current code page.
+-- The Windows console stores Unicode characters directly, so this is a
+-- rather roundabout way of doing things... oh well.
+-- See #782, #1483, #1649
+consoleInputToUnicode :: Bool -> String -> IO String
+consoleInputToUnicode is_tty str
+  | is_tty = do
+    cp <- System.Win32.getConsoleCP
+    System.Win32.stringToUnicode cp str
+  | otherwise =
+    decodeStringAsUTF8 str
+#else
+-- for Unix, assume the input is in UTF-8 and decode it to a Unicode String. 
+-- See #782.
+consoleInputToUnicode :: Bool -> String -> IO String
+consoleInputToUnicode _is_tty str = decodeStringAsUTF8 str
+#endif
+
+decodeStringAsUTF8 :: String -> IO String
+decodeStringAsUTF8 str =
+  withCStringLen str $ \(cstr,len) -> 
+    utf8DecodeString (castPtr cstr :: Ptr Word8) len
+
+mkPrompt :: GHCi String
+mkPrompt = do
+  session <- getSession
+  (toplevs,exports) <- io (GHC.getContext session)
+  resumes <- io $ GHC.getResumeContext session
+  -- st <- getGHCiState
+
+  context_bit <-
+        case resumes of
+            [] -> return empty
+            r:_ -> do
+                let ix = GHC.resumeHistoryIx r
+                if ix == 0
+                   then return (brackets (ppr (GHC.resumeSpan r)) <> space)
+                   else do
+                        let hist = GHC.resumeHistory r !! (ix-1)
+                        span <- io$ GHC.getHistorySpan session hist
+                        return (brackets (ppr (negate ix) <> char ':' 
+                                          <+> ppr span) <> space)
+  let
+        dots | _:rs <- resumes, not (null rs) = text "... "
+             | otherwise = empty
+
+        
+
+        modules_bit = 
+       -- ToDo: maybe...
+       --  let (btoplevs, bexports) = fromMaybe ([],[]) (remembered_ctx st) in
+       --  hsep (map (\m -> text "!*" <> ppr (GHC.moduleName m)) btoplevs) <+>
+       --  hsep (map (\m -> char '!'  <> ppr (GHC.moduleName m)) bexports) <+>
+             hsep (map (\m -> char '*'  <> ppr (GHC.moduleName m)) toplevs) <+>
+             hsep (map (ppr . GHC.moduleName) exports)
+
+        deflt_prompt = dots <> context_bit <> modules_bit
+
+        f ('%':'s':xs) = deflt_prompt <> f xs
         f ('%':'%':xs) = char '%' <> f xs
         f (x:xs) = char x <> f xs
         f [] = empty
-    
-        perc_s = hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
-                 hsep (map (ppr . GHC.moduleName) exports)
-             
+   --
+  st <- getGHCiState
+  return (showSDoc (f (prompt st)))
 
-#ifdef USE_READLINE
-readlineLoop :: GHCi ()
+
+#ifdef USE_EDITLINE
+readlineLoop :: GHCi (Maybe String)
 readlineLoop = do
-   session <- getSession
-   (mod,imports) <- io (GHC.getContext session)
    io yield
    saveSession -- for use by completion
-   st <- getGHCiState
-   l <- io (readline (mkPrompt mod imports (prompt st))
-	  	`finally` setNonBlockingFD 0)
-		-- readline sometimes puts stdin into blocking mode,
-		-- so we need to put it back for the IO library
+   prompt <- mkPrompt
+   l <- io (readline prompt `finally` setNonBlockingFD 0)
+                -- readline sometimes puts stdin into blocking mode,
+                -- so we need to put it back for the IO library
    splatSavedSession
    case l of
-	Nothing -> return ()
-	Just l  ->
-	  case removeSpaces l of
-	    "" -> readlineLoop
-	    l  -> do
-        	  io (addHistory l)
-  	  	  quit <- runCommand l
-          	  if quit then return () else readlineLoop
+        Nothing -> return Nothing
+        Just "" -> return (Just "") -- Don't put empty lines in the history
+        Just l  -> do
+                   io (addHistory l)
+                   str <- io $ consoleInputToUnicode True l
+                   return (Just str)
 #endif
 
-runCommand :: String -> GHCi Bool
-runCommand c = ghciHandle handler (doCommand c)
-  where 
-    doCommand (':' : command) = specialCommand command
-    doCommand stmt
-       = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
-            return False
-
--- This version is for the GHC command-line option -e.  The only difference
--- from runCommand is that it catches the ExitException exception and
--- exits, rather than printing out the exception.
-runCommandEval c = ghciHandle handleEval (doCommand c)
-  where 
-    handleEval (ExitException code) = io (exitWith code)
-    handleEval e                    = do handler e
-				         io (exitWith (ExitFailure 1))
-
-    doCommand (':' : command) = specialCommand command
-    doCommand stmt
-       = do nms <- runStmt stmt
-	    case nms of 
-		Nothing -> io (exitWith (ExitFailure 1))
-		  -- failure to run the command causes exit(1) for ghc -e.
-		_       -> finishEvalExpr nms
-
-runStmt :: String -> GHCi (Maybe [Name])
-runStmt stmt
- | null (filter (not.isSpace) stmt) = return (Just [])
+queryQueue :: GHCi (Maybe String)
+queryQueue = do
+  st <- getGHCiState
+  case cmdqueue st of
+    []   -> return Nothing
+    c:cs -> do setGHCiState st{ cmdqueue = cs }
+               return (Just c)
+
+runCommands :: GHCi (Maybe String) -> GHCi ()
+runCommands = runCommands' handler
+
+runCommands' :: (Exception -> GHCi Bool) -- Exception handler
+             -> GHCi (Maybe String) -> GHCi ()
+runCommands' eh getCmd = do
+  mb_cmd <- noSpace queryQueue
+  mb_cmd <- maybe (noSpace getCmd) (return . Just) mb_cmd
+  case mb_cmd of 
+    Nothing -> return ()
+    Just c  -> do
+      b <- ghciHandle eh (doCommand c)
+      if b then return () else runCommands' eh getCmd
+  where
+    noSpace q = q >>= maybe (return Nothing)
+                            (\c->case removeSpaces c of 
+                                   ""   -> noSpace q
+                                   ":{" -> multiLineCmd q
+                                   c    -> return (Just c) )
+    multiLineCmd q = do
+      st <- getGHCiState
+      let p = prompt st
+      setGHCiState st{ prompt = "%s| " }
+      mb_cmd <- collectCommand q ""
+      getGHCiState >>= \st->setGHCiState st{ prompt = p }
+      return mb_cmd
+    -- we can't use removeSpaces for the sublines here, so 
+    -- multiline commands are somewhat more brittle against
+    -- fileformat errors (such as \r in dos input on unix), 
+    -- we get rid of any extra spaces for the ":}" test; 
+    -- we also avoid silent failure if ":}" is not found;
+    -- and since there is no (?) valid occurrence of \r (as 
+    -- opposed to its String representation, "\r") inside a
+    -- ghci command, we replace any such with ' ' (argh:-(
+    collectCommand q c = q >>= 
+      maybe (io (ioError collectError))
+            (\l->if removeSpaces l == ":}" 
+                 then return (Just $ removeSpaces c) 
+                 else collectCommand q (c++map normSpace l))
+      where normSpace '\r' = ' '
+            normSpace   c  = c
+    -- QUESTION: is userError the one to use here?
+    collectError = userError "unterminated multiline command :{ .. :}"
+    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 }
+
+
+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
-      case result of
-	GHC.RunFailed      -> return Nothing
-	GHC.RunException e -> throw e  -- this is caught by runCommand(Eval)
-	GHC.RunOk names    -> return (Just names)
-
--- possibly print the type and revert CAFs after evaluating an expression
-finishEvalExpr mb_names
- = do b <- isOptionSet ShowType
-      session <- getSession
-      case mb_names of
-	Nothing    -> return ()      
-	Just names -> when b (mapM_ (showTypeOfName session) names)
-
-      flushInterpBuffers
-      io installSignalHandlers
-      b <- isOptionSet RevertCAFs
-      io (when b revertCAFs)
-      return True
-
-showTypeOfName :: Session -> Name -> GHCi ()
-showTypeOfName session n
+ = do result <- GhciMonad.runStmt stmt step
+      afterRunStmt (const True) result
+
+--afterRunStmt :: GHC.RunResult -> GHCi Bool
+                                 -- False <=> the statement failed to compile
+afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
+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
+               let namesSorted = sortBy compareNames names
+               tythings <- catMaybes `liftM` 
+                              io (mapM (GHC.lookupName session) namesSorted)
+               docs <- io$ pprTypeAndContents session [id | AnId id <- tythings]
+               printForUserPartWay docs
+               maybe (return ()) runBreakCmd mb_info
+               -- run the command set with ":set stop <cmd>"
+               st <- getGHCiState
+               enqueueCommands [stop st]
+               return ()
+         | otherwise -> resume GHC.SingleStep >>=
+                        afterRunStmt step_here >> return ()
+     _ -> return ()
+
+  flushInterpBuffers
+  io installSignalHandlers
+  b <- isOptionSet RevertCAFs
+  when b revertCAFs
+
+  return (case run_result of GHC.RunOk _ -> True; _ -> False)
+
+runBreakCmd :: GHC.BreakInfo -> GHCi ()
+runBreakCmd info = do
+  let mod = GHC.breakInfo_module info
+      nm  = GHC.breakInfo_number info
+  st <- getGHCiState
+  case  [ loc | (_,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
+
+
+data MaybeCommand = GotCommand Command | BadCommand | NoLastCommand
 
 specialCommand :: String -> GHCi Bool
 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
 specialCommand str = do
   let (cmd,rest) = break isSpace str
-  maybe_cmd <- io (lookupCommand cmd)
+  maybe_cmd <- lookupCommand cmd
   case maybe_cmd of
-    Nothing -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n" 
-		                    ++ shortHelpText) >> return False)
-    Just (_,f,_,_) -> f (dropWhile isSpace rest)
-
-lookupCommand :: String -> IO (Maybe Command)
+    GotCommand (_,f,_,_) -> f (dropWhile isSpace rest)
+    BadCommand ->
+      do io $ hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
+                           ++ shortHelpText)
+         return False
+    NoLastCommand ->
+      do io $ hPutStr stdout ("there is no last command to perform\n"
+                           ++ shortHelpText)
+         return False
+
+lookupCommand :: String -> GHCi (MaybeCommand)
+lookupCommand "" = do
+  st <- getGHCiState
+  case last_command st of
+      Just c -> return $ GotCommand c
+      Nothing -> return NoLastCommand
 lookupCommand str = do
-  cmds <- readIORef commands
+  mc <- io $ lookupCommand' str
+  st <- getGHCiState
+  setGHCiState st{ last_command = mc }
+  return $ case mc of
+           Just c -> GotCommand c
+           Nothing -> BadCommand
+
+lookupCommand' :: String -> IO (Maybe Command)
+lookupCommand' str = do
+  macros <- readIORef macros_ref
+  let cmds = builtin_commands ++ macros
   -- 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
-     		[] -> return Nothing
-     		c:_ -> return (Just c)
+  return $ case [ c | c <- cmds, str == cmdName c ] of
+           c:_ -> Just c
+           [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of
+                 [] -> Nothing
+                 c:_ -> Just c
+
+getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
+getCurrentBreakSpan = do
+  session <- getSession
+  resumes <- io $ GHC.getResumeContext session
+  case resumes of
+    [] -> return Nothing
+    (r:_) -> do
+        let ix = GHC.resumeHistoryIx r
+        if ix == 0
+           then return (Just (GHC.resumeSpan r))
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                span <- io $ GHC.getHistorySpan session hist
+                return (Just span)
+
+getCurrentBreakModule :: GHCi (Maybe Module)
+getCurrentBreakModule = do
+  session <- getSession
+  resumes <- io $ GHC.getResumeContext session
+  case resumes of
+    [] -> return Nothing
+    (r:_) -> 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
 
+noArgs :: GHCi () -> String -> GHCi ()
+noArgs m "" = m
+noArgs _ _  = io $ putStrLn "This command takes no arguments"
+
 help :: String -> GHCi ()
 help _ = io (putStr helpText)
 
@@ -587,30 +845,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
@@ -618,71 +876,116 @@ pprInfo exts (thing, fixity, insts)
 	| fix == GHC.defaultFixity = empty
 	| otherwise		   = ppr fix <+> ppr (GHC.getName thing)
 
------------------------------------------------------------------------------
--- Commands
-
 runMain :: String -> GHCi ()
-runMain args = do
-  let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))
-  runCommand $ '[': ss ++ "] `System.Environment.withArgs` main"
-  return ()
+runMain s = case toArgs s of
+            Left err   -> io (hPutStrLn stderr err)
+            Right args ->
+                do dflags <- getDynFlags
+                   case mainFunIs dflags of
+                       Nothing -> doWithArgs args "main"
+                       Just f  -> doWithArgs args f
+
+runRun :: String -> GHCi ()
+runRun s = case toCmdArgs s of
+           Left err          -> io (hPutStrLn stderr err)
+           Right (cmd, args) -> doWithArgs args cmd
+
+doWithArgs :: [String] -> String -> GHCi ()
+doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++
+                                       show args ++ " (" ++ cmd ++ ")"]
 
 addModule :: [FilePath] -> GHCi ()
 addModule files = do
-  io (revertCAFs)			-- always revert CAFs on load/add.
+  revertCAFs			-- always revert CAFs on load/add.
   files <- mapM expandPath files
   targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
   session <- getSession
   io (mapM_ (GHC.addTarget session) targets)
+  prev_context <- io $ GHC.getContext session
   ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
+  afterLoad ok session False prev_context
 
 changeDirectory :: String -> GHCi ()
+changeDirectory "" = do
+  -- :cd on its own changes to the user's home directory
+  either_dir <- io (IO.try getHomeDirectory)
+  case either_dir of
+     Left _e -> return ()
+     Right dir -> changeDirectory dir
 changeDirectory dir = do
   session <- getSession
   graph <- io (GHC.getModuleGraph session)
   when (not (null graph)) $
 	io $ putStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
+  prev_context <- io $ GHC.getContext session
   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)
-  setContextAfterLoad session []
+  setContextAfterLoad session prev_context False []
   io (GHC.workingDirectoryChanged session)
   dir <- expandPath dir
   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 ()
-
-defineMacro :: String -> GHCi ()
-defineMacro s = do
+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 :: Bool{-overwrite-} -> String -> GHCi ()
+defineMacro overwrite s = do
   let (macro_name, definition) = break isSpace s
-  cmds <- io (readIORef commands)
+  macros <- io (readIORef macros_ref)
+  let defined = map cmdName macros
   if (null macro_name) 
-	then throwDyn (CmdLineError "invalid macro name") 
+	then if null defined
+                then io $ putStrLn "no macros defined"
+                else io $ putStr ("the following macros are defined:\n" ++
+                                  unlines defined)
 	else do
-  if (macro_name `elem` map cmdName cmds)
+  if (not overwrite && macro_name `elem` defined)
 	then throwDyn (CmdLineError 
-		("command '" ++ macro_name ++ "' is already defined"))
+		("macro '" ++ macro_name ++ "' is already defined"))
 	else do
 
+  let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
+
   -- give the expression a type signature, so we can be sure we're getting
   -- something of the right type.
   let new_expr = '(' : definition ++ ") :: String -> IO String"
@@ -692,27 +995,36 @@ defineMacro s = do
   maybe_hv <- io (GHC.compileExpr cms new_expr)
   case maybe_hv of
      Nothing -> return ()
-     Just hv -> io (writeIORef commands --
-		    (cmds ++ [(macro_name, runMacro hv, False, completeNone)]))
+     Just hv -> io (writeIORef macros_ref --
+		    (filtered ++ [(macro_name, runMacro hv, Nothing, completeNone)]))
 
 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
-  cmds <- io (readIORef commands)
-  if (macro_name `elem` map cmdName builtin_commands) 
-	then throwDyn (CmdLineError
-		("command '" ++ macro_name ++ "' cannot be undefined"))
-	else do
-  if (macro_name `notElem` map cmdName cmds) 
-	then throwDyn (CmdLineError 
-		("command '" ++ macro_name ++ "' not defined"))
-	else do
-  io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
-
+undefineMacro str = mapM_ undef (words str) 
+ where undef macro_name = do
+        cmds <- io (readIORef macros_ref)
+        if (macro_name `notElem` map cmdName cmds) 
+      	   then throwDyn (CmdLineError 
+      		("macro '" ++ macro_name ++ "' is not defined"))
+      	   else do
+            io (writeIORef macros_ref (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)
@@ -723,8 +1035,10 @@ loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return ()
 loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule' files = do
   session <- getSession
+  prev_context <- io $ GHC.getContext session
 
   -- unload first
+  discardActiveBreakPoints
   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)
 
@@ -740,15 +1054,14 @@ 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 False prev_context LoadAllTargets
 
 checkModule :: String -> GHCi ()
 checkModule m = do
   let modl = GHC.mkModuleName m
   session <- getSession
-  result <- io (GHC.checkModule session modl)
+  prev_context <- io $ GHC.getContext session
+  result <- io (GHC.checkModule session modl False)
   case result of
     Nothing -> io $ putStrLn "Nothing"
     Just r  -> io $ putStrLn (showSDoc (
@@ -760,35 +1073,43 @@ checkModule m = do
 			(text "global names: " <+> ppr global) $$
 		        (text "local  names: " <+> ppr local)
 	   _ -> empty))
-  afterLoad (successIf (isJust result)) session
+  afterLoad (successIf (isJust result)) session False prev_context
 
 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)))
-  afterLoad ok session
+  prev_context <- io $ GHC.getContext session
+  doLoad session True prev_context $ 
+        if null m then LoadAllTargets 
+                  else LoadUpTo (GHC.mkModuleName m)
+  return ()
 
-afterLoad ok session = do
-  io (revertCAFs)  -- always revert CAFs on load.
-  graph <- io (GHC.getModuleGraph session)
-  graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
-  setContextAfterLoad session graph'
-  do 
-     bt  <- getBkptTable
-     bt' <- io$ refreshBkptTable session bt graph'
-     setBkptTable bt'
-  modulesLoadedMsg ok (map GHC.ms_mod_name graph')
-
-setContextAfterLoad session [] = do
+doLoad :: Session -> Bool -> ([Module],[Module]) -> LoadHowMuch -> GHCi SuccessFlag
+doLoad session retain_context prev_context 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 retain_context prev_context
+  return ok
+
+afterLoad :: SuccessFlag -> Session -> Bool -> ([Module],[Module]) -> GHCi ()
+afterLoad ok session retain_context prev_context = do
+  revertCAFs  -- always revert CAFs on load.
+  discardTickArrays
+  loaded_mod_summaries <- getLoadedModules session
+  let loaded_mods = map GHC.ms_mod loaded_mod_summaries
+      loaded_mod_names = map GHC.moduleName loaded_mods
+  modulesLoadedMsg ok loaded_mod_names
+
+  setContextAfterLoad session prev_context retain_context loaded_mod_summaries
+
+
+setContextAfterLoad :: Session -> ([Module],[Module]) -> Bool -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad session prev keep_ctxt [] = do
   prel_mod <- getPrelude
-  io (GHC.setContext session [] [prel_mod])
-setContextAfterLoad session ms = do
+  setContextKeepingPackageModules session prev keep_ctxt ([], [prel_mod])
+setContextAfterLoad session prev keep_ctxt ms = do
   -- load a target if one is available, otherwise load the topmost module.
   targets <- io (GHC.getTargets session)
   case [ m | Just m <- map (findTarget ms) targets ] of
@@ -807,16 +1128,39 @@ setContextAfterLoad session ms = do
 	= GHC.ms_mod_name summary == m
    summary `matches` Target (TargetFile f _) _ 
 	| Just f' <- GHC.ml_hs_file (GHC.ms_location summary)	= f == f'
-   summary `matches` target
+   _ `matches` _
 	= False
 
    load_this summary | m <- GHC.ms_mod summary = do
 	b <- io (GHC.moduleIsInterpreted session m)
-	if b then io (GHC.setContext session [m] []) 
+	if b then setContextKeepingPackageModules session prev keep_ctxt ([m], [])
        	     else do
-                   prel_mod <- getPrelude
-                   io (GHC.setContext session []  [prel_mod,m])
-
+                prel_mod <- getPrelude
+                setContextKeepingPackageModules session prev keep_ctxt ([],[prel_mod,m])
+
+-- | Keep any package modules (except Prelude) when changing the context.
+setContextKeepingPackageModules
+        :: Session
+        -> ([Module],[Module])          -- previous context
+        -> Bool                         -- re-execute :module commands
+        -> ([Module],[Module])          -- new context
+        -> GHCi ()
+setContextKeepingPackageModules session prev_context keep_ctxt (as,bs) = do
+  let (_,bs0) = prev_context
+  prel_mod <- getPrelude
+  let pkg_modules = filter (\p -> not (isHomeModule p) && p /= prel_mod) bs0
+  let bs1 = if null as then nub (prel_mod : bs) else bs
+  io $ GHC.setContext session as (nub (bs1 ++ pkg_modules))
+  if keep_ctxt
+     then do
+          st <- getGHCiState
+          mapM_ (playCtxtCmd False) (remembered_ctx st)
+     else do
+          st <- getGHCiState
+          setGHCiState st{ remembered_ctx = [] }
+
+isHomeModule :: Module -> Bool
+isHomeModule mod = GHC.modulePackageId mod == mainPackageId
 
 modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> GHCi ()
 modulesLoadedMsg ok mods = do
@@ -839,9 +1183,10 @@ typeOfExpr str
        maybe_ty <- io (GHC.exprType cms str)
        case maybe_ty of
 	  Nothing -> return ()
-	  Just ty -> do ty' <- cleanType ty
-			tystr <- showForUser (ppr ty')
-		        io (putStrLn (str ++ " :: " ++ tystr))
+	  Just ty -> do dflags <- getDynFlags
+		        let pefas = dopt Opt_PrintExplicitForalls dflags
+                        printForUser $ text str <+> dcolon
+					<+> pprTypeForUser pefas ty
 
 kindOfType :: String -> GHCi ()
 kindOfType str 
@@ -849,240 +1194,187 @@ kindOfType str
        maybe_ty <- io (GHC.typeKind cms str)
        case maybe_ty of
 	  Nothing    -> return ()
-	  Just ty    -> do tystr <- showForUser (ppr ty)
-		           io (putStrLn (str ++ " :: " ++ tystr))
-
-quit :: String -> GHCi Bool
-quit _ =  do in_inferior_session <- liftM not isTopLevel 
-             if in_inferior_session 
-               then throwDyn StopParentSession
-               else return True
+	  Just ty    -> printForUser $ text str <+> dcolon <+> ppr ty
           
+quit :: String -> GHCi Bool
+quit _ = return True
 
 shellEscape :: String -> GHCi Bool
 shellEscape str = io (system str >> return False)
 
 -----------------------------------------------------------------------------
--- create tags file for currently loaded modules.
-
-createETagsFileCmd, createCTagsFileCmd :: String -> GHCi ()
-
-createCTagsFileCmd ""   = ghciCreateTagsFile CTags "tags"
-createCTagsFileCmd file = ghciCreateTagsFile CTags file
-
-createETagsFileCmd ""    = ghciCreateTagsFile ETags "TAGS"
-createETagsFileCmd file  = ghciCreateTagsFile ETags file
-
-data TagsKind = ETags | CTags
-
-ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
-ghciCreateTagsFile kind file = do
-  session <- getSession
-  io $ createTagsFile session kind file
-
--- ToDo: 
--- 	- remove restriction that all modules must be interpreted
---	  (problem: we don't know source locations for entities unless
---	  we compiled the module.
---
---	- extract createTagsFile so it can be used from the command-line
---	  (probably need to fix first problem before this is useful).
---
-createTagsFile :: Session -> TagsKind -> FilePath -> IO ()
-createTagsFile session tagskind tagFile = do
-  graph <- GHC.getModuleGraph session
-  let ms = map GHC.ms_mod graph
-      tagModule m = do 
-        is_interpreted <- GHC.moduleIsInterpreted session m
-        -- should we just skip these?
-        when (not is_interpreted) $
-          throwDyn (CmdLineError ("module '" 
-                                ++ GHC.moduleNameString (GHC.moduleName m)
-                                ++ "' is not interpreted"))
-        mbModInfo <- GHC.getModuleInfo session m
-        let unqual 
-	      | Just modinfo <- mbModInfo,
-		Just unqual <- GHC.modInfoPrintUnqualified modinfo = unqual
-	      | otherwise = GHC.alwaysQualify
-
-        case mbModInfo of 
-          Just modInfo -> return $! listTags unqual modInfo 
-          _            -> return []
-
-  mtags <- mapM tagModule ms
-  either_res <- collateAndWriteTags tagskind tagFile $ concat mtags
-  case either_res of
-    Left e  -> hPutStrLn stderr $ ioeGetErrorString e
-    Right _ -> return ()
-
-listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
-listTags unqual modInfo =
-	   [ tagInfo unqual name loc 
-           | name <- GHC.modInfoExports modInfo
-           , let loc = nameSrcLoc name
-           , isGoodSrcLoc loc
-           ]
-
-type TagInfo = (String -- tag name
-               ,String -- file name
-               ,Int    -- line number
-               ,Int    -- column number
-               )
-
--- get tag info, for later translation into Vim or Emacs style
-tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo
-tagInfo unqual name loc
-    = ( showSDocForUser unqual $ pprOccName (nameOccName name)
-      , showSDocForUser unqual $ ftext (srcLocFile loc)
-      , srcLocLine loc
-      , srcLocCol loc
-      )
-
-collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
-collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al
-  let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos
-  IO.try (writeFile file tags)
-collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
-  let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2
-      groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
-  tagGroups <- mapM tagFileGroup groups 
-  IO.try (writeFile file $ concat tagGroups)
-  where
-    tagFileGroup group@[] = throwDyn (CmdLineError "empty tag file group??")
-    tagFileGroup group@((_,fileName,_,_):_) = do
-      file <- readFile fileName -- need to get additional info from sources..
-      let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
-          sortedGroup = sortLe byLine group
-          tags = unlines $ perFile sortedGroup 1 0 $ lines file
-      return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
-    perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos (line:lines) | lNo>count =
-      perFile (tagInfo:tags) (count+1) (pos+length line) lines
-    perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count =
-      showETag tagInfo line pos : perFile tags count pos lines
-    perFile tags count pos lines = []
-
--- simple ctags format, for Vim et al
-showTag :: TagInfo -> String
-showTag (tag,file,lineNo,colNo)
-    =  tag ++ "\t" ++ file ++ "\t" ++ show lineNo
-
--- etags format, for Emacs/XEmacs
-showETag :: TagInfo -> String -> Int -> String
-showETag (tag,file,lineNo,colNo) line charPos
-    =  take colNo line ++ tag
-    ++ "\x7f" ++ tag
-    ++ "\x01" ++ show lineNo
-    ++ "," ++ show charPos
-
------------------------------------------------------------------------------
 -- Browsing a module's contents
 
-browseCmd :: String -> GHCi ()
-browseCmd m = 
+browseCmd :: Bool -> String -> GHCi ()
+browseCmd bang m = 
   case words m of
-    ['*':m] | looksLikeModuleName m -> browseModule m False
-    [m]     | looksLikeModuleName m -> browseModule m True
+    ['*':s] | looksLikeModuleName s -> do 
+        m <-  wantInterpretedModule s
+        browseModule bang m False
+    [s] | looksLikeModuleName s -> do
+        m <- lookupModule s
+        browseModule bang m True
+    [] -> do
+        s <- getSession
+        (as,bs) <- io $ GHC.getContext s
+                -- Guess which module the user wants to browse.  Pick
+                -- modules that are interpreted first.  The most
+                -- recently-added module occurs last, it seems.
+        case (as,bs) of
+          (as@(_:_), _)   -> browseModule bang (last as) True
+          ([],  bs@(_:_)) -> browseModule bang (last bs) True
+          ([],  [])  -> throwDyn (CmdLineError ":browse: no current module")
     _ -> throwDyn (CmdLineError "syntax:  :browse <module>")
 
-browseModule m exports_only = do
+-- without bang, show items in context of their parents and omit children
+-- with bang, show class methods and data constructors separately, and
+--            indicate import modules, to aid qualifying unqualified names
+-- with sorted, sort items alphabetically
+browseModule :: Bool -> Module -> Bool -> GHCi ()
+browseModule bang modl exports_only = do
   s <- getSession
-  modl <- io $ GHC.findModule s (GHC.mkModuleName m) Nothing
-  is_interpreted <- io (GHC.moduleIsInterpreted s modl)
-  when (not is_interpreted && not exports_only) $
-	throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted"))
-
+  -- :browse! reports qualifiers wrt current context
+  current_unqual <- io (GHC.getPrintUnqual s)
   -- Temporarily set the context to the module we're interested in,
   -- just so we can get an appropriate PrintUnqualified
   (as,bs) <- io (GHC.getContext s)
   prel_mod <- getPrelude
   io (if exports_only then GHC.setContext s [] [prel_mod,modl]
-		      else GHC.setContext s [modl] [])
-  unqual <- io (GHC.getPrintUnqual s)
+                      else GHC.setContext s [modl] [])
+  target_unqual <- io (GHC.getPrintUnqual s)
   io (GHC.setContext s as bs)
 
+  let unqual = if bang then current_unqual else target_unqual
+
   mb_mod_info <- io $ GHC.getModuleInfo s modl
   case mb_mod_info of
-    Nothing -> throwDyn (CmdLineError ("unknown module: " ++ m))
+    Nothing -> throwDyn (CmdLineError ("unknown module: " ++
+                                GHC.moduleNameString (GHC.moduleName modl)))
     Just mod_info -> do
-        let names
-	       | exports_only = GHC.modInfoExports mod_info
-	       | otherwise    = fromMaybe [] (GHC.modInfoTopLevelScope mod_info)
-
-	    filtered = filterOutChildren names
-	
-        things <- io $ mapM (GHC.lookupName s) filtered
-
         dflags <- getDynFlags
-	let exts = dopt Opt_GlasgowExts dflags
-	io (putStrLn (showSDocForUser unqual (
-		vcat (map (pprTyThingInContext exts) (catMaybes things))
-	   )))
-	-- ToDo: modInfoInstances currently throws an exception for
-	-- package modules.  When it works, we can do this:
-	--	$$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
+        let names
+               | exports_only = GHC.modInfoExports mod_info
+               | otherwise    = GHC.modInfoTopLevelScope mod_info
+                                `orElse` []
+
+                -- sort alphabetically name, but putting
+                -- locally-defined identifiers first.
+                -- We would like to improve this; see #1799.
+            sorted_names = loc_sort local ++ occ_sort external
+                where 
+                (local,external) = partition ((==modl) . nameModule) names
+                occ_sort = sortBy (compare `on` nameOccName) 
+                -- try to sort by src location.  If the first name in
+                -- our list has a good source location, then they all should.
+                loc_sort names
+                      | n:_ <- names, isGoodSrcSpan (nameSrcSpan n)
+                      = sortBy (compare `on` nameSrcSpan) names
+                      | otherwise
+                      = occ_sort names
+
+        mb_things <- io $ mapM (GHC.lookupName s) sorted_names
+        let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things)
+
+        rdr_env <- io $ GHC.getGRE s
+
+        let pefas              = dopt Opt_PrintExplicitForalls dflags
+            things | bang      = catMaybes mb_things
+                   | otherwise = filtered_things
+            pretty | bang      = pprTyThing
+                   | otherwise = pprTyThingInContext
+
+            labels  [] = text "-- not currently imported"
+            labels  l  = text $ intercalate "\n" $ map qualifier l
+            qualifier  = maybe "-- defined locally" 
+                             (("-- imported via "++) . intercalate ", " 
+                               . map GHC.moduleNameString)
+            importInfo = RdrName.getGRE_NameQualifier_maybes rdr_env
+            modNames   = map (importInfo . GHC.getName) things
+                                        
+            -- annotate groups of imports with their import modules
+            -- the default ordering is somewhat arbitrary, so we group 
+            -- by header and sort groups; the names themselves should
+            -- really come in order of source appearance.. (trac #1799)
+            annotate mts = concatMap (\(m,ts)->labels m:ts)
+                         $ sortBy cmpQualifiers $ group mts
+              where cmpQualifiers = 
+                      compare `on` (map (fmap (map moduleNameFS)) . fst)
+            group []            = []
+            group mts@((m,_):_) = (m,map snd g) : group ng
+              where (g,ng) = partition ((==m).fst) mts
+
+        let prettyThings = map (pretty pefas) things
+            prettyThings' | bang      = annotate $ zip modNames prettyThings
+                          | otherwise = prettyThings
+        io (putStrLn $ showSDocForUser unqual (vcat prettyThings'))
+        -- ToDo: modInfoInstances currently throws an exception for
+        -- package modules.  When it works, we can do this:
+        --        $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
 
 -----------------------------------------------------------------------------
 -- Setting the module context
 
+setContext :: String -> GHCi ()
 setContext str
-  | all sensible mods = fn mods
+  | all sensible strs = do
+       playCtxtCmd True (cmd, as, bs)
+       st <- getGHCiState
+       setGHCiState st{ remembered_ctx = remembered_ctx st ++ [(cmd,as,bs)] }
   | otherwise = throwDyn (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
   where
-    (fn, mods) = case str of 
-			'+':stuff -> (addToContext,      words stuff)
-			'-':stuff -> (removeFromContext, words stuff)
-			stuff     -> (newContext,        words stuff) 
+    (cmd, strs, as, bs) =
+        case str of 
+                '+':stuff -> rest AddModules stuff
+                '-':stuff -> rest RemModules stuff
+                stuff     -> rest SetContext stuff
+
+    rest cmd stuff = (cmd, strs, as, bs)
+       where strs = words stuff
+             (as,bs) = partitionWith starred strs
 
     sensible ('*':m) = looksLikeModuleName m
     sensible m       = looksLikeModuleName m
 
-separate :: Session -> [String] -> [Module] -> [Module] 
-        -> GHCi ([Module],[Module])
-separate session []           as bs = return (as,bs)
-separate session (('*':str):ms) as bs = do
-   m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
-   b <- io $ GHC.moduleIsInterpreted session m
-   if b then separate session ms (m:as) bs
-   	else throwDyn (CmdLineError ("module '"
-                        ++ GHC.moduleNameString (GHC.moduleName m)
-                        ++ "' is not interpreted"))
-separate session (str:ms) as bs = do
-  m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
-  separate session ms as (m:bs)
-
-newContext :: [String] -> GHCi ()
-newContext strs = do
-  s <- getSession
-  (as,bs) <- separate s strs [] []
-  prel_mod <- getPrelude
-  let bs' = if null as && prel_mod `notElem` bs then prel_mod:bs else bs
-  io $ GHC.setContext s as bs'
-
-
-addToContext :: [String] -> GHCi ()
-addToContext strs = do
-  s <- getSession
-  (as,bs) <- io $ GHC.getContext s
-
-  (new_as,new_bs) <- separate s strs [] []
-
-  let as_to_add = new_as \\ (as ++ bs)
-      bs_to_add = new_bs \\ (as ++ bs)
-
-  io $ GHC.setContext s (as ++ as_to_add) (bs ++ bs_to_add)
-
-
-removeFromContext :: [String] -> GHCi ()
-removeFromContext strs = do
-  s <- getSession
-  (as,bs) <- io $ GHC.getContext s
-
-  (as_to_remove,bs_to_remove) <- separate s strs [] []
-
-  let as' = as \\ (as_to_remove ++ bs_to_remove)
-      bs' = bs \\ (as_to_remove ++ bs_to_remove)
-
-  io $ GHC.setContext s as' bs'
+    starred ('*':m) = Left m
+    starred m       = Right m
+
+playCtxtCmd :: Bool -> (CtxtCmd, [String], [String]) -> GHCi ()
+playCtxtCmd fail (cmd, as, bs)
+  = do
+    s <- getSession
+    (as',bs') <- do_checks fail
+    (prev_as,prev_bs) <- io $ GHC.getContext s
+    (new_as, new_bs) <-
+      case cmd of
+        SetContext -> do
+          prel_mod <- getPrelude
+          let bs'' = if null as && prel_mod `notElem` bs' then prel_mod:bs'
+                                                          else bs'
+          return (as',bs'')
+        AddModules -> do
+          let as_to_add = as' \\ (prev_as ++ prev_bs)
+              bs_to_add = bs' \\ (prev_as ++ prev_bs)
+          return (prev_as ++ as_to_add, prev_bs ++ bs_to_add)
+        RemModules -> do
+          let new_as = prev_as \\ (as' ++ bs')
+              new_bs = prev_bs \\ (as' ++ bs')
+          return (new_as, new_bs)
+    io $ GHC.setContext s new_as new_bs
+  where
+    do_checks True = do
+      as' <- mapM wantInterpretedModule as
+      bs' <- mapM lookupModule bs
+      return (as',bs')
+    do_checks False = do
+      as' <- mapM (trymaybe . wantInterpretedModule) as
+      bs' <- mapM (trymaybe . lookupModule) bs
+      return (catMaybes as', catMaybes bs')
+
+    trymaybe m = do
+        r <- ghciTry m
+        case r of
+          Left _  -> return Nothing
+          Right a -> return (Just a)
 
 ----------------------------------------------------------------------------
 -- Code for `:set'
@@ -1104,29 +1396,77 @@ setCmd ""
    		   then text "none."
    		   else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
    	   ))
+       dflags <- getDynFlags
+       io $ putStrLn (showSDoc (
+          vcat (text "GHCi-specific dynamic flag settings:" 
+               :map (flagSetting dflags) ghciFlags)
+          ))
+       io $ putStrLn (showSDoc (
+          vcat (text "other dynamic, non-language, flag settings:" 
+               :map (flagSetting dflags) nonLanguageDynFlags)
+          ))
+  where flagSetting dflags (str,f)
+          | dopt f dflags = text "  " <> text "-f"    <> text str
+          | otherwise     = text "  " <> text "-fno-" <> text str
+        (ghciFlags,others)  = partition (\(_,f)->f `elem` flags) 
+                                        DynFlags.fFlags
+        nonLanguageDynFlags = filter (\(_,f)->not $ f `elem` map snd xFlags) 
+                                     others
+        flags = [Opt_PrintExplicitForalls
+                ,Opt_PrintBindResult
+                ,Opt_BreakOnException
+                ,Opt_BreakOnError
+                ,Opt_PrintEvldWithShow
+                ] 
 setCmd str
-  = case toArgs str of
-	("args":args) -> setArgs args
-	("prog":prog) -> setProg prog
-        ("prompt":prompt) -> setPrompt (after 6)
-        ("editor":cmd) -> setEditor (after 6)
-	wds -> setOptions wds
-   where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str
+  = case getCmd str of
+    Right ("args",   rest) ->
+        case toArgs rest of
+            Left err -> io (hPutStrLn stderr err)
+            Right args -> setArgs args
+    Right ("prog",   rest) ->
+        case toArgs rest of
+            Right [prog] -> setProg prog
+            _ -> io (hPutStrLn stderr "syntax: :set prog <progname>")
+    Right ("prompt", rest) -> setPrompt $ dropWhile isSpace rest
+    Right ("editor", rest) -> setEditor $ dropWhile isSpace rest
+    Right ("stop",   rest) -> setStop   $ dropWhile isSpace rest
+    _ -> case toArgs str of
+         Left err -> io (hPutStrLn stderr err)
+         Right wds -> setOptions wds
+
+setArgs, setOptions :: [String] -> GHCi ()
+setProg, setEditor, setStop, setPrompt :: String -> GHCi ()
 
 setArgs args = do
   st <- getGHCiState
   setGHCiState st{ args = args }
 
-setProg [prog] = do
+setProg prog = do
   st <- getGHCiState
   setGHCiState st{ progname = prog }
-setProg _ = do
-  io (hPutStrLn stderr "syntax: :set prog <progname>")
 
 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 }
+
 setPrompt value = do
   st <- getGHCiState
   if null value
@@ -1138,10 +1478,13 @@ setPrompt value = do
 
 setOptions wds =
    do -- first, deal with the GHCi opts (+s, +t, etc.)
-      let (plus_opts, minus_opts)  = partition isPlus wds
+      let (plus_opts, minus_opts)  = partitionWith isPlus wds
       mapM_ setOpt plus_opts
-
       -- then, dynamic flags
+      newDynFlags minus_opts
+
+newDynFlags :: [String] -> GHCi ()
+newDynFlags minus_opts = do
       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
       (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
@@ -1162,7 +1505,8 @@ setOptions wds =
         io (GHC.setTargets session [])
         io (GHC.load session LoadAllTargets)
         io (linkPackages dflags new_pkgs)
-        setContextAfterLoad session []
+        -- package flags changed, we can't re-use any of the old context
+        setContextAfterLoad session ([],[]) False []
       return ()
 
 
@@ -1171,7 +1515,7 @@ unsetOptions str
   = do -- first, deal with the GHCi opts (+s, +t, etc.)
        let opts = words str
 	   (minus_opts, rest1) = partition isMinus opts
-	   (plus_opts, rest2)  = partition isPlus rest1
+	   (plus_opts, rest2)  = partitionWith isPlus rest1
 
        if (not (null rest2)) 
 	  then io (putStrLn ("unknown option: '" ++ head rest2 ++ "'"))
@@ -1179,23 +1523,28 @@ 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 :: String -> Bool
+isMinus ('-':_) = True
 isMinus _ = False
 
-isPlus ('+':s) = True
-isPlus _ = False
+isPlus :: String -> Either String String
+isPlus ('+':opt) = Left opt
+isPlus other     = Right other
 
-setOpt ('+':str)
+setOpt, unsetOpt :: String -> GHCi ()
+
+setOpt str
   = case strToGHCiOpt str of
 	Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
 	Just o  -> setOption o
 
-unsetOpt ('+':str)
+unsetOpt str
   = case strToGHCiOpt str of
 	Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
 	Just o  -> unsetOption o
@@ -1214,79 +1563,128 @@ optToStr RevertCAFs = "r"
 -- ---------------------------------------------------------------------------
 -- code for `:show'
 
-showCmd str =
+showCmd :: String -> GHCi ()
+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
-        ["breakpoints"] -> showBkptTable
-	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
-
+        ["breaks"]   -> showBkptTable
+        ["context"]  -> showContext
+        ["packages"]  -> showPackages
+        ["languages"]  -> showLanguages
+	_ -> throwDyn (CmdLineError ("syntax:  :show [ args | prog | prompt | editor | stop | modules | bindings\n"++
+                                     "               | breaks | context | packages | languages ]"))
+
+showModules :: GHCi ()
 showModules = do
   session <- getSession
-  let show_one ms = do m <- io (GHC.showModule session ms)
-		       io (putStrLn m)
+  loaded_mods <- getLoadedModules session
+        -- we want *loaded* modules only, see #1734
+  let show_one ms = do m <- io (GHC.showModule session ms); io (putStrLn m)
+  mapM_ show_one loaded_mods
+
+getLoadedModules :: GHC.Session -> GHCi [GHC.ModSummary]
+getLoadedModules session = do
   graph <- io (GHC.getModuleGraph session)
-  mapM_ show_one graph
+  filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
 
+showBindings :: GHCi ()
 showBindings = do
   s <- getSession
-  unqual <- io (GHC.getPrintUnqual s)
   bindings <- io (GHC.getBindings s)
-  mapM_ showTyThing bindings
-  return ()
+  docs     <- io$ pprTypeAndContents s 
+                  [ id | AnId id <- sortBy compareTyThings bindings]
+  printForUserPartWay docs
 
-showTyThing (AnId id) = do 
-  ty' <- cleanType (GHC.idType id)
-  str <- showForUser (ppr id <> text " :: " <> ppr ty')
-  io (putStrLn str)
-showTyThing _  = return ()
+compareTyThings :: TyThing -> TyThing -> Ordering
+t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
 
--- 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 
-	then return ty
-	else return $! GHC.dropForAlls ty
+printTyThing :: TyThing -> GHCi ()
+printTyThing tyth = do dflags <- getDynFlags
+                       let pefas = dopt Opt_PrintExplicitForalls dflags
+		       printForUser (pprTyThing pefas tyth)
 
 showBkptTable :: GHCi ()
 showBkptTable = do
-  bt     <- getBkptTable
-  msg <- showForUser . vcat $ 
-             [ ppr mod <> colon <+> fcat 
-                       [ parens(int row <> comma <> int col) | (row,col) <- sites]
-               | (mod, sites) <-  sitesList bt ]
-  io (putStrLn msg)
+  st <- getGHCiState
+  printForUser $ prettyLocations (breaks st)
+
+showContext :: GHCi ()
+showContext = do
+   session <- getSession
+   resumes <- io $ GHC.getResumeContext session
+   printForUser $ vcat (map pp_resume (reverse resumes))
+  where
+   pp_resume resume =
+        ptext (sLit "--> ") <> text (GHC.resumeStmt resume)
+        $$ nest 2 (ptext (sLit "Stopped at") <+> ppr (GHC.resumeSpan resume))
+
+showPackages :: GHCi ()
+showPackages = do
+  pkg_flags <- fmap packageFlags getDynFlags
+  io $ putStrLn $ showSDoc $ vcat $
+    text ("active package flags:"++if null pkg_flags then " none" else "")
+    : map showFlag pkg_flags
+  pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags
+  io $ putStrLn $ showSDoc $ vcat $
+    text "packages currently loaded:" 
+    : map (nest 2 . text . packageIdString) (sort pkg_ids)
+  where showFlag (ExposePackage p) = text $ "  -package " ++ p
+        showFlag (HidePackage p)   = text $ "  -hide-package " ++ p
+        showFlag (IgnorePackage p) = text $ "  -ignore-package " ++ p
+
+showLanguages :: GHCi ()
+showLanguages = do
+   dflags <- getDynFlags
+   io $ putStrLn $ showSDoc $ vcat $
+      text "active language flags:" :
+      [text ("  -X" ++ str) | (str,f) <- DynFlags.xFlags, dopt f dflags]
+
 -- -----------------------------------------------------------------------------
 -- Completion
 
 completeNone :: String -> IO [String]
-completeNone w = return []
+completeNone _w = return []
+
+completeMacro, completeIdentifier, completeModule,
+    completeHomeModule, completeSetOptions, completeFilename,
+    completeHomeModuleOrFile 
+    :: String -> IO [String]
 
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
 completeWord :: String -> Int -> Int -> IO (Maybe (String, [String]))
 completeWord w start end = do
   line <- Readline.getLineBuffer
-  case w of 
+  let line_words = words (dropWhile isSpace line)
+  case w of
      ':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
      _other
-	| Just c <- is_cmd line -> do
-	   maybe_cmd <- lookupCommand c
-           let (n,w') = selectWord (words' 0 line)
-	   case maybe_cmd of
-	     Nothing -> return Nothing
-	     Just (_,_,False,complete) -> wrapCompleter complete w
-	     Just (_,_,True,complete) -> let complete' w = do rets <- complete w
-                                                              return (map (drop n) rets)
-                                         in wrapCompleter complete' w'
+	| ((':':c) : _) <- line_words -> do
+           completionVars <- lookupCompletionVars c
+	   case completionVars of
+	     (Nothing,complete) -> wrapCompleter complete w
+	     (Just breakChars,complete) 
+                    -> let (n,w') = selectWord 
+                                        (words' (`elem` breakChars) 0 line)
+                           complete' w = do rets <- complete w
+                                            return (map (drop n) rets)
+                       in wrapCompleter complete' w'
+        | ("import" : _) <- line_words ->
+                wrapCompleter completeModule w
 	| otherwise     -> do
 		--printf "complete %s, start = %d, end = %d\n" w start end
 		wrapCompleter completeIdentifier w
-    where words' _ [] = []
-          words' n str = let (w,r) = break isSpace str
-                             (s,r') = span isSpace r
-                         in (n,w):words' (n+length w+length s) r'
+    where words' _ _ [] = []
+          words' isBreak n str = let (w,r) = break isBreak str
+                                     (s,r') = span isBreak r
+                                 in (n,w):words' isBreak (n+length w+length s) r'
           -- In a Haskell expression we want to parse 'a-b' as three words
           -- where a compiler flag (ie. -fno-monomorphism-restriction) should
           -- only be a single word.
@@ -1294,19 +1692,26 @@ completeWord w start end = do
           selectWord ((offset,x):xs)
               | offset+length x >= start = (start-offset,take (end-offset) x)
               | otherwise = selectWord xs
+          
+          lookupCompletionVars ('!':_) = return (Just filenameWordBreakChars,
+                                            completeFilename)
+          lookupCompletionVars c = do
+              maybe_cmd <- lookupCommand' c
+              case maybe_cmd of
+                  Just (_,_,ws,f) -> return (ws,f)
+                  Nothing -> return (Just filenameWordBreakChars,
+                                        completeFilename)
 
-is_cmd line 
- | ((':':w) : _) <- words (dropWhile isSpace line) = Just w
- | otherwise = Nothing
 
+completeCmd :: String -> IO [String]
 completeCmd w = do
-  cmds <- readIORef commands
-  return (filter (w `isPrefixOf`) (map (':':) (map cmdName cmds)))
+  cmds <- readIORef macros_ref
+  return (filter (w `isPrefixOf`) (map (':':) 
+             (map cmdName (builtin_commands ++ cmds))))
 
 completeMacro w = do
-  cmds <- readIORef commands
-  let cmds' = [ cmd | cmd <- map cmdName cmds, cmd `elem` map cmdName builtin_commands ]
-  return (filter (w `isPrefixOf`) cmds')
+  cmds <- readIORef macros_ref
+  return (filter (w `isPrefixOf`) (map cmdName cmds))
 
 completeIdentifier w = do
   s <- restoreSession
@@ -1329,13 +1734,18 @@ completeSetOptions w = do
   return (filter (w `isPrefixOf`) options)
     where options = "args":"prog":allFlags
 
-completeBkpt = unionComplete completeModule completeBkptCmds
-
-completeBkptCmds w = do
-  return (filter (w `isPrefixOf`) options)
-    where options = ["add","del","list","stop"]
-
-completeFilename = Readline.filenameCompletionFunction
+completeFilename w = do
+    ws <- Readline.filenameCompletionFunction w
+    case ws of
+        -- If we only found one result, and it's a directory, 
+        -- add a trailing slash.
+        [file] -> do
+                isDir <- expandPathIO file >>= doesDirectoryExist
+                if isDir && last file /= '/'
+                    then return [file ++ "/"]
+                    else return [file]
+        _ -> return ws
+                
 
 completeHomeModuleOrFile = unionComplete completeHomeModule completeFilename
 
@@ -1349,8 +1759,10 @@ wrapCompleter :: (String -> IO [String]) -> String -> IO (Maybe (String,[String]
 wrapCompleter fun w =  do
   strs <- fun w
   case strs of
-    []  -> return Nothing
-    [x] -> return (Just (x,[]))
+    []  -> Readline.setAttemptedCompletionOver True >> return Nothing
+    [x] -> -- Add a trailing space, unless it already has an appended slash.
+           let appended = if last x == '/' then x else x ++ " "
+           in return (Just (appended,[]))
     xs  -> case getCommonPrefix xs of
 		""   -> return (Just ("",xs))
 		pref -> return (Just (pref,xs))
@@ -1358,19 +1770,18 @@ wrapCompleter fun w =  do
 getCommonPrefix :: [String] -> String
 getCommonPrefix [] = ""
 getCommonPrefix (s:ss) = foldl common s ss
-  where common s "" = ""
-	common "" s = ""
+  where common _s "" = ""
+	common "" _s = ""
 	common (c:cs) (d:ds)
 	   | c == d = c : common cs ds
 	   | otherwise = ""
 
 allExposedModules :: DynFlags -> [ModuleName]
 allExposedModules dflags 
- = map GHC.mkModuleName (concat (map exposedModules (filter exposed (eltsUFM pkg_db))))
+ = concat (map exposedModules (filter exposed (eltsUFM pkg_db)))
  where
   pkg_db = pkgIdMap (pkgState dflags)
 #else
-completeCmd        = completeNone
 completeMacro      = completeNone
 completeIdentifier = completeNone
 completeModule     = completeNone
@@ -1378,7 +1789,6 @@ completeHomeModule = completeNone
 completeSetOptions = completeNone
 completeFilename   = completeNone
 completeHomeModuleOrFile=completeNone
-completeBkpt       = completeNone
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -1395,24 +1805,13 @@ completeBkpt       = completeNone
 -- handler arond the flushing operation, so if stderr is closed
 -- GHCi will just die gracefully rather than going into an infinite loop.
 handler :: Exception -> GHCi Bool
-handler (DynException dyn) 
-  | Just StopChildSession <- fromDynamic dyn 
-     -- propagate to the parent session
-  = do ASSERTM (liftM not isTopLevel) 
-       throwDyn StopChildSession
-
-  | Just StopParentSession <- fromDynamic dyn 
-  = do at_topLevel <-  isTopLevel
-       if at_topLevel then return True else throwDyn StopParentSession
-  
-  | Just (ChildSessionStopped msg) <- fromDynamic dyn     
-  = io(putStrLn msg) >> return False
 
 handler exception = do
   flushInterpBuffers
   io installSignalHandlers
   ghciHandle handler (showException exception >> return False)
 
+showException :: Exception -> GHCi ()
 showException (DynException dyn) =
   case fromDynamic dyn of
     Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
@@ -1439,121 +1838,529 @@ ghciHandle h (GHCi m) = GHCi $ \s ->
 ghciUnblock :: GHCi a -> GHCi a
 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
 
+ghciTry :: GHCi a -> GHCi (Either Exception a)
+ghciTry (GHCi m) = GHCi $ \s -> Exception.try (m s) 
 
 -- ----------------------------------------------------------------------------
 -- Utils
 
 expandPath :: String -> GHCi String
-expandPath path = 
+expandPath path = io (expandPathIO path)
+
+expandPathIO :: String -> IO String
+expandPathIO path = 
   case dropWhile isSpace path of
    ('~':d) -> do
-	tilde <- io (getEnv "HOME")	-- will fail if HOME not defined
+	tilde <- getHomeDirectory -- will fail if HOME not defined
 	return (tilde ++ '/':d)
    other -> 
 	return other
 
--- ----------------------------------------------------------------------------
--- Windows console setup
+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 :: (Name -> SDoc -> GHCi ()) -> String
+                              -> (Name -> GHCi ())
+                              -> GHCi ()
+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
 
-setUpConsole :: IO ()
-setUpConsole = do
-#ifdef mingw32_HOST_OS
-	-- On Windows we need to set a known code page, otherwise the characters
-  	-- we read from the console will be be in some strange encoding, and
-	-- similarly for characters we write to the console.
-	--
-	-- At the moment, GHCi pretends all input is Latin-1.  In the
-	-- future we should support UTF-8, but for now we set the code pages
-	-- to Latin-1.
-	--
-	-- It seems you have to set the font in the console window to
-	-- a Unicode font in order for output to work properly,
-	-- otherwise non-ASCII characters are mapped wrongly.  sigh.
-	-- (see MSDN for SetConsoleOutputCP()).
-	--
-	setConsoleCP 28591       -- ISO Latin-1
-	setConsoleOutputCP 28591 -- ISO Latin-1
-#endif
-	return ()
-
-
-instrumentationBkptHandler :: IORef (BkptTable Module) -> BkptHandler Module
-instrumentationBkptHandler ref_bkptTable = BkptHandler {
-    isAutoBkptEnabled = \sess bkptLoc -> do 
-      bktpTable <- readIORef ref_bkptTable
-      return$ isBkptEnabled bktpTable bkptLoc
-
-  , handleBreakpoint = doBreakpoint ref_bkptTable 
-  }
-
-doBreakpoint :: IORef (BkptTable Module)-> Session -> [(Id,HValue)] -> BkptLocation Module -> String -> b -> IO b
-doBreakpoint ref_bkptTable s@(Session ref) values _ locMsg b = do
-         let (ids, hValues) = unzip values
-             names = map idName ids
-         ASSERT (length names == length hValues) return ()
-         let global_ids = map globaliseAndTidy ids
-         printScopeMsg locMsg global_ids
-         typed_ids  <- mapM instantiateIdType global_ids
-         hsc_env <- readIORef ref
-         let ictxt = hsc_IC hsc_env
-             rn_env   = ic_rn_local_env ictxt
-             type_env = ic_type_env ictxt
-             bound_names = map idName typed_ids
-             new_rn_env  = extendLocalRdrEnv rn_env bound_names
-		-- Remove any shadowed bindings from the type_env;
-		-- they are inaccessible but might, I suppose, cause 
-		-- a space leak if we leave them there
-             shadowed = [ n | name <- bound_names,
-                          let rdr_name = mkRdrUnqual (nameOccName name),
-                          Just n <- [lookupLocalRdrEnv rn_env rdr_name] ]
-             filtered_type_env = delListFromNameEnv type_env shadowed
-             new_type_env = extendTypeEnvWithIds filtered_type_env (typed_ids)
-             new_ic = ictxt { ic_rn_local_env = new_rn_env, 
-		  	      ic_type_env     = new_type_env }
-         writeIORef ref (hsc_env { hsc_IC = new_ic })
-         is_tty <- hIsTerminalDevice stdin
-         prel_mod <- GHC.findModule s prel_name Nothing
-         withExtendedLinkEnv (zip names hValues) $ 
-           startGHCi (interactiveLoop is_tty True) GHCiState{ 
-                              progname = "<interactive>",
-                              args     = [],
-                              prompt   = locMsg ++ "> ",
-                              session  = s,
-                              options  = [],
-                              bkptTable= ref_bkptTable,
-                              prelude  = prel_mod,
-			      topLevel = False }
-             `catchDyn` (\e -> case e of 
-                           StopChildSession -> evaluate$
-                                               throwDyn (ChildSessionStopped "")
-                           StopParentSession -> throwDyn StopParentSession
-           ) `finally` do
-             writeIORef ref hsc_env
-             putStrLn $ "Returning to normal execution..."
-         return b
+-- -----------------------------------------------------------------------------
+-- commands for debugger
+
+sprintCmd, printCmd, forceCmd :: String -> GHCi ()
+sprintCmd = pprintCommand False False
+printCmd  = pprintCommand True False
+forceCmd  = pprintCommand False True
+
+pprintCommand :: Bool -> Bool -> String -> GHCi ()
+pprintCommand bind force str = do
+  session <- getSession
+  io $ pprintClosureCommand session bind force str
+
+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 _ -> 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 :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
+doContinue pred step = do 
+  runResult <- resume step
+  afterRunStmt pred runResult
+  return ()
+
+abandonCmd :: String -> GHCi ()
+abandonCmd = noArgs $ do
+  s <- getSession
+  b <- io $ GHC.abandon s -- the prompt will change to indicate the new context
+  when (not b) $ io $ putStrLn "There is no computation running."
+  return ()
+
+deleteCmd :: String -> GHCi ()
+deleteCmd argLine = do
+   deleteSwitch $ words argLine
+   where
+   deleteSwitch :: [String] -> GHCi ()
+   deleteSwitch [] = 
+      io $ putStrLn "The delete command requires at least one argument."
+   -- delete all break points
+   deleteSwitch ("*":_rest) = discardActiveBreakPoints
+   deleteSwitch idents = do
+      mapM_ deleteOneBreak idents 
+      where
+      deleteOneBreak :: String -> GHCi ()
+      deleteOneBreak str
+         | all isDigit str = deleteBreak (read str)
+         | otherwise = return ()
+
+historyCmd :: String -> GHCi ()
+historyCmd arg
+  | null arg        = history 20
+  | all isDigit arg = history (read arg)
+  | otherwise       = io $ putStrLn "Syntax:  :history [num]"
+  where
+  history num = do
+    s <- getSession
+    resumes <- io $ GHC.getResumeContext s
+    case resumes of
+      [] -> io $ putStrLn "Not stopped at a breakpoint"
+      (r:_) -> do
+        let hist = GHC.resumeHistory r
+            (took,rest) = splitAt num hist
+        case hist of
+          [] -> io $ putStrLn $ 
+                   "Empty history. Perhaps you forgot to use :trace?"
+          _  -> do
+                 spans <- mapM (io . GHC.getHistorySpan s) took
+                 let nums  = map (printf "-%-3d:") [(1::Int)..]
+                     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 :: SDoc -> SDoc
+bold c | do_bold   = text start_bold <> c <> text end_bold
+       | otherwise = c
+
+backCmd :: String -> GHCi ()
+backCmd = noArgs $ do
+  s <- getSession
+  (names, _, span) <- io $ GHC.back s
+  printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr span
+  printTypeOfNames s names
+   -- run the command set with ":set stop <cmd>"
+  st <- getGHCiState
+  enqueueCommands [stop st]
+
+forwardCmd :: String -> GHCi ()
+forwardCmd = noArgs $ do
+  s <- getSession
+  (names, ix, span) <- io $ GHC.forward s
+  printForUser $ (if (ix == 0)
+                    then ptext (sLit "Stopped at")
+                    else ptext (sLit "Logged breakpoint at")) <+> ppr span
+  printTypeOfNames s names
+   -- run the command set with ":set stop <cmd>"
+  st <- getGHCiState
+  enqueueCommands [stop st]
+
+-- handle the "break" command
+breakCmd :: String -> GHCi ()
+breakCmd argLine = do
+   session <- getSession
+   breakSwitch session $ words argLine
+
+breakSwitch :: Session -> [String] -> GHCi ()
+breakSwitch _session [] = do
+   io $ putStrLn "The break command requires at least one argument."
+breakSwitch session (arg1:rest) 
+   | looksLikeModuleName arg1 && not (null rest) = do
+        mod <- wantInterpretedModule arg1
+        breakByModule mod rest
+   | all isDigit arg1 = do
+        (toplevel, _) <- io $ GHC.getContext session 
+        case toplevel of
+           (mod : _) -> breakByModuleLine mod (read arg1) rest
+           [] -> do 
+              io $ putStrLn "Cannot find default module for breakpoint." 
+              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.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 name $ text "can't find its location: " <> ppr loc
+       where
+          noCanDo n why = printForUser $
+                text "cannot set breakpoint on " <> ppr n <> text ": " <> why
+
+breakByModule :: Module -> [String] -> GHCi () 
+breakByModule mod (arg1:rest)
+   | all isDigit arg1 = do  -- looks like a line number
+        breakByModuleLine mod (read arg1) rest
+breakByModule _ _
+   = 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 = breakSyntax
+
+breakSyntax :: a
+breakSyntax = throwDyn (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
+
+findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
+findBreakAndSet mod lookupTickTree = do 
+   tickArray <- getTickArray mod
+   (breakArray, _) <- getModBreak mod
+   case lookupTickTree tickArray of 
+      Nothing  -> io $ putStrLn $ "No breakpoints found at that location."
+      Just (tick, span) -> do
+         success <- io $ setBreakFlag True breakArray tick 
+         if success 
+            then do
+               (alreadySet, nm) <- 
+                     recordBreak $ BreakLocation
+                             { breakModule = mod
+                             , breakLoc = span
+                             , breakTick = tick
+                             , onBreakCmd = ""
+                             }
+               printForUser $
+                  text "Breakpoint " <> ppr nm <>
+                  if alreadySet 
+                     then text " was already set at " <> ppr span
+                     else text " activated at " <> ppr span
+            else do
+            printForUser $ text "Breakpoint could not be activated at" 
+                                 <+> ppr span
+
+-- When a line number is specified, the current policy for choosing
+-- the best breakpoint is this:
+--    - the leftmost complete subexpression on the specified line, or
+--    - the leftmost subexpression starting on the specified line, or
+--    - the rightmost subexpression enclosing the specified line
+--
+findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
+findBreakByLine line arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    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
+
+        starts_here = [ tick | tick@(_,span) <- ticks,
+                               GHC.srcSpanStartLine span == line ]
+
+        (complete,incomplete) = partition ends_here starts_here
+            where ends_here (_,span) = GHC.srcSpanEndLine span == line
+
+findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
+                 -> Maybe (BreakIndex,SrcSpan)
+findBreakByCoord mb_file (line, col) arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    listToMaybe (sortBy (rightmost `on` snd) contains ++
+                 sortBy (leftmost_smallest `on` snd) after_here)
   where 
-     printScopeMsg :: String -> [Id] -> IO ()
-     printScopeMsg location ids = do
-       unqual  <- GHC.getPrintUnqual s
-       printForUser stdout unqual $
-         text "Stopped at a breakpoint in " <> text (stripColumn location) <>
-         char '.' <+> text "Local bindings in scope:" $$
-         nest 2 (pprWithCommas showId ids)
-      where 
-           showId id = 
-                ppr (idName id) <+> dcolon <+> ppr (idType id) 
-           stripColumn = reverse . tail . dropWhile (/= ':') . reverse
-
--- | Give the Id a Global Name, and tidy its type
-     globaliseAndTidy :: Id -> Id
-     globaliseAndTidy id
-      = let tidied_type = tidyTopType$ idType id
-        in setIdType (globaliseId VanillaGlobal id) tidied_type
-
--- | Instantiate the tyVars with GHC.Base.Unknown
-     instantiateIdType :: Id -> IO Id
-     instantiateIdType id = do
-       instantiatedType <- instantiateTyVarsToUnknown s (idType id)
-       return$ setIdType id instantiatedType
+        ticks = arr ! line
+
+        -- the ticks that span this coordinate
+        contains = [ tick | tick@(_,span) <- ticks, span `spans` (line,col),
+                            is_correct_file span ]
+
+        is_correct_file span
+                 | Just f <- mb_file = GHC.srcSpanFile span == f
+                 | otherwise         = True
+
+        after_here = [ tick | tick@(_,span) <- ticks,
+                              GHC.srcSpanStartLine span == line,
+                              GHC.srcSpanStartCol span >= col ]
+
+-- For now, use ANSI bold on terminals that we know support it.
+-- Otherwise, we add a line of carets under the active expression instead.
+-- In particular, on Windows and when running the testsuite (which sets
+-- TERM to vt100 for other reasons) we get carets.
+-- We really ought to use a proper termcap/terminfo library.
+do_bold :: Bool
+do_bold = (`isPrefixOf` unsafePerformIO mTerm) `any` ["xterm", "linux"]
+    where mTerm = System.Environment.getEnv "TERM"
+                  `Exception.catch` \_ -> return "TERM not set"
+
+start_bold :: String
+start_bold = "\ESC[1m"
+end_bold :: String
+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"
+      Just span
+       | GHC.isGoodSrcSpan span -> io $ listAround span True
+       | otherwise ->
+          do s <- getSession
+             resumes <- io $ GHC.getResumeContext s
+             case resumes of
+                 [] -> panic "No resumes"
+                 (r:_) ->
+                     do let traceIt = case GHC.resumeHistory r of
+                                      [] -> text "rerunning with :trace,"
+                                      _ -> empty
+                            doWhat = traceIt <+> text ":back then :list"
+                        printForUser (text "Unable to list source for" <+>
+                                      ppr span
+                                   $$ text "Try" <+> doWhat)
+listCmd str = list2 (words str)
+
+list2 :: [String] -> GHCi ()
+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
+-- start_bold/end_bold.
+listAround :: SrcSpan -> Bool -> IO ()
+listAround span do_highlight = do
+      contents <- BS.readFile (unpackFS file)
+      let 
+          lines = BS.split '\n' contents
+          these_lines = take (line2 - line1 + 1 + pad_before + pad_after) $ 
+                        drop (line1 - 1 - pad_before) $ lines
+          fst_line = max 1 (line1 - pad_before)
+          line_nos = [ fst_line .. ]
+
+          highlighted | do_highlight = zipWith highlight line_nos these_lines
+                      | otherwise    = [\p -> BS.concat[p,l] | l <- these_lines]
+
+          bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
+          prefixed = zipWith ($) highlighted bs_line_nos
+      --
+      BS.putStrLn (BS.intercalate (BS.pack "\n") prefixed)
+  where
+        file  = GHC.srcSpanFile span
+        line1 = GHC.srcSpanStartLine span
+        col1  = GHC.srcSpanStartCol span
+        line2 = GHC.srcSpanEndLine span
+        col2  = GHC.srcSpanEndCol span
+
+        pad_before | line1 == 1 = 0
+                   | otherwise  = 1
+        pad_after = 1
+
+        highlight | do_bold   = highlight_bold
+                  | otherwise = highlight_carets
+
+        highlight_bold no line prefix
+          | no == line1 && no == line2
+          = let (a,r) = BS.splitAt col1 line
+                (b,c) = BS.splitAt (col2-col1) r
+            in
+            BS.concat [prefix, a,BS.pack start_bold,b,BS.pack end_bold,c]
+          | no == line1
+          = let (a,b) = BS.splitAt col1 line in
+            BS.concat [prefix, a, BS.pack start_bold, b]
+          | no == line2
+          = let (a,b) = BS.splitAt col2 line in
+            BS.concat [prefix, a, BS.pack end_bold, b]
+          | otherwise   = BS.concat [prefix, line]
+
+        highlight_carets no line prefix
+          | no == line1 && no == line2
+          = BS.concat [prefix, line, nl, indent, BS.replicate col1 ' ',
+                                         BS.replicate (col2-col1) '^']
+          | no == line1
+          = BS.concat [indent, BS.replicate (col1 - 2) ' ', BS.pack "vv", nl, 
+                                         prefix, line]
+          | no == line2
+          = BS.concat [prefix, line, nl, indent, BS.replicate col2 ' ',
+                                         BS.pack "^^"]
+          | otherwise   = BS.concat [prefix, line]
+         where
+           indent = BS.pack ("  " ++ replicate (length (show no)) ' ')
+           nl = BS.singleton '\n'
+
+-- --------------------------------------------------------------------------
+-- Tick arrays
+
+getTickArray :: Module -> GHCi TickArray
+getTickArray modl = do
+   st <- getGHCiState
+   let arrmap = tickarrays st
+   case lookupModuleEnv arrmap modl of
+      Just arr -> return arr
+      Nothing  -> do
+        (_breakArray, ticks) <- getModBreak modl 
+        let arr = mkTickArray (assocs ticks)
+        setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
+        return arr
+
+discardTickArrays :: GHCi ()
+discardTickArrays = do
+   st <- getGHCiState
+   setGHCiState st{tickarrays = emptyModuleEnv}
 
+mkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray
+mkTickArray ticks
+  = accumArray (flip (:)) [] (1, max_line) 
+        [ (line, (nm,span)) | (nm,span) <- ticks,
+                              line <- srcSpanLines span ]
+    where
+        max_line = foldr max 0 (map GHC.srcSpanEndLine (map snd ticks))
+        srcSpanLines span = [ GHC.srcSpanStartLine span .. 
+                              GHC.srcSpanEndLine span ]
+
+lookupModule :: String -> GHCi Module
+lookupModule modName
+   = do session <- getSession 
+        io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
+
+-- don't reset the counter back to zero?
+discardActiveBreakPoints :: GHCi ()
+discardActiveBreakPoints = do
+   st <- getGHCiState
+   mapM (turnOffBreak.snd) (breaks st)
+   setGHCiState $ st { breaks = [] }
 
+deleteBreak :: Int -> GHCi ()
+deleteBreak identity = do
+   st <- getGHCiState
+   let oldLocations    = breaks st
+       (this,rest)     = partition (\loc -> fst loc == identity) oldLocations
+   if null this 
+      then printForUser (text "Breakpoint" <+> ppr identity <+>
+                         text "does not exist")
+      else do
+           mapM (turnOffBreak.snd) this
+           setGHCiState $ st { breaks = rest }
+
+turnOffBreak :: BreakLocation -> GHCi Bool
+turnOffBreak loc = do
+  (arr, _) <- getModBreak (breakModule loc)
+  io $ setBreakFlag False arr (breakTick loc)
+
+getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
+getModBreak mod = do
+   session <- getSession
+   Just mod_info <- io $ GHC.getModuleInfo session mod
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let array      = GHC.modBreaks_flags modBreaks
+   let ticks      = GHC.modBreaks_locs  modBreaks
+   return (array, ticks)
+
+setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool 
+setBreakFlag toggle array index
+   | toggle    = GHC.setBreakOn array index 
+   | otherwise = GHC.setBreakOff array index