MERGED: Make ":" in GHCi repeat the last command

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

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 0ac7e1c..3ae37f5 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -23,14 +23,15 @@ import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
 import PprTyThing
 import DynFlags
 
 import PprTyThing
 import DynFlags
 

-#ifdef USE_READLINE

 import Packages
 import Packages

+#ifdef USE_READLINE

 import PackageConfig
 import UniqFM
 #endif
 
 import HscTypes                ( implicitTyThings )
 import PackageConfig
 import UniqFM
 #endif
 
 import HscTypes                ( implicitTyThings )

-import Outputable       hiding (printForUser)
+import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
+import Outputable       hiding (printForUser, printForUserPartWay)

 import Module           -- for ModuleEnv
 import Name
 import SrcLoc
 import Module           -- for ModuleEnv
 import Name
 import SrcLoc

@@ -46,12 +47,12 @@ import Util
 import NameSet
 import Maybes          ( orElse )
 import FastString
 import NameSet
 import Maybes          ( orElse )
 import FastString

+import Encoding

 
 #ifndef mingw32_HOST_OS
 import System.Posix hiding (getEnv)
 #else
 import GHC.ConsoleHandler ( flushConsole )
 
 #ifndef mingw32_HOST_OS
 import System.Posix hiding (getEnv)
 #else
 import GHC.ConsoleHandler ( flushConsole )

-import System.Win32      ( setConsoleCP, setConsoleOutputCP )

 import qualified System.Win32
 #endif
 
 import qualified System.Win32
 #endif
 

@@ -74,14 +75,13 @@ 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 Control.Monad as Monad
 import Text.Printf
 import Data.Char
 import Data.Dynamic
 import Data.Array
 import Control.Monad as Monad
 import Text.Printf

-
-import Foreign.StablePtr       ( newStablePtr )
+import Foreign
+import Foreign.C        ( withCStringLen )

 import GHC.Exts                ( unsafeCoerce# )
 import GHC.IOBase      ( IOErrorType(InvalidArgument) )
 
 import GHC.Exts                ( unsafeCoerce# )
 import GHC.IOBase      ( IOErrorType(InvalidArgument) )
 

@@ -97,13 +97,11 @@ ghciWelcomeMsg :: String
 ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
                  ": http://www.haskell.org/ghc/  :? for help"
 
 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
 
 cmdName :: Command -> String
 cmdName (n,_,_,_) = n
 

-commands :: IORef [Command]
-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 = [

@@ -113,13 +111,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),

@@ -163,8 +163,11 @@ helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
  "   <statement>                 evaluate/run <statement>\n" ++
  " Commands available from the prompt:\n" ++
  "\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" ++
  "   :add <filename> ...         add module(s) to the current target set\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" ++
  "   :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" ++

@@ -223,6 +226,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" ++

@@ -230,6 +235,8 @@ 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" 
 

@@ -306,7 +313,9 @@ interactiveUI session srcs maybe_expr = do
                    break_ctr = 0,
                    breaks = [],
                    tickarrays = emptyModuleEnv,
                    break_ctr = 0,
                    breaks = [],
                    tickarrays = emptyModuleEnv,

-                   cmdqueue = []
+                   last_command = Nothing,
+                   cmdqueue = [],
+                   remembered_ctx = Nothing

                  }
 
 #ifdef USE_READLINE
                  }
 
 #ifdef USE_READLINE

@@ -330,11 +339,11 @@ runGHCi paths maybe_expr = do
          either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
          case either_hdl of
             Left _e   -> return ()
          either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
          case either_hdl of
             Left _e   -> return ()

-            Right hdl -> fileLoop hdl False
+            Right hdl -> runCommands (fileLoop hdl False 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
        Left _e -> return ()
        Right dir -> do
     case either_dir of
        Left _e -> return ()
        Right dir -> do

@@ -346,7 +355,7 @@ runGHCi paths maybe_expr = do
               either_hdl <- io (IO.try (openFile file ReadMode))
               case either_hdl of
                  Left _e   -> return ()
               either_hdl <- io (IO.try (openFile file ReadMode))
               case either_hdl of
                  Left _e   -> return ()

-                 Right hdl -> fileLoop hdl False
+                 Right hdl -> runCommands (fileLoop hdl False 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

@@ -377,9 +386,6 @@ runGHCi paths maybe_expr = do
                       | otherwise -> io (ioError err)
              Right () -> return ()
 #endif
                       | 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
             -- enter the interactive loop
             interactiveLoop is_tty show_prompt
         Just expr -> do

@@ -408,10 +414,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 is_tty)

 #else
 #else

-  fileLoop stdin show_prompt
+  runCommands (fileLoop stdin show_prompt is_tty)

 #endif
 
 
 #endif
 
 

@@ -447,32 +453,55 @@ checkPerms name =
          else return True
 #endif
 
          else return True
 #endif
 

-fileLoop :: Handle -> Bool -> GHCi ()
-fileLoop hdl show_prompt = do
+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
    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 -> 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
 
 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
 
   context_bit <-
         case resumes of

@@ -490,8 +519,14 @@ mkPrompt = do
         dots | _:rs <- resumes, not (null rs) = text "... "
              | otherwise = empty
 
         dots | _:rs <- resumes, not (null rs) = text "... "
              | otherwise = empty
 

+        
+

         modules_bit = 
         modules_bit = 

-             hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
+       -- 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
              hsep (map (ppr . GHC.moduleName) exports)
 
         deflt_prompt = dots <> context_bit <> modules_bit

@@ -506,41 +541,73 @@ mkPrompt = do
 
 
 #ifdef USE_READLINE
 
 
 #ifdef USE_READLINE

-readlineLoop :: GHCi ()
+readlineLoop :: GHCi (Maybe String)

 readlineLoop = do
    io yield
    saveSession -- for use by completion
    prompt <- mkPrompt
    l <- io (readline prompt `finally` setNonBlockingFD 0)
 readlineLoop = do
    io yield
    saveSession -- for use by completion
    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)
+                   str <- io $ consoleInputToUnicode True l
+                   return (Just str)

 #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

@@ -595,7 +662,11 @@ afterRunStmt step_here run_result = do
                printForUser $ ptext SLIT("Stopped at") <+> 
                        ppr (GHC.resumeSpan $ head resumes)
 --               printTypeOfNames session names
                printForUser $ ptext SLIT("Stopped at") <+> 
                        ppr (GHC.resumeSpan $ head resumes)
 --               printTypeOfNames session names

-               printTypeAndContentOfNames 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
                maybe (return ()) runBreakCmd mb_info
                -- run the command set with ":set stop <cmd>"
                st <- getGHCiState

@@ -612,19 +683,6 @@ afterRunStmt step_here 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
 runBreakCmd :: GHC.BreakInfo -> GHCi ()
 runBreakCmd info = do
   let mod = GHC.breakInfo_module info

@@ -652,26 +710,49 @@ printTypeOfName session n
             Nothing    -> return ()
             Just thing -> printTyThing thing
 
             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
 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
   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
 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
   -- 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, str `isPrefixOf` 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
 
 getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
 getCurrentBreakSpan = do

@@ -760,8 +841,9 @@ addModule files = do
   targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
   session <- getSession
   io (mapM_ (GHC.addTarget session) targets)
   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)
   ok <- io (GHC.load session LoadAllTargets)

-  afterLoad ok session
+  afterLoad ok session False prev_context

 
 changeDirectory :: String -> GHCi ()
 changeDirectory dir = do
 
 changeDirectory :: String -> GHCi ()
 changeDirectory dir = do

@@ -769,9 +851,10 @@ changeDirectory dir = do
   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"
   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)
   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)

-  setContextAfterLoad session []
+  setContextAfterLoad session prev_context []

   io (GHC.workingDirectoryChanged session)
   dir <- expandPath dir
   io (setCurrentDirectory dir)
   io (GHC.workingDirectoryChanged session)
   dir <- expandPath dir
   io (setCurrentDirectory dir)

@@ -819,18 +902,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"

@@ -840,8 +929,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

@@ -850,17 +939,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

@@ -883,6 +969,7 @@ loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return ()
 loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule' files = do
   session <- getSession
 loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule' files = do
   session <- getSession

+  prev_context <- io $ GHC.getContext session

 
   -- unload first
   discardActiveBreakPoints
 
   -- unload first
   discardActiveBreakPoints

@@ -901,12 +988,13 @@ 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 prev_context LoadAllTargets

 
 checkModule :: String -> GHCi ()
 checkModule m = do
   let modl = GHC.mkModuleName m
   session <- getSession
 
 checkModule :: String -> GHCi ()
 checkModule m = do
   let modl = GHC.mkModuleName m
   session <- getSession

+  prev_context <- io $ GHC.getContext session

   result <- io (GHC.checkModule session modl False)
   case result of
     Nothing -> io $ putStrLn "Nothing"
   result <- io (GHC.checkModule session modl False)
   case result of
     Nothing -> io $ putStrLn "Nothing"

@@ -919,37 +1007,74 @@ 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 False prev_context

 
 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)
+  prev_context <- io $ GHC.getContext session
+  doLoad session True prev_context $ 
+        if null m then LoadAllTargets 
+                  else LoadUpTo (GHC.mkModuleName m)

   return ()
 
   return ()
 

-doLoad :: Session -> LoadHowMuch -> GHCi SuccessFlag
-doLoad session howmuch = 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)
   -- 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
+  afterLoad ok session retain_context prev_context

   return ok
 
   return ok
 

-afterLoad :: SuccessFlag -> Session -> GHCi ()
-afterLoad ok session = do
+afterLoad :: SuccessFlag -> Session -> Bool -> ([Module],[Module]) -> GHCi ()
+afterLoad ok session retain_context prev_context = do

   io (revertCAFs)  -- always revert CAFs on load.
   discardTickArrays
   io (revertCAFs)  -- always revert CAFs on load.
   discardTickArrays

-  loaded_mods <- getLoadedModules session
-  setContextAfterLoad session loaded_mods
-  modulesLoadedMsg ok (map GHC.ms_mod_name loaded_mods)
+  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 -> [GHC.ModSummary] -> GHCi ()
-setContextAfterLoad session [] = do
+  st <- getGHCiState
+  if not retain_context
+    then do
+        setGHCiState st{ remembered_ctx = Nothing }
+        setContextAfterLoad session prev_context loaded_mod_summaries
+    else do
+        -- figure out which modules we can keep in the context, which we
+        -- have to put back, and which we have to remember because they
+        -- are (temporarily) unavailable.  See ghci.prog009, #1873, #1360
+        let (as,bs) = prev_context
+            as1 = filter isHomeModule as -- package modules are kept anyway
+            bs1 = filter isHomeModule bs
+            (as_ok, as_bad) = partition (`elem` loaded_mods) as1
+            (bs_ok, bs_bad) = partition (`elem` loaded_mods) bs1
+            (rem_as, rem_bs) = fromMaybe ([],[]) (remembered_ctx st)
+            (rem_as_ok, rem_as_bad) = partition (`elem` loaded_mods) rem_as
+            (rem_bs_ok, rem_bs_bad) = partition (`elem` loaded_mods) rem_bs
+            as' = nub (as_ok++rem_as_ok)
+            bs' = nub (bs_ok++rem_bs_ok)
+            rem_as' = nub (rem_as_bad ++ as_bad)
+            rem_bs' = nub (rem_bs_bad ++ bs_bad)
+
+         -- Put back into the context any modules that we previously had
+         -- to drop because they weren't available (rem_as_ok, rem_bs_ok).
+        setContextKeepingPackageModules session prev_context (as',bs')
+
+         -- If compilation failed, remember any modules that we are unable
+         -- to load, so that we can put them back in the context in the future.
+        case ok of
+         Succeeded -> setGHCiState st{ remembered_ctx = Nothing }
+         Failed    -> setGHCiState st{ remembered_ctx = Just (rem_as',rem_bs') }
+
+
+
+setContextAfterLoad :: Session -> ([Module],[Module]) -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad session prev [] = do

   prel_mod <- getPrelude
   prel_mod <- getPrelude

-  io (GHC.setContext session [] [prel_mod])
-setContextAfterLoad session ms = do
+  setContextKeepingPackageModules session prev ([], [prel_mod])
+setContextAfterLoad session prev 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
   -- 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

@@ -973,11 +1098,26 @@ setContextAfterLoad session ms = do
 
    load_this summary | m <- GHC.ms_mod summary = do
        b <- io (GHC.moduleIsInterpreted session m)
 
    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 ([m], [])

                     else do
                     else do

-                   prel_mod <- getPrelude
-                   io (GHC.setContext session []  [prel_mod,m])
+                prel_mod <- getPrelude
+                setContextKeepingPackageModules session prev ([],[prel_mod,m])
+
+-- | Keep any package modules (except Prelude) when changing the context.
+setContextKeepingPackageModules
+        :: Session
+        -> ([Module],[Module])          -- previous context
+        -> ([Module],[Module])          -- new context
+        -> GHCi ()
+setContextKeepingPackageModules session prev_context (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))

 
 

+isHomeModule :: Module -> Bool
+isHomeModule mod = GHC.modulePackageId mod == mainPackageId

 
 modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> GHCi ()
 modulesLoadedMsg ok mods = do
 
 modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> GHCi ()
 modulesLoadedMsg ok mods = do

@@ -1022,48 +1162,111 @@ 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 :: String -> Bool -> GHCi ()
-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
-
+  -- :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]
   -- 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)
 
   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
   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 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
 
 -----------------------------------------------------------------------------
 -- Setting the module context

@@ -1085,14 +1288,10 @@ separate :: Session -> [String] -> [Module] -> [Module]
         -> GHCi ([Module],[Module])
 separate _       []             as bs = return (as,bs)
 separate session (('*':str):ms) as bs = do
         -> GHCi ([Module],[Module])
 separate _       []             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"))
+  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 ()

@@ -1149,6 +1348,28 @@ 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
 setCmd str
   = case toArgs str of
        ("args":args) -> setArgs args

@@ -1231,7 +1452,8 @@ newDynFlags minus_opts = do
         io (GHC.setTargets session [])
         io (GHC.load session LoadAllTargets)
         io (linkPackages dflags new_pkgs)
         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 ([],[]) []

       return ()
 
 
       return ()
 
 

@@ -1302,6 +1524,8 @@ 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]")
 
 showModules :: GHCi ()
        _ -> throwDyn (CmdLineError "syntax:  :show [args|prog|prompt|editor|stop|modules|bindings|breaks|context]")
 
 showModules :: GHCi ()

@@ -1321,8 +1545,9 @@ showBindings :: GHCi ()
 showBindings = do
   s <- getSession
   bindings <- io (GHC.getBindings s)
 showBindings = do
   s <- getSession
   bindings <- io (GHC.getBindings s)

-  mapM_ printTyThing $ sortBy compareTyThings bindings
-  return ()
+  docs     <- io$ pprTypeAndContents s 
+                  [ id | AnId id <- sortBy compareTyThings bindings]
+  printForUserPartWay docs

 
 compareTyThings :: TyThing -> TyThing -> Ordering
 t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
 
 compareTyThings :: TyThing -> TyThing -> Ordering
 t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2

@@ -1347,6 +1572,26 @@ 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
 
 -- -----------------------------------------------------------------------------
 -- Completion

@@ -1368,7 +1613,7 @@ completeWord w start end = do
      ':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
      _other
        | ((':':c) : _) <- line_words -> do
      ':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
      _other
        | ((':':c) : _) <- line_words -> do

-          maybe_cmd <- lookupCommand c
+          maybe_cmd <- lookupCommand' c

            let (n,w') = selectWord (words' 0 line)
           case maybe_cmd of
             Nothing -> return Nothing
            let (n,w') = selectWord (words' 0 line)
           case maybe_cmd of
             Nothing -> return Nothing

@@ -1395,13 +1640,13 @@ completeWord w start end = do
 
 completeCmd :: String -> IO [String]
 completeCmd w = do
 
 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
 
 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

@@ -1523,7 +1768,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

@@ -1557,33 +1802,6 @@ wantNameFromInterpretedModule noCanDo str and_then = do
                                 text " is not interpreted"
                else and_then n
 
                                 text " is not interpreted"
                else and_then n
 

--- ----------------------------------------------------------------------------
--- Windows console setup
-
-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.  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()).
-       --
-        -- This call has been known to hang on some machines, see bug #1483
-        --
-       setConsoleCP 28591       -- ISO Latin-1
-       setConsoleOutputCP 28591 -- ISO Latin-1
-#endif
-       return ()
-

 -- -----------------------------------------------------------------------------
 -- commands for debugger
 
 -- -----------------------------------------------------------------------------
 -- commands for debugger