projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
FIX #1556: GHC's :reload keeps the context, if possible
[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs
diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 507a71c..25ad9d8 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -6,6 +6,7 @@
 -- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------
 -- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------
+
 module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
 
 #include "HsVersions.h"
 module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
 
 #include "HsVersions.h"
@@ -17,14 +18,19 @@ import Debugger
 -- The GHC interface
 import qualified GHC
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
 -- The GHC interface
 import qualified GHC
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
-                          Type, Module, ModuleName, TyThing(..), Phase,
+                          Module, ModuleName, TyThing(..), Phase,
                           BreakIndex, SrcSpan, Resume, SingleStep )
                           BreakIndex, SrcSpan, Resume, SingleStep )
+import PprTyThing
 import DynFlags
 import DynFlags
+
 import Packages
 import Packages
+#ifdef USE_READLINE
 import PackageConfig
 import UniqFM
 import PackageConfig
 import UniqFM
+#endif
+
 import HscTypes                ( implicitTyThings )
 import HscTypes                ( implicitTyThings )
-import PprTyThing
+import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
 import Outputable       hiding (printForUser)
 import Module           -- for ModuleEnv
 import Name
 import Outputable       hiding (printForUser)
 import Module           -- for ModuleEnv
 import Name
@@ -69,6 +75,7 @@ import System.Exit    ( exitWith, ExitCode(..) )
 import System.Directory
 import System.IO
 import System.IO.Error as IO
 import System.Directory
 import System.IO
 import System.IO.Error as IO
+import System.IO.Unsafe
 import Data.Char
 import Data.Dynamic
 import Data.Array
 import Data.Char
 import Data.Dynamic
 import Data.Array
@@ -81,7 +88,9 @@ import GHC.IOBase     ( IOErrorType(InvalidArgument) )
 
 import Data.IORef      ( IORef, readIORef, writeIORef )
 
 
 import Data.IORef      ( IORef, readIORef, writeIORef )
 
+#ifdef USE_READLINE
 import System.Posix.Internals ( setNonBlockingFD )
 import System.Posix.Internals ( setNonBlockingFD )
+#endif
 
 -----------------------------------------------------------------------------
 
 
 -----------------------------------------------------------------------------
 
@@ -90,9 +99,12 @@ ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
                  ": http://www.haskell.org/ghc/  :? for help"
 
 type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
                  ": http://www.haskell.org/ghc/  :? for help"
 
 type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
+
+cmdName :: Command -> String
 cmdName (n,_,_,_) = n
 
 cmdName (n,_,_,_) = n
 
-GLOBAL_VAR(commands, builtin_commands, [Command])
+macros_ref :: IORef [Command]
+GLOBAL_VAR(macros_ref, [], [Command])
 
 builtin_commands :: [Command]
 builtin_commands = [
 
 builtin_commands :: [Command]
 builtin_commands = [
@@ -102,13 +114,15 @@ builtin_commands = [
   ("abandon",   keepGoing abandonCmd,           False, completeNone),
   ("break",     keepGoing breakCmd,             False, completeIdentifier),
   ("back",      keepGoing backCmd,              False, completeNone),
   ("abandon",   keepGoing abandonCmd,           False, completeNone),
   ("break",     keepGoing breakCmd,             False, completeIdentifier),
   ("back",      keepGoing backCmd,              False, completeNone),
-  ("browse",    keepGoing browseCmd,           False, completeModule),
+  ("browse",    keepGoing (browseCmd False),   False, completeModule),
+  ("browse!",   keepGoing (browseCmd True),    False, completeModule),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("check",    keepGoing checkModule,          False, completeHomeModule),
   ("continue",  keepGoing continueCmd,          False, completeNone),
   ("cmd",       keepGoing cmdCmd,               False, completeIdentifier),
   ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("check",    keepGoing checkModule,          False, completeHomeModule),
   ("continue",  keepGoing continueCmd,          False, completeNone),
   ("cmd",       keepGoing cmdCmd,               False, completeIdentifier),
   ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
-  ("def",      keepGoing defineMacro,          False, completeIdentifier),
+  ("def",      keepGoing (defineMacro False),  False, completeIdentifier),
+  ("def!",     keepGoing (defineMacro True),   False, completeIdentifier),
   ("delete",    keepGoing deleteCmd,            False, completeNone),
   ("e",        keepGoing editFile,             False, completeFilename),
   ("edit",     keepGoing editFile,             False, completeFilename),
   ("delete",    keepGoing deleteCmd,            False, completeNone),
   ("e",        keepGoing editFile,             False, completeFilename),
   ("edit",     keepGoing editFile,             False, completeFilename),
@@ -130,7 +144,8 @@ builtin_commands = [
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      keepGoing stepCmd,              False, completeIdentifier), 
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      keepGoing stepCmd,              False, completeIdentifier), 
-  ("stepover",  keepGoing stepOverCmd,          False, completeIdentifier), 
+  ("steplocal", keepGoing stepLocalCmd,         False, completeIdentifier), 
+  ("stepmodule",keepGoing stepModuleCmd,        False, completeIdentifier), 
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
@@ -143,14 +158,18 @@ keepGoing a str = a str >> return False
 keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
 keepGoingPaths a str = a (toArgs str) >> return False
 
 keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
 keepGoingPaths a str = a (toArgs str) >> return False
 
+shortHelpText :: String
 shortHelpText = "use :? for help.\n"
 
 shortHelpText = "use :? for help.\n"
 
+helpText :: String
 helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
  "   <statement>                 evaluate/run <statement>\n" ++
 helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
  "   <statement>                 evaluate/run <statement>\n" ++
+ "   :{\\n ..lines.. \\n:}\\n       multiline command\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
- "   :browse [*]<module>         display the names defined by <module>\n" ++
+ "   :browse[!] [-s] [[*]<mod>]  display the names defined by module <mod>\n" ++
+ "                               (!: more details; -s: sort; *: all top-level names)\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
  "   :cmd <expr>                 run the commands returned by <expr>::IO String\n" ++
  "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
  "   :cmd <expr>                 run the commands returned by <expr>::IO String\n" ++
  "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
@@ -186,7 +205,8 @@ helpText =
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
- "   :stepover                   single-step without following function applications\n"++
+ "   :steplocal                  single-step restricted to the current top level decl.\n"++
+ "   :stepmodule                 single-step restricted to the current module\n"++
  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++
 
  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++
 
@@ -208,6 +228,8 @@ helpText =
  "    +t            print type after evaluation\n" ++
  "    -<flags>      most GHC command line flags can also be set here\n" ++
  "                         (eg. -v2, -fglasgow-exts, etc.)\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" ++
  "\n" ++
  " -- Commands for displaying information:\n" ++
  "\n" ++
@@ -215,9 +237,12 @@ helpText =
  "   :show breaks                show the active breakpoints\n" ++
  "   :show context               show the breakpoint context\n" ++
  "   :show modules               show the currently loaded modules\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 anything that can be set with :set (e.g. args)\n" ++
  "\n" 
 
  "   :show <setting>             show anything that can be set with :set (e.g. args)\n" ++
  "\n" 
 
+findEditor :: IO String
 findEditor = do
   getEnv "EDITOR" 
     `IO.catch` \_ -> do
 findEditor = do
   getEnv "EDITOR" 
     `IO.catch` \_ -> do
@@ -258,7 +283,8 @@ interactiveUI session srcs maybe_expr = do
         hSetBuffering stdin NoBuffering
 
         -- initial context is just the Prelude
         hSetBuffering stdin NoBuffering
 
         -- initial context is just the Prelude
-   prel_mod <- GHC.findModule session prel_name (Just basePackageId)
+   prel_mod <- GHC.findModule session (GHC.mkModuleName "Prelude") 
+                                      (Just basePackageId)
    GHC.setContext session [] [prel_mod]
 
 #ifdef USE_READLINE
    GHC.setContext session [] [prel_mod]
 
 #ifdef USE_READLINE
@@ -298,8 +324,6 @@ interactiveUI session srcs maybe_expr = do
 
    return ()
 
 
    return ()
 
-prel_name = GHC.mkModuleName "Prelude"
-
 runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi ()
 runGHCi paths maybe_expr = do
   let read_dot_files = not opt_IgnoreDotGhci
 runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi ()
 runGHCi paths maybe_expr = do
   let read_dot_files = not opt_IgnoreDotGhci
@@ -314,14 +338,14 @@ runGHCi paths maybe_expr = do
        when (dir_ok && file_ok) $ do
          either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
          case either_hdl of
        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
+            Left _e   -> return ()
+            Right hdl -> runCommands (fileLoop hdl False)
     
   when (read_dot_files) $ do
     -- Read in $HOME/.ghci
     
   when (read_dot_files) $ do
     -- Read in $HOME/.ghci
-    either_dir <- io (IO.try (getEnv "HOME"))
+    either_dir <- io (IO.try getHomeDirectory)
     case either_dir of
     case either_dir of
-       Left e -> return ()
+       Left _e -> return ()
        Right dir -> do
          cwd <- io (getCurrentDirectory)
          when (dir /= cwd) $ do
        Right dir -> do
          cwd <- io (getCurrentDirectory)
          when (dir /= cwd) $ do
@@ -330,8 +354,8 @@ runGHCi paths maybe_expr = do
             when ok $ do
               either_hdl <- io (IO.try (openFile file ReadMode))
               case either_hdl of
             when ok $ do
               either_hdl <- io (IO.try (openFile file ReadMode))
               case either_hdl of
-                 Left e    -> return ()
-                 Right hdl -> fileLoop hdl False
+                 Left _e   -> return ()
+                 Right hdl -> runCommands (fileLoop hdl False)
 
   -- Perform a :load for files given on the GHCi command line
   -- When in -e mode, if the load fails then we want to stop
 
   -- Perform a :load for files given on the GHCi command line
   -- When in -e mode, if the load fails then we want to stop
@@ -376,6 +400,7 @@ runGHCi paths maybe_expr = do
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
 
   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 
 interactiveLoop is_tty show_prompt =
   -- Ignore ^C exceptions caught here
   ghciHandleDyn (\e -> case e of 
@@ -392,10 +417,10 @@ interactiveLoop is_tty show_prompt =
   -- read commands from stdin
 #ifdef USE_READLINE
   if (is_tty) 
   -- read commands from stdin
 #ifdef USE_READLINE
   if (is_tty) 
-       then readlineLoop
-       else fileLoop stdin show_prompt
+       then runCommands readlineLoop
+       else runCommands (fileLoop stdin show_prompt)
 #else
 #else
-  fileLoop stdin show_prompt
+  runCommands (fileLoop stdin show_prompt)
 #endif
 
 
 #endif
 
 
@@ -409,10 +434,11 @@ interactiveLoop is_tty show_prompt =
 -- the same directory while a process is running.
 
 checkPerms :: String -> IO Bool
 -- the same directory while a process is running.
 
 checkPerms :: String -> IO Bool
-checkPerms name =
 #ifdef mingw32_HOST_OS
 #ifdef mingw32_HOST_OS
+checkPerms _ =
   return True
 #else
   return True
 #else
+checkPerms name =
   Util.handle (\_ -> return False) $ do
      st <- getFileStatus name
      me <- getRealUserID
   Util.handle (\_ -> return False) $ do
      st <- getFileStatus name
      me <- getRealUserID
@@ -430,27 +456,24 @@ checkPerms name =
          else return True
 #endif
 
          else return True
 #endif
 
-fileLoop :: Handle -> Bool -> GHCi ()
+fileLoop :: Handle -> Bool -> GHCi (Maybe String)
 fileLoop hdl show_prompt = do
    when show_prompt $ do
         prompt <- mkPrompt
         (io (putStr prompt))
    l <- io (IO.try (hGetLine hdl))
    case l of
 fileLoop hdl show_prompt = 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 <- runCommands l
-                     if quit then return () else fileLoop hdl show_prompt
-
+        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 -> return (Just l)
+
+mkPrompt :: GHCi String
 mkPrompt = do
   session <- getSession
   (toplevs,exports) <- io (GHC.getContext session)
 mkPrompt = do
   session <- getSession
   (toplevs,exports) <- io (GHC.getContext session)
@@ -459,7 +482,7 @@ mkPrompt = do
   context_bit <-
         case resumes of
             [] -> return empty
   context_bit <-
         case resumes of
             [] -> return empty
-            r:rs -> do
+            r:_ -> do
                 let ix = GHC.resumeHistoryIx r
                 if ix == 0
                    then return (brackets (ppr (GHC.resumeSpan r)) <> space)
                 let ix = GHC.resumeHistoryIx r
                 if ix == 0
                    then return (brackets (ppr (GHC.resumeSpan r)) <> space)
@@ -469,7 +492,7 @@ mkPrompt = do
                         return (brackets (ppr (negate ix) <> char ':' 
                                           <+> ppr span) <> space)
   let
                         return (brackets (ppr (negate ix) <> char ':' 
                                           <+> ppr span) <> space)
   let
-        dots | r:rs <- resumes, not (null rs) = text "... "
+        dots | _:rs <- resumes, not (null rs) = text "... "
              | otherwise = empty
 
         modules_bit = 
              | otherwise = empty
 
         modules_bit = 
@@ -488,45 +511,72 @@ mkPrompt = do
 
 
 #ifdef USE_READLINE
 
 
 #ifdef USE_READLINE
-readlineLoop :: GHCi ()
+readlineLoop :: GHCi (Maybe String)
 readlineLoop = do
 readlineLoop = do
-   session <- getSession
-   (mod,imports) <- io (GHC.getContext session)
    io yield
    saveSession -- for use by completion
    io yield
    saveSession -- for use by completion
-   st <- getGHCiState
-   mb_span <- getCurrentBreakSpan
    prompt <- mkPrompt
    l <- io (readline prompt `finally` setNonBlockingFD 0)
    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
+                -- readline sometimes puts stdin into blocking mode,
+                -- so we need to put it back for the IO library
    splatSavedSession
    case l of
    splatSavedSession
    case l of
-       Nothing -> return ()
-       Just l  ->
-         case removeSpaces l of
-           "" -> readlineLoop
-           l  -> do
-                 io (addHistory l)
-                 quit <- runCommands l
-                 if quit then return () else readlineLoop
+        Nothing -> return Nothing
+        Just l  -> do
+                   io (addHistory l)
+                   return (Just l)
 #endif
 
 #endif
 
-runCommands :: String -> GHCi Bool
-runCommands cmd = do
-        q <- ghciHandle handler (doCommand cmd)
-        if q then return True else runNext
+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 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 handler (doCommand c)
+      if b then return () else runCommands getCmd
   where
   where
-       runNext = do
-          st <- getGHCiState
-          case cmdqueue st of
-            []   -> return False
-            c:cs -> do setGHCiState st{ cmdqueue = cs }
-                       runCommands c
-
-       doCommand (':' : cmd) = specialCommand cmd
-       doCommand stmt        = do timeIt $ runStmt stmt GHC.RunToCompletion
-                                  return False
+    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
 
 enqueueCommands :: [String] -> GHCi ()
 enqueueCommands cmds = do
@@ -537,6 +587,7 @@ enqueueCommands cmds = do
 -- 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.
 -- 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 :: String -> GHCi Bool
 runCommandEval c = ghciHandle handleEval (doCommand c)
   where 
     handleEval (ExitException code) = io (exitWith code)
 runCommandEval c = ghciHandle handleEval (doCommand c)
   where 
     handleEval (ExitException code) = io (exitWith code)
@@ -565,8 +616,9 @@ runStmt stmt step
 
 --afterRunStmt :: GHC.RunResult -> GHCi Bool
                                  -- False <=> the statement failed to compile
 
 --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 _ (GHC.RunException e) = throw e
-afterRunStmt pred run_result = do
+afterRunStmt step_here run_result = do
   session     <- getSession
   resumes <- io $ GHC.getResumeContext session
   case run_result of
   session     <- getSession
   resumes <- io $ GHC.getResumeContext session
   case run_result of
@@ -575,17 +627,18 @@ afterRunStmt pred run_result = do
         when show_types $ printTypeOfNames session names
      GHC.RunBreak _ names mb_info 
          | isNothing  mb_info || 
         when show_types $ printTypeOfNames session names
      GHC.RunBreak _ names mb_info 
          | isNothing  mb_info || 
-           pred (GHC.resumeSpan $ head resumes) -> do
+           step_here (GHC.resumeSpan $ head resumes) -> do
                printForUser $ ptext SLIT("Stopped at") <+> 
                        ppr (GHC.resumeSpan $ head resumes)
                printForUser $ ptext SLIT("Stopped at") <+> 
                        ppr (GHC.resumeSpan $ head resumes)
-               printTypeOfNames session names
+--               printTypeOfNames session names
+               printTypeAndContentOfNames session names
                maybe (return ()) runBreakCmd mb_info
                -- run the command set with ":set stop <cmd>"
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()
          | otherwise -> io(GHC.resume session GHC.SingleStep) >>= 
                maybe (return ()) runBreakCmd mb_info
                -- run the command set with ":set stop <cmd>"
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()
          | otherwise -> io(GHC.resume session GHC.SingleStep) >>= 
-                        afterRunStmt pred >> return ()
+                        afterRunStmt step_here >> return ()
      _ -> return ()
 
   flushInterpBuffers
      _ -> return ()
 
   flushInterpBuffers
@@ -595,12 +648,25 @@ afterRunStmt pred run_result = do
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 
+      where printTypeAndContentOfNames session names = do
+              let namesSorted = sortBy compareNames names
+              tythings <- catMaybes `liftM` 
+                              io (mapM (GHC.lookupName session) namesSorted)
+             let ids = [id | AnId id <- tythings]
+              terms <- mapM (io . GHC.obtainTermB session 10 False) ids
+              docs_terms <- mapM (io . showTerm session) terms                                   
+             dflags <- getDynFlags
+             let pefas = dopt Opt_PrintExplicitForalls dflags
+              printForUser $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
+                                            (map (pprTyThing pefas . AnId) ids)
+                                            docs_terms
+
 runBreakCmd :: GHC.BreakInfo -> GHCi ()
 runBreakCmd info = do
   let mod = GHC.breakInfo_module info
       nm  = GHC.breakInfo_number info
   st <- getGHCiState
 runBreakCmd :: GHC.BreakInfo -> GHCi ()
 runBreakCmd info = do
   let mod = GHC.breakInfo_module info
       nm  = GHC.breakInfo_number info
   st <- getGHCiState
-  case  [ loc | (i,loc) <- breaks st,
+  case  [ loc | (_,loc) <- breaks st,
                 breakModule loc == mod, breakTick loc == nm ] of
         []  -> return ()
         loc:_ | null cmd  -> return ()
                 breakModule loc == mod, breakTick loc == nm ] of
         []  -> return ()
         loc:_ | null cmd  -> return ()
@@ -634,7 +700,8 @@ specialCommand str = do
 
 lookupCommand :: String -> IO (Maybe Command)
 lookupCommand str = do
 
 lookupCommand :: String -> IO (Maybe Command)
 lookupCommand str = do
-  cmds <- readIORef commands
+  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)
   -- look for exact match first, then the first prefix match
   case [ c | c <- cmds, str == cmdName c ] of
      c:_ -> return (Just c)
@@ -643,28 +710,13 @@ lookupCommand str = do
                c:_ -> return (Just c)
 
 
                c:_ -> return (Just c)
 
 
-getCurrentBreakTick :: GHCi (Maybe BreakIndex)
-getCurrentBreakTick = do
-  session <- getSession
-  resumes <- io $ GHC.getResumeContext session
-  case resumes of
-    [] -> return Nothing
-    (r:rs) -> do
-        let ix = GHC.resumeHistoryIx r
-        if ix == 0
-           then return (GHC.breakInfo_number `fmap` GHC.resumeBreakInfo r)
-           else do
-                let hist = GHC.resumeHistory r !! (ix-1)
-                let tick = GHC.getHistoryTick hist
-                return (Just tick)
-
 getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
 getCurrentBreakSpan = do
   session <- getSession
   resumes <- io $ GHC.getResumeContext session
   case resumes of
     [] -> return Nothing
 getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
 getCurrentBreakSpan = do
   session <- getSession
   resumes <- io $ GHC.getResumeContext session
   case resumes of
     [] -> return Nothing
-    (r:rs) -> do
+    (r:_) -> do
         let ix = GHC.resumeHistoryIx r
         if ix == 0
            then return (Just (GHC.resumeSpan r))
         let ix = GHC.resumeHistoryIx r
         if ix == 0
            then return (Just (GHC.resumeSpan r))
@@ -679,7 +731,7 @@ getCurrentBreakModule = do
   resumes <- io $ GHC.getResumeContext session
   case resumes of
     [] -> return Nothing
   resumes <- io $ GHC.getResumeContext session
   case resumes of
     [] -> return Nothing
-    (r:rs) -> do
+    (r:_) -> do
         let ix = GHC.resumeHistoryIx r
         if ix == 0
            then return (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)
         let ix = GHC.resumeHistoryIx r
         if ix == 0
            then return (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)
@@ -692,7 +744,7 @@ getCurrentBreakModule = do
 
 noArgs :: GHCi () -> String -> GHCi ()
 noArgs m "" = m
 
 noArgs :: GHCi () -> String -> GHCi ()
 noArgs m "" = m
-noArgs m _ = io $ putStrLn "This command takes no arguments"
+noArgs _ _  = io $ putStrLn "This command takes no arguments"
 
 help :: String -> GHCi ()
 help _ = io (putStr helpText)
 
 help :: String -> GHCi ()
 help _ = io (putStr helpText)
@@ -708,7 +760,7 @@ info s  = do { let names = words s
     infoThing pefas session str = io $ do
        names     <- GHC.parseName session str
        mb_stuffs <- mapM (GHC.getInfo session) names
     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)
+       let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
        unqual <- GHC.getPrintUnqual session
        putStrLn (showSDocForUser unqual $
                   vcat (intersperse (text "") $
        unqual <- GHC.getPrintUnqual session
        putStrLn (showSDocForUser unqual $
                   vcat (intersperse (text "") $
@@ -746,7 +798,7 @@ addModule files = do
   session <- getSession
   io (mapM_ (GHC.addTarget session) targets)
   ok <- io (GHC.load session LoadAllTargets)
   session <- getSession
   io (mapM_ (GHC.addTarget session) targets)
   ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
+  afterLoad ok session Nothing
 
 changeDirectory :: String -> GHCi ()
 changeDirectory dir = do
 
 changeDirectory :: String -> GHCi ()
 changeDirectory dir = do
@@ -804,18 +856,24 @@ chooseEditFile =
   where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f
         fromTarget _ = Nothing -- when would we get a module target?
 
   where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f
         fromTarget _ = Nothing -- when would we get a module target?
 
-defineMacro :: String -> GHCi ()
-defineMacro s = do
+defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
+defineMacro overwrite s = do
   let (macro_name, definition) = break isSpace s
   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) 
   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
        else do
-  if (macro_name `elem` map cmdName cmds)
+  if (not overwrite && macro_name `elem` defined)
        then throwDyn (CmdLineError 
        then throwDyn (CmdLineError 
-               ("command '" ++ macro_name ++ "' is already defined"))
+               ("macro '" ++ macro_name ++ "' is already defined"))
        else do
 
        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"
   -- 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"
@@ -825,8 +883,8 @@ defineMacro s = do
   maybe_hv <- io (GHC.compileExpr cms new_expr)
   case maybe_hv of
      Nothing -> return ()
   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, False, completeNone)]))
 
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
 
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
@@ -835,17 +893,14 @@ runMacro fun s = do
   return False
 
 undefineMacro :: String -> GHCi ()
   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
 
 cmdCmd :: String -> GHCi ()
 cmdCmd str = do
@@ -886,7 +941,7 @@ loadModule' files = do
   -- as a ToDo for now.
 
   io (GHC.setTargets session targets)
   -- as a ToDo for now.
 
   io (GHC.setTargets session targets)
-  doLoad session LoadAllTargets
+  doLoad session False LoadAllTargets
 
 checkModule :: String -> GHCi ()
 checkModule m = do
 
 checkModule :: String -> GHCi ()
 checkModule m = do
@@ -904,31 +959,46 @@ checkModule m = do
                        (text "global names: " <+> ppr global) $$
                        (text "local  names: " <+> ppr local)
           _ -> empty))
                        (text "global names: " <+> ppr global) $$
                        (text "local  names: " <+> ppr local)
           _ -> empty))
-  afterLoad (successIf (isJust result)) session
+  afterLoad (successIf (isJust result)) session Nothing
 
 reloadModule :: String -> GHCi ()
 reloadModule m = do
   session <- getSession
 
 reloadModule :: String -> GHCi ()
 reloadModule m = do
   session <- getSession
-  doLoad session $ if null m then LoadAllTargets 
-                             else LoadUpTo (GHC.mkModuleName m)
+  doLoad session True $ if null m then LoadAllTargets 
+                                  else LoadUpTo (GHC.mkModuleName m)
   return ()
 
   return ()
 
-doLoad session howmuch = do
+doLoad :: Session -> Bool -> LoadHowMuch -> GHCi SuccessFlag
+doLoad session retain_context howmuch = do
   -- turn off breakpoints before we load: we can't turn them off later, because
   -- the ModBreaks will have gone away.
   discardActiveBreakPoints
   -- turn off breakpoints before we load: we can't turn them off later, because
   -- the ModBreaks will have gone away.
   discardActiveBreakPoints
+  context <- io $ GHC.getContext session
   ok <- io (GHC.load session howmuch)
   ok <- io (GHC.load session howmuch)
-  afterLoad ok session
+  afterLoad ok session (if retain_context then Just context else Nothing)
   return ok
 
   return ok
 
-afterLoad ok session = do
+afterLoad :: SuccessFlag -> Session -> Maybe ([Module],[Module]) -> GHCi ()
+afterLoad ok session maybe_context = do
   io (revertCAFs)  -- always revert CAFs on load.
   discardTickArrays
   io (revertCAFs)  -- always revert CAFs on load.
   discardTickArrays
-  graph <- io (GHC.getModuleGraph session)
-  graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
-  setContextAfterLoad session graph'
-  modulesLoadedMsg ok (map GHC.ms_mod_name graph')
-
+  loaded_mods <- getLoadedModules session
+
+  -- try to retain the old module context for :reload.  This might
+  -- not be possible, for example if some modules have gone away, so
+  -- we attempt to set the same context, backing off to the default
+  -- context if that fails.
+  case maybe_context of
+     Nothing -> setContextAfterLoad session loaded_mods
+     Just (as,bs) -> do
+        r <- io $ Exception.try (GHC.setContext session as bs)
+        case r of
+           Left err -> setContextAfterLoad session loaded_mods
+           Right _  -> return ()
+
+  modulesLoadedMsg ok (map GHC.ms_mod_name loaded_mods)
+
+setContextAfterLoad :: Session -> [GHC.ModSummary] -> GHCi ()
 setContextAfterLoad session [] = do
   prel_mod <- getPrelude
   io (GHC.setContext session [] [prel_mod])
 setContextAfterLoad session [] = do
   prel_mod <- getPrelude
   io (GHC.setContext session [] [prel_mod])
@@ -951,7 +1021,7 @@ 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'
        = 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
        = False
 
    load_this summary | m <- GHC.ms_mod summary = do
@@ -983,8 +1053,10 @@ typeOfExpr str
        maybe_ty <- io (GHC.exprType cms str)
        case maybe_ty of
          Nothing -> return ()
        maybe_ty <- io (GHC.exprType cms str)
        case maybe_ty of
          Nothing -> return ()
-         Just ty -> do ty' <- cleanType ty
-                        printForUser $ text str <> text " :: " <> ppr ty'
+         Just ty -> do dflags <- getDynFlags
+                       let pefas = dopt Opt_PrintExplicitForalls dflags
+                        printForUser $ text str <+> dcolon
+                                       <+> pprTypeForUser pefas ty
 
 kindOfType :: String -> GHCi ()
 kindOfType str 
 
 kindOfType :: String -> GHCi ()
 kindOfType str 
@@ -992,7 +1064,7 @@ kindOfType str
        maybe_ty <- io (GHC.typeKind cms str)
        case maybe_ty of
          Nothing    -> return ()
        maybe_ty <- io (GHC.typeKind cms str)
        case maybe_ty of
          Nothing    -> return ()
-         Just ty    -> printForUser $ text str <> text " :: " <> ppr ty
+         Just ty    -> printForUser $ text str <+> dcolon <+> ppr ty
           
 quit :: String -> GHCi Bool
 quit _ = return True
           
 quit :: String -> GHCi Bool
 quit _ = return True
@@ -1003,51 +1075,112 @@ shellEscape str = io (system str >> return False)
 -----------------------------------------------------------------------------
 -- Browsing a module's contents
 
 -----------------------------------------------------------------------------
 -- Browsing a module's contents
 
-browseCmd :: String -> GHCi ()
-browseCmd m = 
+browseCmd :: Bool -> String -> GHCi ()
+browseCmd bang m = 
   case words m of
   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>")
 
     _ -> 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
   s <- getSession
-  modl <- if exports_only then lookupModule m
-                          else wantInterpretedModule m
-
   -- Temporarily set the context to the module we're interested in,
   -- just so we can get an appropriate PrintUnqualified
   (as,bs) <- io (GHC.getContext s)
   prel_mod <- getPrelude
   io (if exports_only then GHC.setContext s [] [prel_mod,modl]
   -- 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] [])
+                      else GHC.setContext s [modl] [])
   unqual <- io (GHC.getPrintUnqual s)
   io (GHC.setContext s as bs)
 
   mb_mod_info <- io $ GHC.getModuleInfo s modl
   case mb_mod_info of
   unqual <- io (GHC.getPrintUnqual s)
   io (GHC.setContext s as bs)
 
   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
     Just mod_info -> do
-        let names
-              | exports_only = GHC.modInfoExports mod_info
-              | otherwise    = GHC.modInfoTopLevelScope mod_info
-                               `orElse` []
-
-        mb_things <- io $ mapM (GHC.lookupName s) names
-       let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things)
-
         dflags <- getDynFlags
         dflags <- getDynFlags
-       let pefas = dopt Opt_PrintExplicitForalls dflags
-       io (putStrLn (showSDocForUser unqual (
-               vcat (map (pprTyThingInContext pefas) filtered_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 from "++) . 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
 
 
 -----------------------------------------------------------------------------
 -- Setting the module context
 
+setContext :: String -> GHCi ()
 setContext str
   | all sensible mods = fn mods
   | otherwise = throwDyn (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
 setContext str
   | all sensible mods = fn mods
   | otherwise = throwDyn (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
@@ -1062,16 +1195,12 @@ setContext str
 
 separate :: Session -> [String] -> [Module] -> [Module] 
         -> GHCi ([Module],[Module])
 
 separate :: Session -> [String] -> [Module] -> [Module] 
         -> GHCi ([Module],[Module])
-separate session []           as bs = return (as,bs)
+separate _       []             as bs = return (as,bs)
 separate session (('*':str):ms) as bs = do
 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"))
+  m <- wantInterpretedModule str
+  separate session ms (m:as) bs
 separate session (str:ms) as bs = do
 separate session (str:ms) as bs = do
-  m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
+  m <- lookupModule str
   separate session ms as (m:bs)
 
 newContext :: [String] -> GHCi ()
   separate session ms as (m:bs)
 
 newContext :: [String] -> GHCi ()
@@ -1128,16 +1257,41 @@ setCmd ""
                   then text "none."
                   else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
           ))
                   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
 setCmd str
   = case toArgs str of
        ("args":args) -> setArgs args
        ("prog":prog) -> setProg prog
-        ("prompt":prompt) -> setPrompt (after 6)
-        ("editor":cmd) -> setEditor (after 6)
-        ("stop":cmd) -> setStop (after 4)
+        ("prompt":_)  -> setPrompt (after 6)
+        ("editor":_)  -> setEditor (after 6)
+        ("stop":_)    -> setStop (after 4)
        wds -> setOptions wds
    where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str
 
        wds -> setOptions wds
    where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str
 
+setArgs, setProg, setOptions :: [String] -> GHCi ()
+setEditor, setStop, setPrompt :: String -> GHCi ()
+
 setArgs args = do
   st <- getGHCiState
   setGHCiState st{ args = args }
 setArgs args = do
   st <- getGHCiState
   setGHCiState st{ args = args }
@@ -1180,11 +1334,12 @@ setPrompt value = do
 
 setOptions wds =
    do -- first, deal with the GHCi opts (+s, +t, etc.)
 
 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
 
       mapM_ setOpt plus_opts
       -- then, dynamic flags
       newDynFlags minus_opts
 
+newDynFlags :: [String] -> GHCi ()
 newDynFlags minus_opts = do
       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
 newDynFlags minus_opts = do
       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
@@ -1215,7 +1370,7 @@ unsetOptions str
   = do -- first, deal with the GHCi opts (+s, +t, etc.)
        let opts = words str
           (minus_opts, rest1) = partition isMinus opts
   = 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 ++ "'"))
 
        if (not (null rest2)) 
          then io (putStrLn ("unknown option: '" ++ head rest2 ++ "'"))
@@ -1229,18 +1384,22 @@ unsetOptions str
        no_flags <- mapM no_flag minus_opts
        newDynFlags no_flags
 
        no_flags <- mapM no_flag minus_opts
        newDynFlags no_flags
 
-isMinus ('-':s) = True
+isMinus :: String -> Bool
+isMinus ('-':_) = True
 isMinus _ = False
 
 isMinus _ = False
 
-isPlus ('+':s) = True
-isPlus _ = False
+isPlus :: String -> Either String String
+isPlus ('+':opt) = Left opt
+isPlus other     = Right other
+
+setOpt, unsetOpt :: String -> GHCi ()
 
 
-setOpt ('+':str)
+setOpt str
   = case strToGHCiOpt str of
        Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
        Just o  -> setOption o
 
   = 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
   = case strToGHCiOpt str of
        Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
        Just o  -> unsetOption o
@@ -1259,6 +1418,7 @@ optToStr RevertCAFs = "r"
 -- ---------------------------------------------------------------------------
 -- code for `:show'
 
 -- ---------------------------------------------------------------------------
 -- code for `:show'
 
+showCmd :: String -> GHCi ()
 showCmd str = do
   st <- getGHCiState
   case words str of
 showCmd str = do
   st <- getGHCiState
   case words str of
@@ -1272,18 +1432,26 @@ showCmd str = do
        ["linker"]   -> io showLinkerState
         ["breaks"]   -> showBkptTable
         ["context"]  -> showContext
        ["linker"]   -> io showLinkerState
         ["breaks"]   -> showBkptTable
         ["context"]  -> showContext
+        ["packages"]  -> showPackages
+        ["languages"]  -> showLanguages
        _ -> throwDyn (CmdLineError "syntax:  :show [args|prog|prompt|editor|stop|modules|bindings|breaks|context]")
 
        _ -> throwDyn (CmdLineError "syntax:  :show [args|prog|prompt|editor|stop|modules|bindings|breaks|context]")
 
+showModules :: GHCi ()
 showModules = do
   session <- getSession
 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)
   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
 showBindings = do
   s <- getSession
-  unqual <- io (GHC.getPrintUnqual s)
   bindings <- io (GHC.getBindings s)
   mapM_ printTyThing $ sortBy compareTyThings bindings
   return ()
   bindings <- io (GHC.getBindings s)
   mapM_ printTyThing $ sortBy compareTyThings bindings
   return ()
@@ -1292,18 +1460,9 @@ compareTyThings :: TyThing -> TyThing -> Ordering
 t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
 
 printTyThing :: TyThing -> GHCi ()
 t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
 
 printTyThing :: TyThing -> GHCi ()
-printTyThing (AnId id) = do
-  ty' <- cleanType (GHC.idType id)
-  printForUser $ ppr id <> text " :: " <> ppr ty'
-printTyThing _ = return ()
-
--- if -fglasgow-exts is on we show the foralls, otherwise we don't.
-cleanType :: Type -> GHCi Type
-cleanType ty = do
-  dflags <- getDynFlags
-  if dopt Opt_PrintExplicitForalls dflags 
-       then return ty
-       else return $! GHC.dropForAlls ty
+printTyThing tyth = do dflags <- getDynFlags
+                       let pefas = dopt Opt_PrintExplicitForalls dflags
+                      printForUser (pprTyThing pefas tyth)
 
 showBkptTable :: GHCi ()
 showBkptTable = do
 
 showBkptTable :: GHCi ()
 showBkptTable = do
@@ -1320,21 +1479,47 @@ showContext = do
         ptext SLIT("--> ") <> text (GHC.resumeStmt resume)
         $$ nest 2 (ptext SLIT("Stopped at") <+> ppr (GHC.resumeSpan 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) 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]
 
 -- -----------------------------------------------------------------------------
 -- Completion
 
 completeNone :: String -> IO [String]
-completeNone w = return []
+completeNone _w = return []
+
+completeMacro, completeIdentifier, completeModule,
+    completeHomeModule, completeSetOptions, completeFilename,
+    completeHomeModuleOrFile 
+    :: String -> IO [String]
 
 #ifdef USE_READLINE
 completeWord :: String -> Int -> Int -> IO (Maybe (String, [String]))
 completeWord w start end = do
   line <- Readline.getLineBuffer
 
 #ifdef USE_READLINE
 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
      ':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
      _other
-       | Just c <- is_cmd line -> do
+       | ((':':c) : _) <- line_words -> do
           maybe_cmd <- lookupCommand c
            let (n,w') = selectWord (words' 0 line)
           case maybe_cmd of
           maybe_cmd <- lookupCommand c
            let (n,w') = selectWord (words' 0 line)
           case maybe_cmd of
@@ -1343,6 +1528,8 @@ completeWord w start end = do
             Just (_,_,True,complete) -> let complete' w = do rets <- complete w
                                                               return (map (drop n) rets)
                                          in wrapCompleter complete' w'
             Just (_,_,True,complete) -> let 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
        | otherwise     -> do
                --printf "complete %s, start = %d, end = %d\n" w start end
                wrapCompleter completeIdentifier w
@@ -1358,18 +1545,15 @@ completeWord w start end = do
               | offset+length x >= start = (start-offset,take (end-offset) x)
               | otherwise = selectWord xs
 
               | offset+length x >= start = (start-offset,take (end-offset) x)
               | otherwise = selectWord xs
 
-is_cmd line 
- | ((':':w) : _) <- words (dropWhile isSpace line) = Just w
- | otherwise = Nothing
-
+completeCmd :: String -> IO [String]
 completeCmd w = do
 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
 
 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
 
 completeIdentifier w = do
   s <- restoreSession
@@ -1415,19 +1599,18 @@ wrapCompleter fun w =  do
 getCommonPrefix :: [String] -> String
 getCommonPrefix [] = ""
 getCommonPrefix (s:ss) = foldl common s ss
 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 
        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
  where
   pkg_db = pkgIdMap (pkgState dflags)
 #else
-completeCmd        = completeNone
 completeMacro      = completeNone
 completeIdentifier = completeNone
 completeModule     = completeNone
 completeMacro      = completeNone
 completeIdentifier = completeNone
 completeModule     = completeNone
@@ -1435,7 +1618,6 @@ completeHomeModule = completeNone
 completeSetOptions = completeNone
 completeFilename   = completeNone
 completeHomeModuleOrFile=completeNone
 completeSetOptions = completeNone
 completeFilename   = completeNone
 completeHomeModuleOrFile=completeNone
-completeBkpt       = completeNone
 #endif
 
 -- ---------------------------------------------------------------------------
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -1458,6 +1640,7 @@ handler exception = do
   io installSignalHandlers
   ghciHandle handler (showException exception >> return False)
 
   io installSignalHandlers
   ghciHandle handler (showException exception >> return False)
 
+showException :: Exception -> GHCi ()
 showException (DynException dyn) =
   case fromDynamic dyn of
     Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
 showException (DynException dyn) =
   case fromDynamic dyn of
     Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
@@ -1492,7 +1675,7 @@ expandPath :: String -> GHCi String
 expandPath path = 
   case dropWhile isSpace path of
    ('~':d) -> do
 expandPath path = 
   case dropWhile isSpace path of
    ('~':d) -> do
-       tilde <- io (getEnv "HOME")     -- will fail if HOME not defined
+       tilde <- io getHomeDirectory -- will fail if HOME not defined
        return (tilde ++ '/':d)
    other -> 
        return other
        return (tilde ++ '/':d)
    other -> 
        return other
@@ -1506,6 +1689,9 @@ wantInterpretedModule str = do
        throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
    return modl
 
        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
 wantNameFromInterpretedModule noCanDo str and_then = do
    session <- getSession
    names <- io $ GHC.parseName session str
@@ -1534,14 +1720,17 @@ setUpConsole = do
        -- similarly for characters we write to the console.
        --
        -- At the moment, GHCi pretends all input is Latin-1.  In the
        -- 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.
+       -- future we should support UTF-8, but for now we set the code
+       -- pages to Latin-1.  Doing it this way does lead to problems,
+       -- however: see bug #1649.
        --
        -- 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()).
        --
        --
        -- 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()).
        --
+        -- This call has been known to hang on some machines, see bug #1483
+        --
        setConsoleCP 28591       -- ISO Latin-1
        setConsoleOutputCP 28591 -- ISO Latin-1
 #endif
        setConsoleCP 28591       -- ISO Latin-1
        setConsoleOutputCP 28591 -- ISO Latin-1
 #endif
@@ -1550,10 +1739,12 @@ setUpConsole = do
 -- -----------------------------------------------------------------------------
 -- commands for debugger
 
 -- -----------------------------------------------------------------------------
 -- commands for debugger
 
+sprintCmd, printCmd, forceCmd :: String -> GHCi ()
 sprintCmd = pprintCommand False False
 printCmd  = pprintCommand True False
 forceCmd  = pprintCommand False True
 
 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
 pprintCommand bind force str = do
   session <- getSession
   io $ pprintClosureCommand session bind force str
@@ -1562,50 +1753,39 @@ stepCmd :: String -> GHCi ()
 stepCmd []         = doContinue (const True) GHC.SingleStep
 stepCmd expression = do runStmt expression GHC.SingleStep; return ()
 
 stepCmd []         = doContinue (const True) GHC.SingleStep
 stepCmd expression = do runStmt expression GHC.SingleStep; return ()
 
-stepOverCmd [] = do 
+stepLocalCmd :: String -> GHCi ()
+stepLocalCmd  [] = do 
   mb_span <- getCurrentBreakSpan
   mb_span <- getCurrentBreakSpan
-  session <- getSession
   case mb_span of
     Nothing  -> stepCmd []
   case mb_span of
     Nothing  -> stepCmd []
-    Just curr_loc -> do
-       Just tick   <- getCurrentBreakTick
-       Just mod    <- getCurrentBreakModule 
-       parent      <- io$ GHC.findEnclosingDeclSpanByTick session mod tick
-       allTicksRightmost <- (sortBy rightmost . map snd) `fmap` 
-                               ticksIn mod parent
-       let lastTick = null allTicksRightmost || 
-                      head allTicksRightmost == curr_loc
-       if not lastTick
-              then let f t = t `isSubspanOf` parent && 
-                             (curr_loc `leftmost_largest` t == LT)
-                   in doContinue f GHC.SingleStep
-              else printForUser (text "Warning: no more breakpoints in this function body, switching to :step") >>
-                   doContinue (const True) GHC.SingleStep
-
-stepOverCmd expression = stepCmd expression
-
-{- 
- The first tricky bit in stepOver is detecting that we have 
- arrived to the last tick in an expression, in which case we must
- step normally to the next tick.
- What we do is:
-  1. Retrieve the enclosing expression block (with a tick)
-  2. Retrieve all the ticks there and sort them out by 'rightness'
-  3. See if the current tick turned out the first one in the list
-
- The second tricky bit is how to step over recursive calls.
-
--}
-
---ticksIn :: Module -> SrcSpan -> GHCi [Tick]
-ticksIn mod src = do
+    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
   ticks <- getTickArray mod
-  let lines = [srcSpanStartLine src .. srcSpanEndLine src]
-  return [  t   | line <- lines
-                , t@(_,span) <- ticks ! line
-                , srcSpanStart src <= srcSpanStart span
-                , srcSpanEnd src   >= srcSpanEnd span
-                ]
+  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 :: String -> GHCi ()
 traceCmd []         = doContinue (const True) GHC.RunAndLogSteps
@@ -1615,6 +1795,7 @@ continueCmd :: String -> GHCi ()
 continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
 
 -- doContinue :: SingleStep -> GHCi ()
 continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
 
 -- doContinue :: SingleStep -> GHCi ()
+doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
 doContinue pred step = do 
   session <- getSession
   runResult <- io $ GHC.resume session step
 doContinue pred step = do 
   session <- getSession
   runResult <- io $ GHC.resume session step
@@ -1656,7 +1837,7 @@ historyCmd arg
     resumes <- io $ GHC.getResumeContext s
     case resumes of
       [] -> io $ putStrLn "Not stopped at a breakpoint"
     resumes <- io $ GHC.getResumeContext s
     case resumes of
       [] -> io $ putStrLn "Not stopped at a breakpoint"
-      (r:rs) -> do
+      (r:_) -> do
         let hist = GHC.resumeHistory r
             (took,rest) = splitAt num hist
         spans <- mapM (io . GHC.getHistorySpan s) took
         let hist = GHC.resumeHistory r
             (took,rest) = splitAt num hist
         spans <- mapM (io . GHC.getHistorySpan s) took
@@ -1669,13 +1850,14 @@ historyCmd arg
                              (map (parens . ppr) spans)))
         io $ putStrLn $ if null rest then "<end of history>" else "..."
 
                              (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
 bold c | do_bold   = text start_bold <> c <> text end_bold
        | otherwise = c
 
 backCmd :: String -> GHCi ()
 backCmd = noArgs $ do
   s <- getSession
-  (names, ix, span) <- io $ GHC.back s
+  (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>"
   printForUser $ ptext SLIT("Logged breakpoint at") <+> ppr span
   printTypeOfNames s names
    -- run the command set with ":set stop <cmd>"
@@ -1703,10 +1885,10 @@ breakCmd argLine = do
 breakSwitch :: Session -> [String] -> GHCi ()
 breakSwitch _session [] = do
    io $ putStrLn "The break command requires at least one argument."
 breakSwitch :: Session -> [String] -> GHCi ()
 breakSwitch _session [] = do
    io $ putStrLn "The break command requires at least one argument."
-breakSwitch session args@(arg1:rest) 
+breakSwitch session (arg1:rest) 
    | looksLikeModuleName arg1 = do
         mod <- wantInterpretedModule arg1
    | looksLikeModuleName arg1 = do
         mod <- wantInterpretedModule arg1
-        breakByModule session mod rest
+        breakByModule mod rest
    | all isDigit arg1 = do
         (toplevel, _) <- io $ GHC.getContext session 
         case toplevel of
    | all isDigit arg1 = do
         (toplevel, _) <- io $ GHC.getContext session 
         case toplevel of
@@ -1727,11 +1909,11 @@ breakSwitch session args@(arg1:rest)
           noCanDo n why = printForUser $
                 text "cannot set breakpoint on " <> ppr n <> text ": " <> why
 
           noCanDo n why = printForUser $
                 text "cannot set breakpoint on " <> ppr n <> text ": " <> why
 
-breakByModule :: Session -> Module -> [String] -> GHCi () 
-breakByModule session mod args@(arg1:rest)
+breakByModule :: Module -> [String] -> GHCi () 
+breakByModule mod (arg1:rest)
    | all isDigit arg1 = do  -- looks like a line number
         breakByModuleLine mod (read arg1) rest
    | all isDigit arg1 = do  -- looks like a line number
         breakByModuleLine mod (read arg1) rest
-breakByModule session mod _
+breakByModule _ _
    = breakSyntax
 
 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
    = breakSyntax
 
 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
@@ -1741,6 +1923,7 @@ breakByModuleLine mod line args
         findBreakAndSet mod $ findBreakByCoord Nothing (line, read col)
    | otherwise = breakSyntax
 
         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 ()
 breakSyntax = throwDyn (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
@@ -1751,7 +1934,6 @@ findBreakAndSet mod lookupTickTree = do
       Nothing  -> io $ putStrLn $ "No breakpoints found at that location."
       Just (tick, span) -> do
          success <- io $ setBreakFlag True breakArray tick 
       Nothing  -> io $ putStrLn $ "No breakpoints found at that location."
       Just (tick, span) -> do
          success <- io $ setBreakFlag True breakArray tick 
-         session <- getSession
          if success 
             then do
                (alreadySet, nm) <- 
          if success 
             then do
                (alreadySet, nm) <- 
@@ -1786,11 +1968,11 @@ findBreakByLine line arr
   where 
         ticks = arr ! line
 
   where 
         ticks = arr ! line
 
-        starts_here = [ tick | tick@(nm,span) <- ticks,
+        starts_here = [ tick | tick@(_,span) <- ticks,
                                GHC.srcSpanStartLine span == line ]
 
         (complete,incomplete) = partition ends_here starts_here
                                GHC.srcSpanStartLine span == line ]
 
         (complete,incomplete) = partition ends_here starts_here
-            where ends_here (nm,span) = GHC.srcSpanEndLine span == line
+            where ends_here (_,span) = GHC.srcSpanEndLine span == line
 
 findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
                  -> Maybe (BreakIndex,SrcSpan)
 
 findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
                  -> Maybe (BreakIndex,SrcSpan)
@@ -1803,29 +1985,30 @@ findBreakByCoord mb_file (line, col) arr
         ticks = arr ! line
 
         -- the ticks that span this coordinate
         ticks = arr ! line
 
         -- the ticks that span this coordinate
-        contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col),
+        contains = [ tick | tick@(_,span) <- ticks, span `spans` (line,col),
                             is_correct_file span ]
 
         is_correct_file span
                  | Just f <- mb_file = GHC.srcSpanFile span == f
                  | otherwise         = True
 
                             is_correct_file span ]
 
         is_correct_file span
                  | Just f <- mb_file = GHC.srcSpanFile span == f
                  | otherwise         = True
 
-        after_here = [ tick | tick@(nm,span) <- ticks,
+        after_here = [ tick | tick@(_,span) <- ticks,
                               GHC.srcSpanStartLine span == line,
                               GHC.srcSpanStartCol span >= col ]
 
                               GHC.srcSpanStartLine span == line,
                               GHC.srcSpanStartCol span >= col ]
 
--- for now, use ANSI bold on Unixy systems.  On Windows, we add a line
--- of carets under the active expression instead.  The Windows console
--- doesn't support ANSI escape sequences, and most Unix terminals
--- (including xterm) do, so this is a reasonable guess until we have a
--- proper termcap/terminfo library.
-#if !defined(mingw32_TARGET_OS)
-do_bold = True
-#else
-do_bold = False
-#endif
-
+-- 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"
 start_bold = "\ESC[1m"
+end_bold :: String
 end_bold   = "\ESC[0m"
 
 listCmd :: String -> GHCi ()
 end_bold   = "\ESC[0m"
 
 listCmd :: String -> GHCi ()
@@ -1837,6 +2020,7 @@ listCmd "" = do
                 | otherwise              -> printForUser $ text "unable to list source for" <+> ppr span
 listCmd str = list2 (words str)
 
                 | otherwise              -> printForUser $ text "unable to list source for" <+> ppr span
 listCmd str = list2 (words str)
 
+list2 :: [String] -> GHCi ()
 list2 [arg] | all isDigit arg = do
     session <- getSession
     (toplevel, _) <- io $ GHC.getContext session 
 list2 [arg] | all isDigit arg = do
     session <- getSession
     (toplevel, _) <- io $ GHC.getContext session 
@@ -1882,6 +2066,7 @@ listModuleLine modl line = do
 -- | 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.
 -- | 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 
 listAround span do_highlight = do
       contents <- BS.readFile (unpackFS file)
       let 
@@ -1892,12 +2077,12 @@ listAround span do_highlight = do
           line_nos = [ fst_line .. ]
 
           highlighted | do_highlight = zipWith highlight line_nos these_lines
           line_nos = [ fst_line .. ]
 
           highlighted | do_highlight = zipWith highlight line_nos these_lines
-                      | otherwise   = these_lines
+                      | otherwise    = [\p -> BS.concat[p,l] | l <- these_lines]
 
           bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
 
           bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
-          prefixed = zipWith BS.append bs_line_nos highlighted
+          prefixed = zipWith ($) highlighted bs_line_nos
       --
       --
-      BS.putStrLn (BS.join (BS.pack "\n") prefixed)
+      BS.putStrLn (BS.intercalate (BS.pack "\n") prefixed)
   where
         file  = GHC.srcSpanFile span
         line1 = GHC.srcSpanStartLine span
   where
         file  = GHC.srcSpanFile span
         line1 = GHC.srcSpanStartLine span
@@ -1912,32 +2097,33 @@ listAround span do_highlight = do
         highlight | do_bold   = highlight_bold
                   | otherwise = highlight_carets
 
         highlight | do_bold   = highlight_bold
                   | otherwise = highlight_carets
 
-        highlight_bold no line
+        highlight_bold no line prefix
           | no == line1 && no == line2
           = let (a,r) = BS.splitAt col1 line
                 (b,c) = BS.splitAt (col2-col1) r
             in
           | no == line1 && no == line2
           = let (a,r) = BS.splitAt col1 line
                 (b,c) = BS.splitAt (col2-col1) r
             in
-            BS.concat [a,BS.pack start_bold,b,BS.pack end_bold,c]
+            BS.concat [prefix, a,BS.pack start_bold,b,BS.pack end_bold,c]
           | no == line1
           = let (a,b) = BS.splitAt col1 line in
           | no == line1
           = let (a,b) = BS.splitAt col1 line in
-            BS.concat [a, BS.pack start_bold, b]
+            BS.concat [prefix, a, BS.pack start_bold, b]
           | no == line2
           = let (a,b) = BS.splitAt col2 line in
           | no == line2
           = let (a,b) = BS.splitAt col2 line in
-            BS.concat [a, BS.pack end_bold, b]
-          | otherwise   = line
+            BS.concat [prefix, a, BS.pack end_bold, b]
+          | otherwise   = BS.concat [prefix, line]
 
 
-        highlight_carets no line
+        highlight_carets no line prefix
           | no == line1 && no == line2
           | no == line1 && no == line2
-          = BS.concat [line, nl, indent, BS.replicate col1 ' ',
+          = BS.concat [prefix, line, nl, indent, BS.replicate col1 ' ',
                                          BS.replicate (col2-col1) '^']
           | no == line1
                                          BS.replicate (col2-col1) '^']
           | no == line1
-          = BS.concat [line, nl, indent, BS.replicate col1 ' ',
-                                         BS.replicate (BS.length line-col1) '^']
+          = BS.concat [indent, BS.replicate (col1 - 2) ' ', BS.pack "vv", nl, 
+                                         prefix, line]
           | no == line2
           | no == line2
-          = BS.concat [line, nl, indent, BS.replicate col2 '^']
-          | otherwise   = line
+          = BS.concat [prefix, line, nl, indent, BS.replicate col2 ' ',
+                                         BS.pack "^^"]
+          | otherwise   = BS.concat [prefix, line]
          where
          where
-           indent = BS.pack "   "
+           indent = BS.pack ("  " ++ replicate (length (show no)) ' ')
            nl = BS.singleton '\n'
 
 -- --------------------------------------------------------------------------
            nl = BS.singleton '\n'
 
 -- --------------------------------------------------------------------------
@@ -1950,7 +2136,7 @@ getTickArray modl = do
    case lookupModuleEnv arrmap modl of
       Just arr -> return arr
       Nothing  -> do
    case lookupModuleEnv arrmap modl of
       Just arr -> return arr
       Nothing  -> do
-        (breakArray, ticks) <- getModBreak modl 
+        (_breakArray, ticks) <- getModBreak modl 
         let arr = mkTickArray (assocs ticks)
         setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
         return arr
         let arr = mkTickArray (assocs ticks)
         setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
         return arr
@@ -1994,6 +2180,7 @@ deleteBreak identity = do
            mapM (turnOffBreak.snd) this
            setGHCiState $ st { breaks = rest }
 
            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)
 turnOffBreak loc = do
   (arr, _) <- getModBreak (breakModule loc)
   io $ setBreakFlag False arr (breakTick loc)
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)