change topHandlerFastExit to topHandler, so the terminal state gets restored (#2228)
[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs
index b017560..26d548d 100644 (file)
@@ -11,12 +11,13 @@ module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
 
 #include "HsVersions.h"
 
 
 #include "HsVersions.h"
 
-import GhciMonad
+import qualified GhciMonad
+import GhciMonad hiding (runStmt)
 import GhciTags
 import Debugger
 
 -- The GHC interface
 import GhciTags
 import Debugger
 
 -- The GHC interface
-import qualified GHC
+import qualified GHC hiding (resume, runStmt)
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
                           Module, ModuleName, TyThing(..), Phase,
                           BreakIndex, SrcSpan, Resume, SingleStep )
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
                           Module, ModuleName, TyThing(..), Phase,
                           BreakIndex, SrcSpan, Resume, SingleStep )
@@ -24,7 +25,7 @@ import PprTyThing
 import DynFlags
 
 import Packages
 import DynFlags
 
 import Packages
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
 import PackageConfig
 import UniqFM
 #endif
 import PackageConfig
 import UniqFM
 #endif
@@ -54,12 +55,11 @@ import System.Posix hiding (getEnv)
 #else
 import GHC.ConsoleHandler ( flushConsole )
 import qualified System.Win32
 #else
 import GHC.ConsoleHandler ( flushConsole )
 import qualified System.Win32
-import System.FilePath
 #endif
 
 #endif
 
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
 import Control.Concurrent      ( yield )       -- Used in readline loop
 import Control.Concurrent      ( yield )       -- Used in readline loop
-import System.Console.Readline as Readline
+import System.Console.Editline.Readline as Readline
 #endif
 
 --import SystemExts
 #endif
 
 --import SystemExts
@@ -67,6 +67,7 @@ import System.Console.Readline as Readline
 import Control.Exception as Exception
 -- import Control.Concurrent
 
 import Control.Exception as Exception
 -- import Control.Concurrent
 
+import System.FilePath
 import qualified Data.ByteString.Char8 as BS
 import Data.List
 import Data.Maybe
 import qualified Data.ByteString.Char8 as BS
 import Data.List
 import Data.Maybe
@@ -82,13 +83,14 @@ import Data.Array
 import Control.Monad as Monad
 import Text.Printf
 import Foreign
 import Control.Monad as Monad
 import Text.Printf
 import Foreign
-import Foreign.C        ( withCStringLen )
+import Foreign.C
 import GHC.Exts                ( unsafeCoerce# )
 import GHC.IOBase      ( IOErrorType(InvalidArgument) )
 import GHC.Exts                ( unsafeCoerce# )
 import GHC.IOBase      ( IOErrorType(InvalidArgument) )
+import GHC.TopHandler
 
 import Data.IORef      ( IORef, readIORef, writeIORef )
 
 
 import Data.IORef      ( IORef, readIORef, writeIORef )
 
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
 import System.Posix.Internals ( setNonBlockingFD )
 #endif
 
 import System.Posix.Internals ( setNonBlockingFD )
 #endif
 
@@ -101,7 +103,6 @@ ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
 cmdName :: Command -> String
 cmdName (n,_,_,_) = n
 
 cmdName :: Command -> String
 cmdName (n,_,_,_) = n
 
-macros_ref :: IORef [Command]
 GLOBAL_VAR(macros_ref, [], [Command])
 
 builtin_commands :: [Command]
 GLOBAL_VAR(macros_ref, [], [Command])
 
 builtin_commands :: [Command]
@@ -138,6 +139,7 @@ builtin_commands = [
   ("print",     keepGoing printCmd,             Nothing, completeIdentifier),
   ("quit",     quit,                           Nothing, completeNone),
   ("reload",   keepGoing reloadModule,         Nothing, completeNone),
   ("print",     keepGoing printCmd,             Nothing, completeIdentifier),
   ("quit",     quit,                           Nothing, completeNone),
   ("reload",   keepGoing reloadModule,         Nothing, completeNone),
+  ("run",      keepGoing runRun,               Nothing, completeIdentifier),
   ("set",      keepGoing setCmd,               Just flagWordBreakChars, completeSetOptions),
   ("show",     keepGoing showCmd,              Nothing, completeNone),
   ("sprint",    keepGoing sprintCmd,            Nothing, completeIdentifier),
   ("set",      keepGoing setCmd,               Just flagWordBreakChars, completeSetOptions),
   ("show",     keepGoing showCmd,              Nothing, completeNone),
   ("sprint",    keepGoing sprintCmd,            Nothing, completeIdentifier),
@@ -159,7 +161,7 @@ builtin_commands = [
 -- 
 -- NOTE: in order for us to override the default correctly, any custom entry
 -- must be a SUBSET of word_break_chars.
 -- 
 -- NOTE: in order for us to override the default correctly, any custom entry
 -- must be a SUBSET of word_break_chars.
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
 word_break_chars :: String
 word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~"
                        specials = "(),;[]`{}"
 word_break_chars :: String
 word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~"
                        specials = "(),;[]`{}"
@@ -176,7 +178,11 @@ keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
 keepGoing a str = a str >> return False
 
 keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
 keepGoing a str = a str >> return False
 
 keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
-keepGoingPaths a str = a (toArgs str) >> return False
+keepGoingPaths a str
+ = do case toArgs str of
+          Left err -> io (hPutStrLn stderr err)
+          Right args -> a args
+      return False
 
 shortHelpText :: String
 shortHelpText = "use :? for help.\n"
 
 shortHelpText :: String
 shortHelpText = "use :? for help.\n"
@@ -206,6 +212,7 @@ helpText =
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
+ "   :run function [<arguments> ...] run the function with the given arguments\n" ++
  "   :type <expr>                show the type of <expr>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :!<command>                 run the shell command <command>\n" ++
  "   :type <expr>                show the type of <expr>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :!<command>                 run the shell command <command>\n" ++
@@ -221,15 +228,18 @@ helpText =
  "   :delete *                   delete all breakpoints\n" ++
  "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
  "   :forward                    go forward in the history (after :back)\n" ++
  "   :delete *                   delete all breakpoints\n" ++
  "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
  "   :forward                    go forward in the history (after :back)\n" ++
- "   :history [<n>]              show the last <n> items in the history (after :trace)\n" ++
+ "   :history [<n>]              after :trace, show the execution history\n" ++
+ "   :list                       show the source code around current breakpoint\n" ++
+ "   :list identifier            show the source code for <identifier>\n" ++
+ "   :list [<module>] <line>     show the source code around line number <line>\n" ++
  "   :print [<name> ...]         prints a value without forcing its computation\n" ++
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
  "   :print [<name> ...]         prints a value without forcing its computation\n" ++
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
- "   :steplocal                  single-step restricted to the current top level decl.\n"++
+ "   :steplocal                  single-step within the current top-level binding\n"++
  "   :stepmodule                 single-step restricted to the current module\n"++
  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :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 <expr>               evaluate <expr> with tracing on (see :history)\n"++
 
  "\n" ++
  " -- Commands for changing settings:\n" ++
 
  "\n" ++
  " -- Commands for changing settings:\n" ++
@@ -260,7 +270,8 @@ helpText =
  "   :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 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" ++
+ "   :show <setting>             show value of <setting>, which is one of\n" ++
+ "                                  [args, prog, prompt, editor, stop]\n" ++
  "\n" 
 
 findEditor :: IO String
  "\n" 
 
 findEditor :: IO String
@@ -274,8 +285,9 @@ findEditor = do
         return ""
 #endif
 
         return ""
 #endif
 
-interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
-interactiveUI session srcs maybe_expr = do
+interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe [String]
+              -> IO ()
+interactiveUI session srcs maybe_exprs = do
    -- HACK! If we happen to get into an infinite loop (eg the user
    -- types 'let x=x in x' at the prompt), then the thread will block
    -- on a blackhole, and become unreachable during GC.  The GC will
    -- HACK! If we happen to get into an infinite loop (eg the user
    -- types 'let x=x in x' at the prompt), then the thread will block
    -- on a blackhole, and become unreachable during GC.  The GC will
@@ -291,7 +303,7 @@ interactiveUI session srcs maybe_expr = do
     -- Initialise buffering for the *interpreted* I/O system
    initInterpBuffering session
 
     -- Initialise buffering for the *interpreted* I/O system
    initInterpBuffering session
 
-   when (isNothing maybe_expr) $ do
+   when (isNothing maybe_exprs) $ do
         -- Only for GHCi (not runghc and ghc -e):
 
         -- Turn buffering off for the compiled program's stdout/stderr
         -- Only for GHCi (not runghc and ghc -e):
 
         -- Turn buffering off for the compiled program's stdout/stderr
@@ -303,10 +315,15 @@ interactiveUI session srcs maybe_expr = do
         -- intended for the program, so unbuffer stdin.
         hSetBuffering stdin NoBuffering
 
         -- intended for the program, so unbuffer stdin.
         hSetBuffering stdin NoBuffering
 
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
         is_tty <- hIsTerminalDevice stdin
         when is_tty $ do
             Readline.initialize
         is_tty <- hIsTerminalDevice stdin
         when is_tty $ do
             Readline.initialize
+
+            withGhcAppData
+                 (\dir -> Readline.readHistory (dir </> "ghci_history"))
+                 (return True)
+            
             Readline.setAttemptedCompletionFunction (Just completeWord)
             --Readline.parseAndBind "set show-all-if-ambiguous 1"
 
             Readline.setAttemptedCompletionFunction (Just completeWord)
             --Readline.parseAndBind "set show-all-if-ambiguous 1"
 
@@ -322,7 +339,9 @@ interactiveUI session srcs maybe_expr = do
 
    default_editor <- findEditor
 
 
    default_editor <- findEditor
 
-   startGHCi (runGHCi srcs maybe_expr)
+   cwd <- getCurrentDirectory
+
+   startGHCi (runGHCi srcs maybe_exprs)
         GHCiState{ progname = "<interactive>",
                    args = [],
                    prompt = "%s> ",
         GHCiState{ progname = "<interactive>",
                    args = [],
                    prompt = "%s> ",
@@ -336,47 +355,65 @@ interactiveUI session srcs maybe_expr = do
                    tickarrays = emptyModuleEnv,
                    last_command = Nothing,
                    cmdqueue = [],
                    tickarrays = emptyModuleEnv,
                    last_command = Nothing,
                    cmdqueue = [],
-                   remembered_ctx = Nothing
+                   remembered_ctx = [],
+                   virtual_path   = cwd,
+                   ghc_e = isJust maybe_exprs
                  }
 
                  }
 
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
+   Readline.stifleHistory 100
+   withGhcAppData (\dir -> Readline.writeHistory (dir </> "ghci_history"))
+                  (return True)
    Readline.resetTerminal Nothing
 #endif
 
    return ()
 
    Readline.resetTerminal Nothing
 #endif
 
    return ()
 
-runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi ()
-runGHCi paths maybe_expr = do
-  let read_dot_files = not opt_IgnoreDotGhci
+withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a
+withGhcAppData right left = do
+   either_dir <- IO.try (getAppUserDataDirectory "ghc")
+   case either_dir of
+      Right dir -> right dir
+      _ -> left
 
 
-  when (read_dot_files) $ do
-    -- Read in ./.ghci.
-    let file = "./.ghci"
-    exists <- io (doesFileExist file)
-    when exists $ do
-       dir_ok  <- io (checkPerms ".")
-       file_ok <- io (checkPerms file)
+
+runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
+runGHCi paths maybe_exprs = do
+  let 
+   read_dot_files = not opt_IgnoreDotGhci
+
+   current_dir = return (Just ".ghci")
+
+   app_user_dir = io $ withGhcAppData 
+                    (\dir -> return (Just (dir </> "ghci.conf")))
+                    (return Nothing)
+
+   home_dir = do
+    either_dir <- io $ IO.try (getEnv "HOME")
+    case either_dir of
+      Right home -> return (Just (home </> ".ghci"))
+      _ -> return Nothing
+
+   sourceConfigFile :: FilePath -> GHCi ()
+   sourceConfigFile file = do
+     exists <- io $ doesFileExist file
+     when exists $ do
+       dir_ok  <- io $ checkPerms (getDirectory file)
+       file_ok <- io $ checkPerms file
        when (dir_ok && file_ok) $ do
        when (dir_ok && file_ok) $ do
-          either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
-          case either_hdl of
-             Left _e   -> return ()
-             Right hdl -> runCommands (fileLoop hdl False False)
+         either_hdl <- io $ IO.try (openFile file ReadMode)
+         case either_hdl of
+           Left _e   -> return ()
+           Right hdl -> runCommands (fileLoop hdl False False)
+     where
+      getDirectory f = case takeDirectory f of "" -> "."; d -> d
 
   when (read_dot_files) $ do
 
   when (read_dot_files) $ do
-    -- Read in $HOME/.ghci
-    either_dir <- io (IO.try getHomeDirectory)
-    case either_dir of
-       Left _e -> return ()
-       Right dir -> do
-          cwd <- io (getCurrentDirectory)
-          when (dir /= cwd) $ do
-             let file = dir ++ "/.ghci"
-             ok <- io (checkPerms file)
-             when ok $ do
-               either_hdl <- io (IO.try (openFile file ReadMode))
-               case either_hdl of
-                  Left _e   -> return ()
-                  Right hdl -> runCommands (fileLoop hdl False False)
+    cfgs0 <- sequence [ current_dir, app_user_dir, home_dir ]
+    cfgs <- io $ mapM canonicalizePath (catMaybes cfgs0)
+    mapM_ sourceConfigFile (nub cfgs)
+        -- nub, because we don't want to read .ghci twice if the
+        -- CWD is $HOME.
 
   -- Perform a :load for files given on the GHCi command line
   -- When in -e mode, if the load fails then we want to stop
 
   -- Perform a :load for files given on the GHCi command line
   -- When in -e mode, if the load fails then we want to stop
@@ -384,7 +421,7 @@ runGHCi paths maybe_expr = do
   when (not (null paths)) $ do
      ok <- ghciHandle (\e -> do showException e; return Failed) $
                 loadModule paths
   when (not (null paths)) $ do
      ok <- ghciHandle (\e -> do showException e; return Failed) $
                 loadModule paths
-     when (isJust maybe_expr && failed ok) $
+     when (isJust maybe_exprs && failed ok) $
         io (exitWith (ExitFailure 1))
 
   -- if verbosity is greater than 0, or we are connected to a
         io (exitWith (ExitFailure 1))
 
   -- if verbosity is greater than 0, or we are connected to a
@@ -393,7 +430,7 @@ runGHCi paths maybe_expr = do
   dflags <- getDynFlags
   let show_prompt = verbosity dflags > 0 || is_tty
 
   dflags <- getDynFlags
   let show_prompt = verbosity dflags > 0 || is_tty
 
-  case maybe_expr of
+  case maybe_exprs of
         Nothing ->
           do
 #if defined(mingw32_HOST_OS)
         Nothing ->
           do
 #if defined(mingw32_HOST_OS)
@@ -409,15 +446,21 @@ runGHCi paths maybe_expr = do
 #endif
             -- enter the interactive loop
             interactiveLoop is_tty show_prompt
 #endif
             -- enter the interactive loop
             interactiveLoop is_tty show_prompt
-        Just expr -> do
+        Just exprs -> do
             -- just evaluate the expression we were given
             -- just evaluate the expression we were given
-            runCommandEval expr
-            return ()
+            enqueueCommands exprs
+            let handle e = do st <- getGHCiState
+                                   -- Jump through some hoops to get the
+                                   -- current progname in the exception text:
+                                   -- <progname>: <exception>
+                              io $ withProgName (progname st)
+                                   -- this used to be topHandlerFastExit, see #2228
+                                 $ topHandler e
+            runCommands' handle (return Nothing)
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
-
 interactiveLoop :: Bool -> Bool -> GHCi ()
 interactiveLoop is_tty show_prompt =
   -- Ignore ^C exceptions caught here
 interactiveLoop :: Bool -> Bool -> GHCi ()
 interactiveLoop is_tty show_prompt =
   -- Ignore ^C exceptions caught here
@@ -433,7 +476,7 @@ interactiveLoop is_tty show_prompt =
                   -- exception handler above.
 
   -- read commands from stdin
                   -- exception handler above.
 
   -- read commands from stdin
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
   if (is_tty) 
        then runCommands readlineLoop
        else runCommands (fileLoop stdin show_prompt is_tty)
   if (is_tty) 
        then runCommands readlineLoop
        else runCommands (fileLoop stdin show_prompt is_tty)
@@ -561,7 +604,7 @@ mkPrompt = do
   return (showSDoc (f (prompt st)))
 
 
   return (showSDoc (f (prompt st)))
 
 
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
 readlineLoop :: GHCi (Maybe String)
 readlineLoop = do
    io yield
 readlineLoop :: GHCi (Maybe String)
 readlineLoop = do
    io yield
@@ -573,6 +616,7 @@ readlineLoop = do
    splatSavedSession
    case l of
         Nothing -> return Nothing
    splatSavedSession
    case l of
         Nothing -> return Nothing
+        Just "" -> return (Just "") -- Don't put empty lines in the history
         Just l  -> do
                    io (addHistory l)
                    str <- io $ consoleInputToUnicode True l
         Just l  -> do
                    io (addHistory l)
                    str <- io $ consoleInputToUnicode True l
@@ -588,14 +632,18 @@ queryQueue = do
                return (Just c)
 
 runCommands :: GHCi (Maybe String) -> GHCi ()
                return (Just c)
 
 runCommands :: GHCi (Maybe String) -> GHCi ()
-runCommands getCmd = do
+runCommands = runCommands' handler
+
+runCommands' :: (Exception -> GHCi Bool) -- Exception handler
+             -> GHCi (Maybe String) -> GHCi ()
+runCommands' eh getCmd = do
   mb_cmd <- noSpace queryQueue
   mb_cmd <- maybe (noSpace getCmd) (return . Just) mb_cmd
   case mb_cmd of 
     Nothing -> return ()
     Just c  -> do
   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
+      b <- ghciHandle eh (doCommand c)
+      if b then return () else runCommands' eh getCmd
   where
     noSpace q = q >>= maybe (return Nothing)
                             (\c->case removeSpaces c of 
   where
     noSpace q = q >>= maybe (return Nothing)
                             (\c->case removeSpaces c of 
@@ -636,36 +684,14 @@ enqueueCommands cmds = do
   setGHCiState st{ cmdqueue = cmds ++ cmdqueue st }
 
 
   setGHCiState st{ cmdqueue = cmds ++ cmdqueue st }
 
 
--- This version is for the GHC command-line option -e.  The only difference
--- from runCommand is that it catches the ExitException exception and
--- exits, rather than printing out the exception.
-runCommandEval :: String -> GHCi Bool
-runCommandEval c = ghciHandle handleEval (doCommand c)
-  where 
-    handleEval (ExitException code) = io (exitWith code)
-    handleEval e                    = do handler e
-                                        io (exitWith (ExitFailure 1))
-
-    doCommand (':' : command) = specialCommand command
-    doCommand stmt
-       = do r <- runStmt stmt GHC.RunToCompletion
-           case r of 
-               False -> io (exitWith (ExitFailure 1))
-                 -- failure to run the command causes exit(1) for ghc -e.
-               _       -> return True
-
 runStmt :: String -> SingleStep -> GHCi Bool
 runStmt stmt step
  | null (filter (not.isSpace) stmt) = return False
  | ["import", mod] <- words stmt    = keepGoing setContext ('+':mod)
  | otherwise
 runStmt :: String -> SingleStep -> GHCi Bool
 runStmt stmt step
  | null (filter (not.isSpace) stmt) = return False
  | ["import", mod] <- words stmt    = keepGoing setContext ('+':mod)
  | otherwise
- = do st <- getGHCiState
-      session <- getSession
-      result <- io $ withProgName (progname st) $ withArgs (args st) $
-                    GHC.runStmt session stmt step
+ = do result <- GhciMonad.runStmt stmt step
       afterRunStmt (const True) result
 
       afterRunStmt (const True) result
 
-
 --afterRunStmt :: GHC.RunResult -> GHCi Bool
                                  -- False <=> the statement failed to compile
 afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
 --afterRunStmt :: GHC.RunResult -> GHCi Bool
                                  -- False <=> the statement failed to compile
 afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
@@ -680,7 +706,7 @@ afterRunStmt step_here run_result = do
      GHC.RunBreak _ names mb_info 
          | isNothing  mb_info || 
            step_here (GHC.resumeSpan $ head resumes) -> do
      GHC.RunBreak _ names mb_info 
          | isNothing  mb_info || 
            step_here (GHC.resumeSpan $ head resumes) -> do
-               printForUser $ ptext SLIT("Stopped at") <+> 
+               printForUser $ ptext (sLit "Stopped at") <+> 
                        ppr (GHC.resumeSpan $ head resumes)
 --               printTypeOfNames session names
                let namesSorted = sortBy compareNames names
                        ppr (GHC.resumeSpan $ head resumes)
 --               printTypeOfNames session names
                let namesSorted = sortBy compareNames names
@@ -693,14 +719,14 @@ afterRunStmt step_here run_result = do
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()
-         | otherwise -> io(GHC.resume session GHC.SingleStep) >>= 
+         | otherwise -> resume GHC.SingleStep >>=
                         afterRunStmt step_here >> return ()
      _ -> return ()
 
   flushInterpBuffers
   io installSignalHandlers
   b <- isOptionSet RevertCAFs
                         afterRunStmt step_here >> return ()
      _ -> return ()
 
   flushInterpBuffers
   io installSignalHandlers
   b <- isOptionSet RevertCAFs
-  io (when b revertCAFs)
+  when b revertCAFs
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 
@@ -851,13 +877,26 @@ pprInfo pefas (thing, fixity, insts)
        | otherwise                = ppr fix <+> ppr (GHC.getName thing)
 
 runMain :: String -> GHCi ()
        | otherwise                = ppr fix <+> ppr (GHC.getName thing)
 
 runMain :: String -> GHCi ()
-runMain args = do
-  let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))
-  enqueueCommands  ['[': ss ++ "] `System.Environment.withArgs` main"]
+runMain s = case toArgs s of
+            Left err   -> io (hPutStrLn stderr err)
+            Right args ->
+                do dflags <- getDynFlags
+                   case mainFunIs dflags of
+                       Nothing -> doWithArgs args "main"
+                       Just f  -> doWithArgs args f
+
+runRun :: String -> GHCi ()
+runRun s = case toCmdArgs s of
+           Left err          -> io (hPutStrLn stderr err)
+           Right (cmd, args) -> doWithArgs args cmd
+
+doWithArgs :: [String] -> String -> GHCi ()
+doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++
+                                       show args ++ " (" ++ cmd ++ ")"]
 
 addModule :: [FilePath] -> GHCi ()
 addModule files = do
 
 addModule :: [FilePath] -> GHCi ()
 addModule files = do
-  io (revertCAFs)                      -- always revert CAFs on load/add.
+  revertCAFs                   -- always revert CAFs on load/add.
   files <- mapM expandPath files
   targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
   session <- getSession
   files <- mapM expandPath files
   targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
   session <- getSession
@@ -881,7 +920,7 @@ changeDirectory dir = do
   prev_context <- io $ GHC.getContext session
   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)
   prev_context <- io $ GHC.getContext session
   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)
-  setContextAfterLoad session prev_context []
+  setContextAfterLoad session prev_context False []
   io (GHC.workingDirectoryChanged session)
   dir <- expandPath dir
   io (setCurrentDirectory dir)
   io (GHC.workingDirectoryChanged session)
   dir <- expandPath dir
   io (setCurrentDirectory dir)
@@ -1056,52 +1095,21 @@ doLoad session retain_context prev_context howmuch = do
 
 afterLoad :: SuccessFlag -> Session -> Bool -> ([Module],[Module]) -> GHCi ()
 afterLoad ok session retain_context prev_context = do
 
 afterLoad :: SuccessFlag -> Session -> Bool -> ([Module],[Module]) -> GHCi ()
 afterLoad ok session retain_context prev_context = do
-  io (revertCAFs)  -- always revert CAFs on load.
+  revertCAFs  -- always revert CAFs on load.
   discardTickArrays
   loaded_mod_summaries <- getLoadedModules session
   let loaded_mods = map GHC.ms_mod loaded_mod_summaries
       loaded_mod_names = map GHC.moduleName loaded_mods
   modulesLoadedMsg ok loaded_mod_names
 
   discardTickArrays
   loaded_mod_summaries <- getLoadedModules session
   let loaded_mods = map GHC.ms_mod loaded_mod_summaries
       loaded_mod_names = map GHC.moduleName loaded_mods
   modulesLoadedMsg ok loaded_mod_names
 
-  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
+  setContextAfterLoad session prev_context retain_context loaded_mod_summaries
+
+
+setContextAfterLoad :: Session -> ([Module],[Module]) -> Bool -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad session prev keep_ctxt [] = do
   prel_mod <- getPrelude
   prel_mod <- getPrelude
-  setContextKeepingPackageModules session prev ([], [prel_mod])
-setContextAfterLoad session prev ms = do
+  setContextKeepingPackageModules session prev keep_ctxt ([], [prel_mod])
+setContextAfterLoad session prev keep_ctxt ms = do
   -- load a target if one is available, otherwise load the topmost module.
   targets <- io (GHC.getTargets session)
   case [ m | Just m <- map (findTarget ms) targets ] of
   -- 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
@@ -1125,23 +1133,31 @@ setContextAfterLoad session prev 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 setContextKeepingPackageModules session prev ([m], [])
+       if b then setContextKeepingPackageModules session prev keep_ctxt ([m], [])
                     else do
                 prel_mod <- getPrelude
                     else do
                 prel_mod <- getPrelude
-                setContextKeepingPackageModules session prev ([],[prel_mod,m])
+                setContextKeepingPackageModules session prev keep_ctxt ([],[prel_mod,m])
 
 -- | Keep any package modules (except Prelude) when changing the context.
 setContextKeepingPackageModules
         :: Session
         -> ([Module],[Module])          -- previous context
 
 -- | Keep any package modules (except Prelude) when changing the context.
 setContextKeepingPackageModules
         :: Session
         -> ([Module],[Module])          -- previous context
+        -> Bool                         -- re-execute :module commands
         -> ([Module],[Module])          -- new context
         -> GHCi ()
         -> ([Module],[Module])          -- new context
         -> GHCi ()
-setContextKeepingPackageModules session prev_context (as,bs) = do
+setContextKeepingPackageModules session prev_context keep_ctxt (as,bs) = do
   let (_,bs0) = prev_context
   prel_mod <- getPrelude
   let pkg_modules = filter (\p -> not (isHomeModule p) && p /= prel_mod) bs0
   let bs1 = if null as then nub (prel_mod : bs) else bs
   io $ GHC.setContext session as (nub (bs1 ++ pkg_modules))
   let (_,bs0) = prev_context
   prel_mod <- getPrelude
   let pkg_modules = filter (\p -> not (isHomeModule p) && p /= prel_mod) bs0
   let bs1 = if null as then nub (prel_mod : bs) else bs
   io $ GHC.setContext session as (nub (bs1 ++ pkg_modules))
+  if keep_ctxt
+     then do
+          st <- getGHCiState
+          mapM_ (playCtxtCmd False) (remembered_ctx st)
+     else do
+          st <- getGHCiState
+          setGHCiState st{ remembered_ctx = [] }
 
 isHomeModule :: Module -> Bool
 isHomeModule mod = GHC.modulePackageId mod == mainPackageId
 
 isHomeModule :: Module -> Bool
 isHomeModule mod = GHC.modulePackageId mod == mainPackageId
@@ -1300,60 +1316,65 @@ browseModule bang modl exports_only = do
 
 setContext :: String -> GHCi ()
 setContext str
 
 setContext :: String -> GHCi ()
 setContext str
-  | all sensible mods = fn mods
+  | all sensible strs = do
+       playCtxtCmd True (cmd, as, bs)
+       st <- getGHCiState
+       setGHCiState st{ remembered_ctx = remembered_ctx st ++ [(cmd,as,bs)] }
   | otherwise = throwDyn (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
   where
   | otherwise = throwDyn (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
   where
-    (fn, mods) = case str of 
-                       '+':stuff -> (addToContext,      words stuff)
-                       '-':stuff -> (removeFromContext, words stuff)
-                       stuff     -> (newContext,        words stuff) 
+    (cmd, strs, as, bs) =
+        case str of 
+                '+':stuff -> rest AddModules stuff
+                '-':stuff -> rest RemModules stuff
+                stuff     -> rest SetContext stuff
+
+    rest cmd stuff = (cmd, strs, as, bs)
+       where strs = words stuff
+             (as,bs) = partitionWith starred strs
 
     sensible ('*':m) = looksLikeModuleName m
     sensible m       = looksLikeModuleName m
 
 
     sensible ('*':m) = looksLikeModuleName m
     sensible m       = looksLikeModuleName m
 
-separate :: Session -> [String] -> [Module] -> [Module] 
-        -> GHCi ([Module],[Module])
-separate _       []             as bs = return (as,bs)
-separate session (('*':str):ms) as bs = do
-  m <- wantInterpretedModule str
-  separate session ms (m:as) bs
-separate session (str:ms) as bs = do
-  m <- lookupModule str
-  separate session ms as (m:bs)
-
-newContext :: [String] -> GHCi ()
-newContext strs = do
-  s <- getSession
-  (as,bs) <- separate s strs [] []
-  prel_mod <- getPrelude
-  let bs' = if null as && prel_mod `notElem` bs then prel_mod:bs else bs
-  io $ GHC.setContext s as bs'
-
-
-addToContext :: [String] -> GHCi ()
-addToContext strs = do
-  s <- getSession
-  (as,bs) <- io $ GHC.getContext s
-
-  (new_as,new_bs) <- separate s strs [] []
-
-  let as_to_add = new_as \\ (as ++ bs)
-      bs_to_add = new_bs \\ (as ++ bs)
-
-  io $ GHC.setContext s (as ++ as_to_add) (bs ++ bs_to_add)
+    starred ('*':m) = Left m
+    starred m       = Right m
 
 
-
-removeFromContext :: [String] -> GHCi ()
-removeFromContext strs = do
-  s <- getSession
-  (as,bs) <- io $ GHC.getContext s
-
-  (as_to_remove,bs_to_remove) <- separate s strs [] []
-
-  let as' = as \\ (as_to_remove ++ bs_to_remove)
-      bs' = bs \\ (as_to_remove ++ bs_to_remove)
-
-  io $ GHC.setContext s as' bs'
+playCtxtCmd :: Bool -> (CtxtCmd, [String], [String]) -> GHCi ()
+playCtxtCmd fail (cmd, as, bs)
+  = do
+    s <- getSession
+    (as',bs') <- do_checks fail
+    (prev_as,prev_bs) <- io $ GHC.getContext s
+    (new_as, new_bs) <-
+      case cmd of
+        SetContext -> do
+          prel_mod <- getPrelude
+          let bs'' = if null as && prel_mod `notElem` bs' then prel_mod:bs'
+                                                          else bs'
+          return (as',bs'')
+        AddModules -> do
+          let as_to_add = as' \\ (prev_as ++ prev_bs)
+              bs_to_add = bs' \\ (prev_as ++ prev_bs)
+          return (prev_as ++ as_to_add, prev_bs ++ bs_to_add)
+        RemModules -> do
+          let new_as = prev_as \\ (as' ++ bs')
+              new_bs = prev_bs \\ (as' ++ bs')
+          return (new_as, new_bs)
+    io $ GHC.setContext s new_as new_bs
+  where
+    do_checks True = do
+      as' <- mapM wantInterpretedModule as
+      bs' <- mapM lookupModule bs
+      return (as',bs')
+    do_checks False = do
+      as' <- mapM (trymaybe . wantInterpretedModule) as
+      bs' <- mapM (trymaybe . lookupModule) bs
+      return (catMaybes as', catMaybes bs')
+
+    trymaybe m = do
+        r <- ghciTry m
+        case r of
+          Left _  -> return Nothing
+          Right a -> return (Just a)
 
 ----------------------------------------------------------------------------
 -- Code for `:set'
 
 ----------------------------------------------------------------------------
 -- Code for `:set'
@@ -1398,27 +1419,32 @@ setCmd ""
                 ,Opt_PrintEvldWithShow
                 ] 
 setCmd str
                 ,Opt_PrintEvldWithShow
                 ] 
 setCmd str
-  = case toArgs str of
-       ("args":args) -> setArgs args
-       ("prog":prog) -> setProg prog
-        ("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
-
-setArgs, setProg, setOptions :: [String] -> GHCi ()
-setEditor, setStop, setPrompt :: String -> GHCi ()
+  = case getCmd str of
+    Right ("args",   rest) ->
+        case toArgs rest of
+            Left err -> io (hPutStrLn stderr err)
+            Right args -> setArgs args
+    Right ("prog",   rest) ->
+        case toArgs rest of
+            Right [prog] -> setProg prog
+            _ -> io (hPutStrLn stderr "syntax: :set prog <progname>")
+    Right ("prompt", rest) -> setPrompt $ dropWhile isSpace rest
+    Right ("editor", rest) -> setEditor $ dropWhile isSpace rest
+    Right ("stop",   rest) -> setStop   $ dropWhile isSpace rest
+    _ -> case toArgs str of
+         Left err -> io (hPutStrLn stderr err)
+         Right wds -> setOptions wds
+
+setArgs, setOptions :: [String] -> GHCi ()
+setProg, setEditor, setStop, setPrompt :: String -> GHCi ()
 
 setArgs args = do
   st <- getGHCiState
   setGHCiState st{ args = args }
 
 
 setArgs args = do
   st <- getGHCiState
   setGHCiState st{ args = args }
 
-setProg [prog] = do
+setProg prog = do
   st <- getGHCiState
   setGHCiState st{ progname = prog }
   st <- getGHCiState
   setGHCiState st{ progname = prog }
-setProg _ = do
-  io (hPutStrLn stderr "syntax: :set prog <progname>")
 
 setEditor cmd = do
   st <- getGHCiState
 
 setEditor cmd = do
   st <- getGHCiState
@@ -1480,7 +1506,7 @@ newDynFlags minus_opts = do
         io (GHC.load session LoadAllTargets)
         io (linkPackages dflags new_pkgs)
         -- package flags changed, we can't re-use any of the old context
         io (GHC.load session LoadAllTargets)
         io (linkPackages dflags new_pkgs)
         -- package flags changed, we can't re-use any of the old context
-        setContextAfterLoad session ([],[]) []
+        setContextAfterLoad session ([],[]) False []
       return ()
 
 
       return ()
 
 
@@ -1553,7 +1579,8 @@ showCmd str = do
         ["context"]  -> showContext
         ["packages"]  -> showPackages
         ["languages"]  -> showLanguages
         ["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\n"++
+                                     "               | breaks | context | packages | languages ]"))
 
 showModules :: GHCi ()
 showModules = do
 
 showModules :: GHCi ()
 showModules = do
@@ -1596,8 +1623,8 @@ showContext = do
    printForUser $ vcat (map pp_resume (reverse resumes))
   where
    pp_resume resume =
    printForUser $ vcat (map pp_resume (reverse resumes))
   where
    pp_resume resume =
-        ptext SLIT("--> ") <> text (GHC.resumeStmt resume)
-        $$ nest 2 (ptext SLIT("Stopped at") <+> ppr (GHC.resumeSpan resume))
+        ptext (sLit "--> ") <> text (GHC.resumeStmt resume)
+        $$ nest 2 (ptext (sLit "Stopped at") <+> ppr (GHC.resumeSpan resume))
 
 showPackages :: GHCi ()
 showPackages = do
 
 showPackages :: GHCi ()
 showPackages = do
@@ -1631,7 +1658,7 @@ completeMacro, completeIdentifier, completeModule,
     completeHomeModuleOrFile 
     :: String -> IO [String]
 
     completeHomeModuleOrFile 
     :: String -> IO [String]
 
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
 completeWord :: String -> Int -> Int -> IO (Maybe (String, [String]))
 completeWord w start end = do
   line <- Readline.getLineBuffer
 completeWord :: String -> Int -> Int -> IO (Maybe (String, [String]))
 completeWord w start end = do
   line <- Readline.getLineBuffer
@@ -1811,6 +1838,8 @@ ghciHandle h (GHCi m) = GHCi $ \s ->
 ghciUnblock :: GHCi a -> GHCi a
 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
 
 ghciUnblock :: GHCi a -> GHCi a
 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
 
+ghciTry :: GHCi a -> GHCi (Either Exception a)
+ghciTry (GHCi m) = GHCi $ \s -> Exception.try (m s) 
 
 -- ----------------------------------------------------------------------------
 -- Utils
 
 -- ----------------------------------------------------------------------------
 -- Utils
@@ -1917,8 +1946,7 @@ continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
 -- doContinue :: SingleStep -> GHCi ()
 doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
 doContinue pred step = do 
 -- doContinue :: SingleStep -> GHCi ()
 doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
 doContinue pred step = do 
-  session <- getSession
-  runResult <- io $ GHC.resume session step
+  runResult <- resume step
   afterRunStmt pred runResult
   return ()
 
   afterRunStmt pred runResult
   return ()
 
@@ -1982,7 +2010,7 @@ backCmd :: String -> GHCi ()
 backCmd = noArgs $ do
   s <- getSession
   (names, _, span) <- io $ GHC.back s
 backCmd = noArgs $ do
   s <- getSession
   (names, _, span) <- io $ GHC.back s
-  printForUser $ ptext SLIT("Logged breakpoint at") <+> ppr span
+  printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr span
   printTypeOfNames s names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
   printTypeOfNames s names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
@@ -1993,8 +2021,8 @@ forwardCmd = noArgs $ do
   s <- getSession
   (names, ix, span) <- io $ GHC.forward s
   printForUser $ (if (ix == 0)
   s <- getSession
   (names, ix, span) <- io $ GHC.forward s
   printForUser $ (if (ix == 0)
-                    then ptext SLIT("Stopped at")
-                    else ptext SLIT("Logged breakpoint at")) <+> ppr span
+                    then ptext (sLit "Stopped at")
+                    else ptext (sLit "Logged breakpoint at")) <+> ppr span
   printTypeOfNames s names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
   printTypeOfNames s names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
@@ -2010,7 +2038,7 @@ breakSwitch :: Session -> [String] -> GHCi ()
 breakSwitch _session [] = do
    io $ putStrLn "The break command requires at least one argument."
 breakSwitch session (arg1:rest) 
 breakSwitch _session [] = do
    io $ putStrLn "The break command requires at least one argument."
 breakSwitch session (arg1:rest) 
-   | looksLikeModuleName arg1 = do
+   | looksLikeModuleName arg1 && not (null rest) = do
         mod <- wantInterpretedModule arg1
         breakByModule mod rest
    | all isDigit arg1 = do
         mod <- wantInterpretedModule arg1
         breakByModule mod rest
    | all isDigit arg1 = do
@@ -2139,9 +2167,23 @@ listCmd :: String -> GHCi ()
 listCmd "" = do
    mb_span <- getCurrentBreakSpan
    case mb_span of
 listCmd "" = do
    mb_span <- getCurrentBreakSpan
    case mb_span of
-      Nothing  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
-      Just span | GHC.isGoodSrcSpan span -> io $ listAround span True
-                | otherwise              -> printForUser $ text "unable to list source for" <+> ppr span
+      Nothing ->
+          printForUser $ text "Not stopped at a breakpoint; nothing to list"
+      Just span
+       | GHC.isGoodSrcSpan span -> io $ listAround span True
+       | otherwise ->
+          do s <- getSession
+             resumes <- io $ GHC.getResumeContext s
+             case resumes of
+                 [] -> panic "No resumes"
+                 (r:_) ->
+                     do let traceIt = case GHC.resumeHistory r of
+                                      [] -> text "rerunning with :trace,"
+                                      _ -> empty
+                            doWhat = traceIt <+> text ":back then :list"
+                        printForUser (text "Unable to list source for" <+>
+                                      ppr span
+                                   $$ text "Try" <+> doWhat)
 listCmd str = list2 (words str)
 
 list2 :: [String] -> GHCi ()
 listCmd str = list2 (words str)
 
 list2 :: [String] -> GHCi ()
@@ -2322,4 +2364,3 @@ setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool
 setBreakFlag toggle array index
    | toggle    = GHC.setBreakOn array index 
    | otherwise = GHC.setBreakOff array index
 setBreakFlag toggle array index
    | toggle    = GHC.setBreakOn array index 
    | otherwise = GHC.setBreakOff array index
-