projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Add ASSERTs to all calls of nameModule
[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs
diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 11c57aa..b1baecd 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -1,3 +1,6 @@
+{-# OPTIONS -fno-cse #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
 {-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
 --
 {-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
 --
@@ -11,25 +14,27 @@ 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 GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
+import qualified GHC hiding (resume, runStmt)
+import GHC              ( LoadHowMuch(..), Target(..),  TargetId(..),
                           Module, ModuleName, TyThing(..), Phase,
                           Module, ModuleName, TyThing(..), Phase,
-                          BreakIndex, SrcSpan, Resume, SingleStep )
+                          BreakIndex, SrcSpan, Resume, SingleStep,
+                          Ghc, handleSourceError )
 import PprTyThing
 import DynFlags
 
 import Packages
 import PprTyThing
 import DynFlags
 
 import Packages
-#ifdef USE_READLINE
+#ifdef USE_EDITLINE
 import PackageConfig
 import UniqFM
 #endif
 
 import PackageConfig
 import UniqFM
 #endif
 
-import HscTypes                ( implicitTyThings )
+import HscTypes                ( implicitTyThings, reflectGhc, reifyGhc )
 import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
 import Outputable       hiding (printForUser, printForUserPartWay)
 import Module           -- for ModuleEnv
 import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
 import Outputable       hiding (printForUser, printForUserPartWay)
 import Module           -- for ModuleEnv
@@ -37,6 +42,8 @@ import Name
 import SrcLoc
 
 -- Other random utilities
 import SrcLoc
 
 -- Other random utilities
+import ErrUtils
+import CmdLineParser
 import Digraph
 import BasicTypes hiding (isTopLevel)
 import Panic      hiding (showException)
 import Digraph
 import BasicTypes hiding (isTopLevel)
 import Panic      hiding (showException)
@@ -48,6 +55,7 @@ import NameSet
 import Maybes          ( orElse )
 import FastString
 import Encoding
 import Maybes          ( orElse )
 import FastString
 import Encoding
+import MonadUtils       ( liftIO )
 
 #ifndef mingw32_HOST_OS
 import System.Posix hiding (getEnv)
 
 #ifndef mingw32_HOST_OS
 import System.Posix hiding (getEnv)
@@ -56,16 +64,17 @@ import GHC.ConsoleHandler ( flushConsole )
 import qualified System.Win32
 #endif
 
 import qualified System.Win32
 #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
 
-import Control.Exception as Exception
+import Exception
 -- import Control.Concurrent
 
 -- 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
@@ -81,13 +90,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
 
@@ -100,7 +110,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]
@@ -137,6 +146,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),
@@ -158,11 +168,15 @@ 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.
-word_break_chars, flagWordBreakChars, filenameWordBreakChars :: String
+#ifdef USE_EDITLINE
+word_break_chars :: String
 word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~"
                        specials = "(),;[]`{}"
                        spaces = " \t\n"
                    in spaces ++ specials ++ symbols
 word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~"
                        specials = "(),;[]`{}"
                        spaces = " \t\n"
                    in spaces ++ specials ++ symbols
+#endif
+
+flagWordBreakChars, filenameWordBreakChars :: String
 flagWordBreakChars = " \t\n"
 filenameWordBreakChars = " \t\n\\`@$><=;|&{(" -- bash defaults
 
 flagWordBreakChars = " \t\n"
 filenameWordBreakChars = " \t\n\\`@$><=;|&{(" -- bash defaults
 
@@ -171,7 +185,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"
@@ -183,7 +201,7 @@ helpText =
  "   <statement>                 evaluate/run <statement>\n" ++
  "   :                           repeat last command\n" ++
  "   :{\\n ..lines.. \\n:}\\n       multiline command\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 [*]<module> ...        add module(s) to the current target set\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" ++
  "   :browse[!] [[*]<mod>]       display the names defined by module <mod>\n" ++
  "                               (!: more details; *: all top-level names)\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
@@ -196,11 +214,12 @@ helpText =
  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
  "   :kind <type>                show the kind of <type>\n" ++
  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
  "   :kind <type>                show the kind of <type>\n" ++
- "   :load <filename> ...        load module(s) and their dependents\n" ++
+ "   :load [*]<module> ...       load module(s) and their dependents\n" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
+ "   :run function [<arguments> ...] run the function with the given arguments\n" ++
  "   :type <expr>                show the type of <expr>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :!<command>                 run the shell command <command>\n" ++
  "   :type <expr>                show the type of <expr>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :!<command>                 run the shell command <command>\n" ++
@@ -216,15 +235,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" ++
@@ -255,7 +277,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
@@ -263,14 +286,15 @@ findEditor = do
   getEnv "EDITOR" 
     `IO.catch` \_ -> do
 #if mingw32_HOST_OS
   getEnv "EDITOR" 
     `IO.catch` \_ -> do
 #if mingw32_HOST_OS
-       win <- System.Win32.getWindowsDirectory
-       return (win </> "notepad.exe")
+        win <- System.Win32.getWindowsDirectory
+        return (win </> "notepad.exe")
 #else
 #else
-       return ""
+        return ""
 #endif
 
 #endif
 
-interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
-interactiveUI session srcs maybe_expr = do
+interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String]
+              -> Ghc ()
+interactiveUI 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
@@ -279,14 +303,14 @@ interactiveUI session srcs maybe_expr = do
    -- it refers to might be finalized, including the standard Handles.
    -- This sounds like a bug, but we don't have a good solution right
    -- now.
    -- it refers to might be finalized, including the standard Handles.
    -- This sounds like a bug, but we don't have a good solution right
    -- now.
-   newStablePtr stdin
-   newStablePtr stdout
-   newStablePtr stderr
+   liftIO $ newStablePtr stdin
+   liftIO $ newStablePtr stdout
+   liftIO $ newStablePtr stderr
 
     -- Initialise buffering for the *interpreted* I/O system
 
     -- Initialise buffering for the *interpreted* I/O system
-   initInterpBuffering session
+   initInterpBuffering
 
 
-   when (isNothing maybe_expr) $ do
+   liftIO $ 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
@@ -298,87 +322,114 @@ 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
 
-        -- initial context is just the Prelude
-   prel_mod <- GHC.findModule session (GHC.mkModuleName "Prelude") 
-                                      (Just basePackageId)
-   GHC.setContext session [] [prel_mod]
+#ifdef USE_EDITLINE
+        is_tty <- hIsTerminalDevice stdin
+        when is_tty $ withReadline $ do
+            Readline.initialize
+
+            withGhcAppData
+                 (\dir -> Readline.readHistory (dir </> "ghci_history"))
+                 (return True)
+            
+            Readline.setAttemptedCompletionFunction (Just completeWord)
+            --Readline.parseAndBind "set show-all-if-ambiguous 1"
+
+            Readline.setBasicWordBreakCharacters word_break_chars
+            Readline.setCompleterWordBreakCharacters word_break_chars
+            Readline.setCompletionAppendCharacter Nothing
+#endif
 
 
-#ifdef USE_READLINE
-   Readline.initialize
-   Readline.setAttemptedCompletionFunction (Just completeWord)
-   --Readline.parseAndBind "set show-all-if-ambiguous 1"
+   -- initial context is just the Prelude
+   prel_mod <- GHC.findModule (GHC.mkModuleName "Prelude") Nothing
+   GHC.setContext [] [prel_mod]
 
 
-   Readline.setBasicWordBreakCharacters word_break_chars
-   Readline.setCompleterWordBreakCharacters word_break_chars
-   Readline.setCompletionAppendCharacter Nothing
-#endif
+   default_editor <- liftIO $ findEditor
 
 
-   default_editor <- findEditor
+   cwd <- liftIO $ getCurrentDirectory
 
 
-   startGHCi (runGHCi srcs maybe_expr)
-       GHCiState{ progname = "<interactive>",
-                  args = [],
+   startGHCi (runGHCi srcs maybe_exprs)
+        GHCiState{ progname = "<interactive>",
+                   args = [],
                    prompt = "%s> ",
                    stop = "",
                    prompt = "%s> ",
                    stop = "",
-                  editor = default_editor,
-                  session = session,
-                  options = [],
+                   editor = default_editor,
+--                   session = session,
+                   options = [],
                    prelude = prel_mod,
                    break_ctr = 0,
                    breaks = [],
                    tickarrays = emptyModuleEnv,
                    last_command = Nothing,
                    cmdqueue = [],
                    prelude = prel_mod,
                    break_ctr = 0,
                    breaks = [],
                    tickarrays = emptyModuleEnv,
                    last_command = Nothing,
                    cmdqueue = [],
-                   remembered_ctx = Nothing
+                   remembered_ctx = [],
+                   virtual_path   = cwd,
+                   ghc_e = isJust maybe_exprs
                  }
 
                  }
 
-#ifdef USE_READLINE
-   Readline.resetTerminal Nothing
+#ifdef USE_EDITLINE
+   liftIO $ do
+     Readline.stifleHistory 100
+     withGhcAppData (\dir -> Readline.writeHistory (dir </> "ghci_history"))
+                    (return True)
+     Readline.resetTerminal Nothing
 #endif
 
    return ()
 
 #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
   -- immediately rather than going on to evaluate the expression.
   when (not (null paths)) $ do
 
   -- Perform a :load for files given on the GHCi command line
   -- When in -e mode, if the load fails then we want to stop
   -- immediately rather than going on to evaluate the expression.
   when (not (null paths)) $ do
-     ok <- ghciHandle (\e -> do showException e; return Failed) $ 
-               loadModule paths
-     when (isJust maybe_expr && failed ok) $
-       io (exitWith (ExitFailure 1))
+     ok <- ghciHandle (\e -> do showException e; return Failed) $
+                loadModule paths
+     when (isJust maybe_exprs && failed ok) $
+        io (exitWith (ExitFailure 1))
 
   -- if verbosity is greater than 0, or we are connected to a
   -- terminal, display the prompt in the interactive loop.
 
   -- if verbosity is greater than 0, or we are connected to a
   -- terminal, display the prompt in the interactive loop.
@@ -386,7 +437,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)
@@ -402,19 +453,25 @@ 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
-  ghciHandleDyn (\e -> case e of 
+  ghciHandleGhcException (\e -> case e of 
                        Interrupted -> do
 #if defined(mingw32_HOST_OS)
                                io (putStrLn "")
                        Interrupted -> do
 #if defined(mingw32_HOST_OS)
                                io (putStrLn "")
@@ -426,7 +483,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)
@@ -450,7 +507,7 @@ checkPerms _ =
   return True
 #else
 checkPerms name =
   return True
 #else
 checkPerms name =
-  Util.handle (\_ -> return False) $ do
+  handleIO (\_ -> return False) $ do
      st <- getFileStatus name
      me <- getRealUserID
      if fileOwner st /= me then do
      st <- getFileStatus name
      me <- getRealUserID
      if fileOwner st /= me then do
@@ -512,9 +569,8 @@ decodeStringAsUTF8 str =
 
 mkPrompt :: GHCi String
 mkPrompt = do
 
 mkPrompt :: GHCi String
 mkPrompt = do
-  session <- getSession
-  (toplevs,exports) <- io (GHC.getContext session)
-  resumes <- io $ GHC.getResumeContext session
+  (toplevs,exports) <- GHC.getContext
+  resumes <- GHC.getResumeContext
   -- st <- getGHCiState
 
   context_bit <-
   -- st <- getGHCiState
 
   context_bit <-
@@ -526,7 +582,7 @@ mkPrompt = do
                    then return (brackets (ppr (GHC.resumeSpan r)) <> space)
                    else do
                         let hist = GHC.resumeHistory r !! (ix-1)
                    then return (brackets (ppr (GHC.resumeSpan r)) <> space)
                    else do
                         let hist = GHC.resumeHistory r !! (ix-1)
-                        span <- io$ GHC.getHistorySpan session hist
+                        span <- GHC.getHistorySpan hist
                         return (brackets (ppr (negate ix) <> char ':' 
                                           <+> ppr span) <> space)
   let
                         return (brackets (ppr (negate ix) <> char ':' 
                                           <+> ppr span) <> space)
   let
@@ -554,22 +610,35 @@ 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
    saveSession -- for use by completion
    prompt <- mkPrompt
 readlineLoop :: GHCi (Maybe String)
 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
+   l <- io $ withReadline (readline prompt)
    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
                    return (Just str)
         Just l  -> do
                    io (addHistory l)
                    str <- io $ consoleInputToUnicode True l
                    return (Just str)
+
+withReadline :: IO a -> IO a
+withReadline = bracket_ stopTimer (do startTimer; setNonBlockingFD 0)
+     -- Two problems are being worked around here:
+     -- 1. readline sometimes puts stdin into blocking mode,
+     --    so we need to put it back for the IO library
+     -- 2. editline doesn't handle some of its system calls returning
+     --    EINTR, so our timer signal confuses it, hence we turn off
+     --    the timer signal when making calls to editline. (#2277)
+     --    If editline is ever fixed, we can remove this.
+
+-- These come from the RTS
+foreign import ccall unsafe startTimer :: IO ()
+foreign import ccall unsafe stopTimer  :: IO ()
 #endif
 
 queryQueue :: GHCi (Maybe String)
 #endif
 
 queryQueue :: GHCi (Maybe String)
@@ -581,15 +650,25 @@ 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' :: (SomeException -> 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 $
+             handleSourceError printErrorAndKeepGoing
+               (doCommand c)
+      if b then return () else runCommands' eh getCmd
   where
   where
+    printErrorAndKeepGoing err = do
+        GHC.printExceptionAndWarnings err
+        return True
+
     noSpace q = q >>= maybe (return Nothing)
                             (\c->case removeSpaces c of 
                                    ""   -> noSpace q
     noSpace q = q >>= maybe (return Nothing)
                             (\c->case removeSpaces c of 
                                    ""   -> noSpace q
@@ -629,71 +708,48 @@ 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.RunException e) = throw e
 afterRunStmt step_here run_result = do
 --afterRunStmt :: GHC.RunResult -> GHCi Bool
                                  -- False <=> the statement failed to compile
 afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
 afterRunStmt _ (GHC.RunException e) = throw e
 afterRunStmt step_here run_result = do
-  session     <- getSession
-  resumes <- io $ GHC.getResumeContext session
+  resumes <- GHC.getResumeContext
   case run_result of
      GHC.RunOk names -> do
         show_types <- isOptionSet ShowType
   case run_result of
      GHC.RunOk names -> do
         show_types <- isOptionSet ShowType
-        when show_types $ printTypeOfNames session names
+        when show_types $ printTypeOfNames names
      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
                tythings <- catMaybes `liftM` 
                        ppr (GHC.resumeSpan $ head resumes)
 --               printTypeOfNames session names
                let namesSorted = sortBy compareNames names
                tythings <- catMaybes `liftM` 
-                              io (mapM (GHC.lookupName session) namesSorted)
-               docs <- io$ pprTypeAndContents session [id | AnId id <- tythings]
+                              mapM GHC.lookupName namesSorted
+               docs <- pprTypeAndContents [id | AnId id <- tythings]
                printForUserPartWay docs
                maybe (return ()) runBreakCmd mb_info
                -- run the command set with ":set stop <cmd>"
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()
                printForUserPartWay docs
                maybe (return ()) runBreakCmd mb_info
                -- run the command set with ":set stop <cmd>"
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()
-         | otherwise -> io(GHC.resume session GHC.SingleStep) >>= 
+         | 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)
 
@@ -709,17 +765,17 @@ runBreakCmd info = do
               | otherwise -> do enqueueCommands [cmd]; return ()
               where cmd = onBreakCmd loc
 
               | otherwise -> do enqueueCommands [cmd]; return ()
               where cmd = onBreakCmd loc
 
-printTypeOfNames :: Session -> [Name] -> GHCi ()
-printTypeOfNames session names
- = mapM_ (printTypeOfName session) $ sortBy compareNames names
+printTypeOfNames :: [Name] -> GHCi ()
+printTypeOfNames names
+ = mapM_ (printTypeOfName ) $ sortBy compareNames names
 
 compareNames :: Name -> Name -> Ordering
 n1 `compareNames` n2 = compareWith n1 `compare` compareWith n2
     where compareWith n = (getOccString n, getSrcSpan n)
 
 
 compareNames :: Name -> Name -> Ordering
 n1 `compareNames` n2 = compareWith n1 `compare` compareWith n2
     where compareWith n = (getOccString n, getSrcSpan n)
 
-printTypeOfName :: Session -> Name -> GHCi ()
-printTypeOfName session n
-   = do maybe_tything <- io (GHC.lookupName session n)
+printTypeOfName :: Name -> GHCi ()
+printTypeOfName n
+   = do maybe_tything <- GHC.lookupName n
         case maybe_tything of
             Nothing    -> return ()
             Just thing -> printTyThing thing
         case maybe_tything of
             Nothing    -> return ()
             Just thing -> printTyThing thing
@@ -770,8 +826,7 @@ lookupCommand' str = do
 
 getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
 getCurrentBreakSpan = do
 
 getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
 getCurrentBreakSpan = do
-  session <- getSession
-  resumes <- io $ GHC.getResumeContext session
+  resumes <- GHC.getResumeContext
   case resumes of
     [] -> return Nothing
     (r:_) -> do
   case resumes of
     [] -> return Nothing
     (r:_) -> do
@@ -780,13 +835,12 @@ getCurrentBreakSpan = do
            then return (Just (GHC.resumeSpan r))
            else do
                 let hist = GHC.resumeHistory r !! (ix-1)
            then return (Just (GHC.resumeSpan r))
            else do
                 let hist = GHC.resumeHistory r !! (ix-1)
-                span <- io $ GHC.getHistorySpan session hist
+                span <- GHC.getHistorySpan hist
                 return (Just span)
 
 getCurrentBreakModule :: GHCi (Maybe Module)
 getCurrentBreakModule = do
                 return (Just span)
 
 getCurrentBreakModule :: GHCi (Maybe Module)
 getCurrentBreakModule = do
-  session <- getSession
-  resumes <- io $ GHC.getResumeContext session
+  resumes <- GHC.getResumeContext
   case resumes of
     [] -> return Nothing
     (r:_) -> do
   case resumes of
     [] -> return Nothing
     (r:_) -> do
@@ -808,21 +862,22 @@ help :: String -> GHCi ()
 help _ = io (putStr helpText)
 
 info :: String -> GHCi ()
 help _ = io (putStr helpText)
 
 info :: String -> GHCi ()
-info "" = throwDyn (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
-info s  = do { let names = words s
-            ; session <- getSession
+info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
+info s  = handleSourceError GHC.printExceptionAndWarnings $ do
+             { let names = words s
             ; dflags <- getDynFlags
             ; let pefas = dopt Opt_PrintExplicitForalls dflags
             ; dflags <- getDynFlags
             ; let pefas = dopt Opt_PrintExplicitForalls dflags
-            ; mapM_ (infoThing pefas session) names }
+            ; mapM_ (infoThing pefas) names }
   where
   where
-    infoThing pefas session str = io $ do
-       names     <- GHC.parseName session str
-       mb_stuffs <- mapM (GHC.getInfo session) names
+    infoThing pefas str = do
+       names     <- GHC.parseName str
+       mb_stuffs <- mapM GHC.getInfo names
        let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
        let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
-       unqual <- GHC.getPrintUnqual session
-       putStrLn (showSDocForUser unqual $
-                  vcat (intersperse (text "") $
-                        map (pprInfo pefas) filtered))
+       unqual <- GHC.getPrintUnqual
+       liftIO $
+          putStrLn (showSDocForUser unqual $
+                    vcat (intersperse (text "") $
+                          map (pprInfo pefas) filtered))
 
   -- Filter out names whose parent is also there Good
   -- example is '[]', which is both a type and data
 
   -- Filter out names whose parent is also there Good
   -- example is '[]', which is both a type and data
@@ -844,20 +899,34 @@ 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
   files <- mapM expandPath files
-  targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
-  session <- getSession
-  io (mapM_ (GHC.addTarget session) targets)
-  prev_context <- io $ GHC.getContext session
-  ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session False prev_context
+  targets <- mapM (\m -> GHC.guessTarget m Nothing) files
+  -- remove old targets with the same id; e.g. for :add *M
+  mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets ]
+  mapM_ GHC.addTarget targets
+  prev_context <- GHC.getContext
+  ok <- trySuccess $ GHC.load LoadAllTargets
+  afterLoad ok False prev_context
 
 changeDirectory :: String -> GHCi ()
 changeDirectory "" = do
 
 changeDirectory :: String -> GHCi ()
 changeDirectory "" = do
@@ -867,25 +936,30 @@ changeDirectory "" = do
      Left _e -> return ()
      Right dir -> changeDirectory dir
 changeDirectory dir = do
      Left _e -> return ()
      Right dir -> changeDirectory dir
 changeDirectory dir = do
-  session <- getSession
-  graph <- io (GHC.getModuleGraph session)
+  graph <- GHC.getModuleGraph
   when (not (null graph)) $
        io $ putStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
   when (not (null graph)) $
        io $ putStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
-  prev_context <- io $ GHC.getContext session
-  io (GHC.setTargets session [])
-  io (GHC.load session LoadAllTargets)
-  setContextAfterLoad session prev_context []
-  io (GHC.workingDirectoryChanged session)
+  prev_context <- GHC.getContext
+  GHC.setTargets []
+  GHC.load LoadAllTargets
+  setContextAfterLoad prev_context False []
+  GHC.workingDirectoryChanged
   dir <- expandPath dir
   io (setCurrentDirectory dir)
 
   dir <- expandPath dir
   io (setCurrentDirectory dir)
 
+trySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag
+trySuccess act =
+    handleSourceError (\e -> do GHC.printExceptionAndWarnings e
+                                return Failed) $ do
+      act
+
 editFile :: String -> GHCi ()
 editFile str =
   do file <- if null str then chooseEditFile else return str
      st <- getGHCiState
      let cmd = editor st
      when (null cmd) 
 editFile :: String -> GHCi ()
 editFile str =
   do file <- if null str then chooseEditFile else return str
      st <- getGHCiState
      let cmd = editor st
      when (null cmd) 
-       $ throwDyn (CmdLineError "editor not set, use :set editor")
+       $ ghcError (CmdLineError "editor not set, use :set editor")
      io $ system (cmd ++ ' ':file)
      return ()
 
      io $ system (cmd ++ ' ':file)
      return ()
 
@@ -901,10 +975,9 @@ editFile str =
 -- of those.
 chooseEditFile :: GHCi String
 chooseEditFile =
 -- of those.
 chooseEditFile :: GHCi String
 chooseEditFile =
-  do session <- getSession
-     let hasFailed x = io $ fmap not $ GHC.isLoaded session $ GHC.ms_mod_name x
+  do let hasFailed x = fmap not $ GHC.isLoaded $ GHC.ms_mod_name x
 
 
-     graph <- io (GHC.getModuleGraph session)
+     graph <- GHC.getModuleGraph
      failed_graph <- filterM hasFailed graph
      let order g  = flattenSCCs $ GHC.topSortModuleGraph True g Nothing
          pick xs  = case xs of
      failed_graph <- filterM hasFailed graph
      let order g  = flattenSCCs $ GHC.topSortModuleGraph True g Nothing
          pick xs  = case xs of
@@ -914,12 +987,12 @@ chooseEditFile =
      case pick (order failed_graph) of
        Just file -> return file
        Nothing   -> 
      case pick (order failed_graph) of
        Just file -> return file
        Nothing   -> 
-         do targets <- io (GHC.getTargets session)
+         do targets <- GHC.getTargets
             case msum (map fromTarget targets) of
               Just file -> return file
             case msum (map fromTarget targets) of
               Just file -> return file
-              Nothing   -> throwDyn (CmdLineError "No files to edit.")
+              Nothing   -> ghcError (CmdLineError "No files to edit.")
           
           
-  where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f
+  where fromTarget (GHC.Target (GHC.TargetFile f _) _ _) = Just f
         fromTarget _ = Nothing -- when would we get a module target?
 
 defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
         fromTarget _ = Nothing -- when would we get a module target?
 
 defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
@@ -934,7 +1007,7 @@ defineMacro overwrite s = do
                                   unlines defined)
        else do
   if (not overwrite && macro_name `elem` defined)
                                   unlines defined)
        else do
   if (not overwrite && macro_name `elem` defined)
-       then throwDyn (CmdLineError 
+       then ghcError (CmdLineError 
                ("macro '" ++ macro_name ++ "' is already defined"))
        else do
 
                ("macro '" ++ macro_name ++ "' is already defined"))
        else do
 
@@ -945,12 +1018,10 @@ defineMacro overwrite s = do
   let new_expr = '(' : definition ++ ") :: String -> IO String"
 
   -- compile the expression
   let new_expr = '(' : definition ++ ") :: String -> IO String"
 
   -- compile the expression
-  cms <- getSession
-  maybe_hv <- io (GHC.compileExpr cms new_expr)
-  case maybe_hv of
-     Nothing -> return ()
-     Just hv -> io (writeIORef macros_ref --
-                   (filtered ++ [(macro_name, runMacro hv, Nothing, completeNone)]))
+  handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+    hv <- GHC.compileExpr new_expr
+    io (writeIORef macros_ref --
+       (filtered ++ [(macro_name, runMacro hv, Nothing, 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
@@ -963,7 +1034,7 @@ undefineMacro str = mapM_ undef (words str)
  where undef macro_name = do
         cmds <- io (readIORef macros_ref)
         if (macro_name `notElem` map cmdName cmds) 
  where undef macro_name = do
         cmds <- io (readIORef macros_ref)
         if (macro_name `notElem` map cmdName cmds) 
-          then throwDyn (CmdLineError 
+          then ghcError (CmdLineError 
                ("macro '" ++ macro_name ++ "' is not defined"))
           else do
             io (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds))
                ("macro '" ++ macro_name ++ "' is not defined"))
           else do
             io (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds))
@@ -971,14 +1042,11 @@ undefineMacro str = mapM_ undef (words str)
 cmdCmd :: String -> GHCi ()
 cmdCmd str = do
   let expr = '(' : str ++ ") :: IO String"
 cmdCmd :: String -> GHCi ()
 cmdCmd str = do
   let expr = '(' : str ++ ") :: IO String"
-  session <- getSession
-  maybe_hv <- io (GHC.compileExpr session expr)
-  case maybe_hv of
-    Nothing -> return ()
-    Just hv -> do 
-        cmds <- io $ (unsafeCoerce# hv :: IO String)
-        enqueueCommands (lines cmds)
-        return ()
+  handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+    hv <- GHC.compileExpr expr
+    cmds <- io $ (unsafeCoerce# hv :: IO String)
+    enqueueCommands (lines cmds)
+    return ()
 
 loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule fs = timeIt (loadModule' fs)
 
 loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule fs = timeIt (loadModule' fs)
@@ -988,115 +1056,83 @@ loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return ()
 
 loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule' files = do
 
 loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule' files = do
-  session <- getSession
-  prev_context <- io $ GHC.getContext session
+  prev_context <- GHC.getContext
 
   -- unload first
 
   -- unload first
+  GHC.abandonAll
   discardActiveBreakPoints
   discardActiveBreakPoints
-  io (GHC.setTargets session [])
-  io (GHC.load session LoadAllTargets)
+  GHC.setTargets []
+  GHC.load LoadAllTargets
 
   -- expand tildes
   let (filenames, phases) = unzip files
   exp_filenames <- mapM expandPath filenames
   let files' = zip exp_filenames phases
 
   -- expand tildes
   let (filenames, phases) = unzip files
   exp_filenames <- mapM expandPath filenames
   let files' = zip exp_filenames phases
-  targets <- io (mapM (uncurry GHC.guessTarget) files')
+  targets <- mapM (uncurry GHC.guessTarget) files'
 
   -- NOTE: we used to do the dependency anal first, so that if it
   -- fails we didn't throw away the current set of modules.  This would
   -- require some re-working of the GHC interface, so we'll leave it
   -- as a ToDo for now.
 
 
   -- NOTE: we used to do the dependency anal first, so that if it
   -- fails we didn't throw away the current set of modules.  This would
   -- require some re-working of the GHC interface, so we'll leave it
   -- as a ToDo for now.
 
-  io (GHC.setTargets session targets)
-  doLoad session False prev_context LoadAllTargets
+  GHC.setTargets targets
+  doLoad False prev_context LoadAllTargets
 
 checkModule :: String -> GHCi ()
 checkModule m = do
   let modl = GHC.mkModuleName m
 
 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"
-    Just r  -> io $ putStrLn (showSDoc (
-       case GHC.checkedModuleInfo r of
-          Just cm | Just scope <- GHC.modInfoTopLevelScope cm -> 
+  prev_context <- GHC.getContext
+  ok <- handleSourceError (\e -> GHC.printExceptionAndWarnings e >> return False) $ do
+          r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
+          io $ putStrLn (showSDoc (
+          case GHC.moduleInfo r of
+            cm | Just scope <- GHC.modInfoTopLevelScope cm ->
                let
                let
-                   (local,global) = partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
+                   (local,global) = ASSERT( all isExternalName scope )
+                                    partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
                in
                        (text "global names: " <+> ppr global) $$
                        (text "local  names: " <+> ppr local)
                in
                        (text "global names: " <+> ppr global) $$
                        (text "local  names: " <+> ppr local)
-          _ -> empty))
-  afterLoad (successIf (isJust result)) session False prev_context
+            _ -> empty))
+          return True
+  afterLoad (successIf ok) False prev_context
 
 reloadModule :: String -> GHCi ()
 reloadModule m = do
 
 reloadModule :: String -> GHCi ()
 reloadModule m = do
-  session <- getSession
-  prev_context <- io $ GHC.getContext session
-  doLoad session True prev_context $ 
+  prev_context <- GHC.getContext
+  doLoad True prev_context $
         if null m then LoadAllTargets 
                   else LoadUpTo (GHC.mkModuleName m)
   return ()
 
         if null m then LoadAllTargets 
                   else LoadUpTo (GHC.mkModuleName m)
   return ()
 
-doLoad :: Session -> Bool -> ([Module],[Module]) -> LoadHowMuch -> GHCi SuccessFlag
-doLoad session retain_context prev_context howmuch = do
+doLoad :: Bool -> ([Module],[Module]) -> LoadHowMuch -> GHCi SuccessFlag
+doLoad 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
   -- turn off breakpoints before we load: we can't turn them off later, because
   -- the ModBreaks will have gone away.
   discardActiveBreakPoints
-  ok <- io (GHC.load session howmuch)
-  afterLoad ok session retain_context prev_context
+  ok <- trySuccess $ GHC.load howmuch
+  afterLoad ok retain_context prev_context
   return ok
 
   return ok
 
-afterLoad :: SuccessFlag -> Session -> Bool -> ([Module],[Module]) -> GHCi ()
-afterLoad ok session retain_context prev_context = do
-  io (revertCAFs)  -- always revert CAFs on load.
+afterLoad :: SuccessFlag -> Bool -> ([Module],[Module]) -> GHCi ()
+afterLoad ok retain_context prev_context = do
+  revertCAFs  -- always revert CAFs on load.
   discardTickArrays
   discardTickArrays
-  loaded_mod_summaries <- getLoadedModules session
+  loaded_mod_summaries <- getLoadedModules
   let loaded_mods = map GHC.ms_mod loaded_mod_summaries
       loaded_mod_names = map GHC.moduleName loaded_mods
   modulesLoadedMsg ok loaded_mod_names
 
   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 prev_context retain_context loaded_mod_summaries
+
+
+setContextAfterLoad :: ([Module],[Module]) -> Bool -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad prev keep_ctxt [] = do
   prel_mod <- getPrelude
   prel_mod <- getPrelude
-  setContextKeepingPackageModules session prev ([], [prel_mod])
-setContextAfterLoad session prev ms = do
+  setContextKeepingPackageModules prev keep_ctxt ([], [prel_mod])
+setContextAfterLoad prev keep_ctxt ms = do
   -- load a target if one is available, otherwise load the topmost module.
   -- load a target if one is available, otherwise load the topmost module.
-  targets <- io (GHC.getTargets session)
+  targets <- GHC.getTargets
   case [ m | Just m <- map (findTarget ms) targets ] of
        []    -> 
          let graph' = flattenSCCs (GHC.topSortModuleGraph True ms Nothing) in
   case [ m | Just m <- map (findTarget ms) targets ] of
        []    -> 
          let graph' = flattenSCCs (GHC.topSortModuleGraph True ms Nothing) in
@@ -1109,32 +1145,39 @@ setContextAfterLoad session prev ms = do
        []    -> Nothing
        (m:_) -> Just m
 
        []    -> Nothing
        (m:_) -> Just m
 
-   summary `matches` Target (TargetModule m) _
+   summary `matches` Target (TargetModule m) _ _
        = GHC.ms_mod_name summary == m
        = GHC.ms_mod_name summary == m
-   summary `matches` Target (TargetFile f _) _ 
+   summary `matches` Target (TargetFile f _) _ _ 
        | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   = f == f'
    _ `matches` _
        = False
 
    load_this summary | m <- GHC.ms_mod summary = do
        | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   = f == f'
    _ `matches` _
        = False
 
    load_this summary | m <- GHC.ms_mod summary = do
-       b <- io (GHC.moduleIsInterpreted session m)
-       if b then setContextKeepingPackageModules session prev ([m], [])
+       b <- GHC.moduleIsInterpreted m
+       if b then setContextKeepingPackageModules prev keep_ctxt ([m], [])
                     else do
                 prel_mod <- getPrelude
                     else do
                 prel_mod <- getPrelude
-                setContextKeepingPackageModules session prev ([],[prel_mod,m])
+                setContextKeepingPackageModules prev keep_ctxt ([],[prel_mod,m])
 
 -- | Keep any package modules (except Prelude) when changing the context.
 setContextKeepingPackageModules
 
 -- | Keep any package modules (except Prelude) when changing the context.
 setContextKeepingPackageModules
-        :: Session
-        -> ([Module],[Module])          -- previous context
+        :: ([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 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
   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))
+  GHC.setContext 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
@@ -1156,22 +1199,18 @@ modulesLoadedMsg ok mods = do
 
 typeOfExpr :: String -> GHCi ()
 typeOfExpr str 
 
 typeOfExpr :: String -> GHCi ()
 typeOfExpr str 
-  = do cms <- getSession
-       maybe_ty <- io (GHC.exprType cms str)
-       case maybe_ty of
-         Nothing -> return ()
-         Just ty -> do dflags <- getDynFlags
-                       let pefas = dopt Opt_PrintExplicitForalls dflags
-                        printForUser $ text str <+> dcolon
-                                       <+> pprTypeForUser pefas ty
+  = handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+       ty <- GHC.exprType str
+       dflags <- getDynFlags
+       let pefas = dopt Opt_PrintExplicitForalls dflags
+       printForUser $ text str <+> dcolon
+                       <+> pprTypeForUser pefas ty
 
 kindOfType :: String -> GHCi ()
 kindOfType str 
 
 kindOfType :: String -> GHCi ()
 kindOfType str 
-  = do cms <- getSession
-       maybe_ty <- io (GHC.typeKind cms str)
-       case maybe_ty of
-         Nothing    -> return ()
-         Just ty    -> printForUser $ text str <+> dcolon <+> ppr ty
+  = handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+       ty <- GHC.typeKind str
+       printForUser $ text str <+> dcolon <+> ppr ty
           
 quit :: String -> GHCi Bool
 quit _ = return True
           
 quit :: String -> GHCi Bool
 quit _ = return True
@@ -1192,16 +1231,15 @@ browseCmd bang m =
         m <- lookupModule s
         browseModule bang m True
     [] -> do
         m <- lookupModule s
         browseModule bang m True
     [] -> do
-        s <- getSession
-        (as,bs) <- io $ GHC.getContext s
+        (as,bs) <- GHC.getContext
                 -- 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
                 -- 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>")
+          ([],  [])  -> ghcError (CmdLineError ":browse: no current module")
+    _ -> ghcError (CmdLineError "syntax:  :browse <module>")
 
 -- without bang, show items in context of their parents and omit children
 -- with bang, show class methods and data constructors separately, and
 
 -- without bang, show items in context of their parents and omit children
 -- with bang, show class methods and data constructors separately, and
@@ -1209,23 +1247,22 @@ browseCmd bang m =
 -- with sorted, sort items alphabetically
 browseModule :: Bool -> Module -> Bool -> GHCi ()
 browseModule bang modl exports_only = do
 -- with sorted, sort items alphabetically
 browseModule :: Bool -> Module -> Bool -> GHCi ()
 browseModule bang modl exports_only = do
-  s <- getSession
   -- :browse! reports qualifiers wrt current context
   -- :browse! reports qualifiers wrt current context
-  current_unqual <- io (GHC.getPrintUnqual s)
+  current_unqual <- GHC.getPrintUnqual
   -- Temporarily set the context to the module we're interested in,
   -- just so we can get an appropriate PrintUnqualified
   -- 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)
+  (as,bs) <- GHC.getContext
   prel_mod <- getPrelude
   prel_mod <- getPrelude
-  io (if exports_only then GHC.setContext s [] [prel_mod,modl]
-                      else GHC.setContext s [modl] [])
-  target_unqual <- io (GHC.getPrintUnqual s)
-  io (GHC.setContext s as bs)
+  if exports_only then GHC.setContext [] [prel_mod,modl]
+                  else GHC.setContext [modl] []
+  target_unqual <- GHC.getPrintUnqual
+  GHC.setContext as bs
 
   let unqual = if bang then current_unqual else target_unqual
 
 
   let unqual = if bang then current_unqual else target_unqual
 
-  mb_mod_info <- io $ GHC.getModuleInfo s modl
+  mb_mod_info <- GHC.getModuleInfo modl
   case mb_mod_info of
   case mb_mod_info of
-    Nothing -> throwDyn (CmdLineError ("unknown module: " ++
+    Nothing -> ghcError (CmdLineError ("unknown module: " ++
                                 GHC.moduleNameString (GHC.moduleName modl)))
     Just mod_info -> do
         dflags <- getDynFlags
                                 GHC.moduleNameString (GHC.moduleName modl)))
     Just mod_info -> do
         dflags <- getDynFlags
@@ -1239,7 +1276,8 @@ browseModule bang modl exports_only = do
                 -- We would like to improve this; see #1799.
             sorted_names = loc_sort local ++ occ_sort external
                 where 
                 -- We would like to improve this; see #1799.
             sorted_names = loc_sort local ++ occ_sort external
                 where 
-                (local,external) = partition ((==modl) . nameModule) names
+                (local,external) = ASSERT( all isExternalName names )
+                                  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.
                 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.
@@ -1249,10 +1287,10 @@ browseModule bang modl exports_only = do
                       | otherwise
                       = occ_sort names
 
                       | otherwise
                       = occ_sort names
 
-        mb_things <- io $ mapM (GHC.lookupName s) sorted_names
+        mb_things <- mapM GHC.lookupName sorted_names
         let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things)
 
         let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things)
 
-        rdr_env <- io $ GHC.getGRE s
+        rdr_env <- GHC.getGRE
 
         let pefas              = dopt Opt_PrintExplicitForalls dflags
             things | bang      = catMaybes mb_things
 
         let pefas              = dopt Opt_PrintExplicitForalls dflags
             things | bang      = catMaybes mb_things
@@ -1293,60 +1331,64 @@ browseModule bang modl exports_only = do
 
 setContext :: String -> GHCi ()
 setContext str
 
 setContext :: String -> GHCi ()
 setContext str
-  | all sensible mods = fn mods
-  | otherwise = throwDyn (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
+  | all sensible strs = do
+       playCtxtCmd True (cmd, as, bs)
+       st <- getGHCiState
+       setGHCiState st{ remembered_ctx = remembered_ctx st ++ [(cmd,as,bs)] }
+  | otherwise = ghcError (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
   where
   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)
-
-
-removeFromContext :: [String] -> GHCi ()
-removeFromContext strs = do
-  s <- getSession
-  (as,bs) <- io $ GHC.getContext s
-
-  (as_to_remove,bs_to_remove) <- separate s strs [] []
-
-  let as' = as \\ (as_to_remove ++ bs_to_remove)
-      bs' = bs \\ (as_to_remove ++ bs_to_remove)
-
-  io $ GHC.setContext s as' bs'
+    starred ('*':m) = Left m
+    starred m       = Right m
+
+playCtxtCmd :: Bool -> (CtxtCmd, [String], [String]) -> GHCi ()
+playCtxtCmd fail (cmd, as, bs)
+  = do
+    (as',bs') <- do_checks fail
+    (prev_as,prev_bs) <- GHC.getContext
+    (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)
+    GHC.setContext 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'
@@ -1377,13 +1419,13 @@ setCmd ""
           vcat (text "other dynamic, non-language, flag settings:" 
                :map (flagSetting dflags) nonLanguageDynFlags)
           ))
           vcat (text "other dynamic, non-language, flag settings:" 
                :map (flagSetting dflags) nonLanguageDynFlags)
           ))
-  where flagSetting dflags (str,f)
+  where flagSetting dflags (str, f, _)
           | dopt f dflags = text "  " <> text "-f"    <> text str
           | otherwise     = text "  " <> text "-fno-" <> text str
           | dopt f dflags = text "  " <> text "-f"    <> text str
           | otherwise     = text "  " <> text "-fno-" <> text str
-        (ghciFlags,others)  = partition (\(_,f)->f `elem` flags) 
+        (ghciFlags,others)  = partition (\(_, f, _) -> f `elem` flags)
                                         DynFlags.fFlags
                                         DynFlags.fFlags
-        nonLanguageDynFlags = filter (\(_,f)->not $ f `elem` map snd xFlags) 
-                                     others
+        nonLanguageDynFlags = filterOut (\(_, f, _) -> f `elem` languageOptions)
+                                        others
         flags = [Opt_PrintExplicitForalls
                 ,Opt_PrintBindResult
                 ,Opt_BreakOnException
         flags = [Opt_PrintExplicitForalls
                 ,Opt_PrintBindResult
                 ,Opt_BreakOnException
@@ -1391,27 +1433,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
@@ -1454,12 +1501,12 @@ newDynFlags :: [String] -> GHCi ()
 newDynFlags minus_opts = do
       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
 newDynFlags minus_opts = do
       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
-      (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
+      (dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts
+      io $ handleFlagWarnings dflags' warns
 
       if (not (null leftovers))
 
       if (not (null leftovers))
-               then throwDyn (CmdLineError ("unrecognised flags: " ++ 
-                                               unwords leftovers))
-               else return ()
+        then ghcError $ errorsToGhcException leftovers
+        else return ()
 
       new_pkgs <- setDynFlags dflags'
 
 
       new_pkgs <- setDynFlags dflags'
 
@@ -1467,13 +1514,12 @@ newDynFlags minus_opts = do
       -- and link the new packages.
       dflags <- getDynFlags
       when (packageFlags dflags /= pkg_flags) $ do
       -- and link the new packages.
       dflags <- getDynFlags
       when (packageFlags dflags /= pkg_flags) $ do
-        io $ hPutStrLn stderr "package flags have changed, ressetting and loading new packages..."
-        session <- getSession
-        io (GHC.setTargets session [])
-        io (GHC.load session LoadAllTargets)
+        io $ hPutStrLn stderr "package flags have changed, resetting and loading new packages..."
+        GHC.setTargets []
+        GHC.load LoadAllTargets
         io (linkPackages dflags new_pkgs)
         -- package flags changed, we can't re-use any of the old context
         io (linkPackages dflags new_pkgs)
         -- package flags changed, we can't re-use any of the old context
-        setContextAfterLoad session ([],[]) []
+        setContextAfterLoad ([],[]) False []
       return ()
 
 
       return ()
 
 
@@ -1491,7 +1537,7 @@ unsetOptions str
        mapM_ unsetOpt plus_opts
  
        let no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
        mapM_ unsetOpt plus_opts
  
        let no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
-           no_flag f = throwDyn (ProgramError ("don't know how to reverse " ++ f))
+           no_flag f = ghcError (ProgramError ("don't know how to reverse " ++ f))
 
        no_flags <- mapM no_flag minus_opts
        newDynFlags no_flags
 
        no_flags <- mapM no_flag minus_opts
        newDynFlags no_flags
@@ -1546,26 +1592,25 @@ 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]")
+       _ -> ghcError (CmdLineError ("syntax:  :show [ args | prog | prompt | editor | stop | modules | bindings\n"++
+                                     "               | breaks | context | packages | languages ]"))
 
 showModules :: GHCi ()
 showModules = do
 
 showModules :: GHCi ()
 showModules = do
-  session <- getSession
-  loaded_mods <- getLoadedModules session
+  loaded_mods <- getLoadedModules
         -- we want *loaded* modules only, see #1734
         -- we want *loaded* modules only, see #1734
-  let show_one ms = do m <- io (GHC.showModule session ms); io (putStrLn m)
+  let show_one ms = do m <- GHC.showModule ms; io (putStrLn m)
   mapM_ show_one loaded_mods
 
   mapM_ show_one loaded_mods
 
-getLoadedModules :: GHC.Session -> GHCi [GHC.ModSummary]
-getLoadedModules session = do
-  graph <- io (GHC.getModuleGraph session)
-  filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
+getLoadedModules :: GHCi [GHC.ModSummary]
+getLoadedModules = do
+  graph <- GHC.getModuleGraph
+  filterM (GHC.isLoaded . GHC.ms_mod_name) graph
 
 showBindings :: GHCi ()
 showBindings = do
 
 showBindings :: GHCi ()
 showBindings = do
-  s <- getSession
-  bindings <- io (GHC.getBindings s)
-  docs     <- io$ pprTypeAndContents s 
+  bindings <- GHC.getBindings
+  docs     <- pprTypeAndContents
                   [ id | AnId id <- sortBy compareTyThings bindings]
   printForUserPartWay docs
 
                   [ id | AnId id <- sortBy compareTyThings bindings]
   printForUserPartWay docs
 
@@ -1584,13 +1629,12 @@ showBkptTable = do
 
 showContext :: GHCi ()
 showContext = do
 
 showContext :: GHCi ()
 showContext = do
-   session <- getSession
-   resumes <- io $ GHC.getResumeContext session
+   resumes <- GHC.getResumeContext
    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
@@ -1601,7 +1645,8 @@ showPackages = do
   pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags
   io $ putStrLn $ showSDoc $ vcat $
     text "packages currently loaded:" 
   pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags
   io $ putStrLn $ showSDoc $ vcat $
     text "packages currently loaded:" 
-    : map (nest 2 . text . packageIdString) pkg_ids
+    : map (nest 2 . text . packageIdString) 
+               (sortBy (compare `on` packageIdFS) pkg_ids)
   where showFlag (ExposePackage p) = text $ "  -package " ++ p
         showFlag (HidePackage p)   = text $ "  -hide-package " ++ p
         showFlag (IgnorePackage p) = text $ "  -ignore-package " ++ p
   where showFlag (ExposePackage p) = text $ "  -package " ++ p
         showFlag (HidePackage p)   = text $ "  -hide-package " ++ p
         showFlag (IgnorePackage p) = text $ "  -ignore-package " ++ p
@@ -1611,7 +1656,7 @@ showLanguages = do
    dflags <- getDynFlags
    io $ putStrLn $ showSDoc $ vcat $
       text "active language flags:" :
    dflags <- getDynFlags
    io $ putStrLn $ showSDoc $ vcat $
       text "active language flags:" :
-      [text ("  -X" ++ str) | (str,f) <- DynFlags.xFlags, dopt f dflags]
+      [text ("  -X" ++ str) | (str, f, _) <- DynFlags.xFlags, dopt f dflags]
 
 -- -----------------------------------------------------------------------------
 -- Completion
 
 -- -----------------------------------------------------------------------------
 -- Completion
@@ -1624,7 +1669,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
@@ -1652,7 +1697,7 @@ completeWord w start end = do
                                      (s,r') = span isBreak r
                                  in (n,w):words' isBreak (n+length w+length s) r'
           -- In a Haskell expression we want to parse 'a-b' as three words
                                      (s,r') = span isBreak r
                                  in (n,w):words' isBreak (n+length w+length s) r'
           -- In a Haskell expression we want to parse 'a-b' as three words
-          -- where a compiler flag (ie. -fno-monomorphism-restriction) should
+          -- where a compiler flag (e.g. -ddump-simpl) should
           -- only be a single word.
           selectWord [] = (0,w)
           selectWord ((offset,x):xs)
           -- only be a single word.
           selectWord [] = (0,w)
           selectWord ((offset,x):xs)
@@ -1680,19 +1725,16 @@ completeMacro w = do
   return (filter (w `isPrefixOf`) (map cmdName cmds))
 
 completeIdentifier w = do
   return (filter (w `isPrefixOf`) (map cmdName cmds))
 
 completeIdentifier w = do
-  s <- restoreSession
-  rdrs <- GHC.getRdrNamesInScope s
+  rdrs <- withRestoredSession GHC.getRdrNamesInScope
   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) rdrs))
 
 completeModule w = do
   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) rdrs))
 
 completeModule w = do
-  s <- restoreSession
-  dflags <- GHC.getSessionDynFlags s
+  dflags <- withRestoredSession GHC.getSessionDynFlags
   let pkg_mods = allExposedModules dflags
   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) pkg_mods))
 
 completeHomeModule w = do
   let pkg_mods = allExposedModules dflags
   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) pkg_mods))
 
 completeHomeModule w = do
-  s <- restoreSession
-  g <- GHC.getModuleGraph s
+  g <- withRestoredSession GHC.getModuleGraph
   let home_mods = map GHC.ms_mod_name g
   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods))
 
   let home_mods = map GHC.ms_mod_name g
   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods))
 
@@ -1770,14 +1812,15 @@ completeHomeModuleOrFile=completeNone
 -- raising another exception.  We therefore don't put the recursive
 -- handler arond the flushing operation, so if stderr is closed
 -- GHCi will just die gracefully rather than going into an infinite loop.
 -- raising another exception.  We therefore don't put the recursive
 -- handler arond the flushing operation, so if stderr is closed
 -- GHCi will just die gracefully rather than going into an infinite loop.
-handler :: Exception -> GHCi Bool
+handler :: SomeException -> GHCi Bool
 
 handler exception = do
   flushInterpBuffers
   io installSignalHandlers
   ghciHandle handler (showException exception >> return False)
 
 
 handler exception = do
   flushInterpBuffers
   io installSignalHandlers
   ghciHandle handler (showException exception >> return False)
 
-showException :: Exception -> GHCi ()
+showException :: SomeException -> GHCi ()
+#if __GLASGOW_HASKELL__ < 609
 showException (DynException dyn) =
   case fromDynamic dyn of
     Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
 showException (DynException dyn) =
   case fromDynamic dyn of
     Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
@@ -1788,6 +1831,17 @@ showException (DynException dyn) =
 
 showException other_exception
   = io (putStrLn ("*** Exception: " ++ show other_exception))
 
 showException other_exception
   = io (putStrLn ("*** Exception: " ++ show other_exception))
+#else
+showException (SomeException e) =
+  io $ case cast e of
+       Just Interrupted         -> putStrLn "Interrupted."
+       -- omit the location for CmdLineError:
+       Just (CmdLineError s)    -> putStrLn s
+       -- ditto:
+       Just ph@(PhaseFailed {}) -> putStrLn (showGhcException ph "")
+       Just other_ghc_ex        -> print other_ghc_ex
+       Nothing                  -> putStrLn ("*** Exception: " ++ show e)
+#endif
 
 -----------------------------------------------------------------------------
 -- recursive exception handlers
 
 -----------------------------------------------------------------------------
 -- recursive exception handlers
@@ -1796,14 +1850,18 @@ showException other_exception
 -- in an exception loop (eg. let a = error a in a) the ^C exception
 -- may never be delivered.  Thanks to Marcin for pointing out the bug.
 
 -- in an exception loop (eg. let a = error a in a) the ^C exception
 -- may never be delivered.  Thanks to Marcin for pointing out the bug.
 
-ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
+ghciHandle :: (SomeException -> GHCi a) -> GHCi a -> GHCi a
 ghciHandle h (GHCi m) = GHCi $ \s -> 
 ghciHandle h (GHCi m) = GHCi $ \s -> 
-   Exception.catch (m s) 
+   gcatch (m s)
        (\e -> unGHCi (ghciUnblock (h e)) s)
 
 ghciUnblock :: GHCi a -> GHCi a
        (\e -> unGHCi (ghciUnblock (h e)) s)
 
 ghciUnblock :: GHCi a -> GHCi a
-ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
+ghciUnblock (GHCi a) =
+    GHCi $ \s -> reifyGhc $ \gs ->
+                   Exception.unblock (reflectGhc (a s) gs)
 
 
+ghciTry :: GHCi a -> GHCi (Either SomeException a)
+ghciTry (GHCi m) = GHCi $ \s -> gtry (m s)
 
 -- ----------------------------------------------------------------------------
 -- Utils
 
 -- ----------------------------------------------------------------------------
 -- Utils
@@ -1822,28 +1880,30 @@ expandPathIO path =
 
 wantInterpretedModule :: String -> GHCi Module
 wantInterpretedModule str = do
 
 wantInterpretedModule :: String -> GHCi Module
 wantInterpretedModule str = do
-   session <- getSession
    modl <- lookupModule str
    modl <- lookupModule str
-   is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+   dflags <- getDynFlags
+   when (GHC.modulePackageId modl /= thisPackage dflags) $
+      ghcError (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
+   is_interpreted <- GHC.moduleIsInterpreted modl
    when (not is_interpreted) $
    when (not is_interpreted) $
-       throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
+       ghcError (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
    return modl
 
 wantNameFromInterpretedModule :: (Name -> SDoc -> GHCi ()) -> String
                               -> (Name -> GHCi ())
                               -> GHCi ()
    return modl
 
 wantNameFromInterpretedModule :: (Name -> SDoc -> GHCi ()) -> String
                               -> (Name -> GHCi ())
                               -> GHCi ()
-wantNameFromInterpretedModule noCanDo str and_then = do
-   session <- getSession
-   names <- io $ GHC.parseName session str
+wantNameFromInterpretedModule noCanDo str and_then =
+  handleSourceError (GHC.printExceptionAndWarnings) $ do
+   names <- GHC.parseName str
    case names of
       []    -> return ()
       (n:_) -> do
    case names of
       []    -> return ()
       (n:_) -> do
-            let modl = GHC.nameModule n
+            let modl = ASSERT( isExternalName n ) GHC.nameModule n
             if not (GHC.isExternalName n)
                then noCanDo n $ ppr n <>
                                 text " is not defined in an interpreted module"
                else do
             if not (GHC.isExternalName n)
                then noCanDo n $ ppr n <>
                                 text " is not defined in an interpreted module"
                else do
-            is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+            is_interpreted <- GHC.moduleIsInterpreted modl
             if not is_interpreted
                then noCanDo n $ text "module " <> ppr modl <>
                                 text " is not interpreted"
             if not is_interpreted
                then noCanDo n $ text "module " <> ppr modl <>
                                 text " is not interpreted"
@@ -1859,8 +1919,7 @@ forceCmd  = pprintCommand False True
 
 pprintCommand :: Bool -> Bool -> String -> GHCi ()
 pprintCommand bind force str = do
 
 pprintCommand :: Bool -> Bool -> String -> GHCi ()
 pprintCommand bind force str = do
-  session <- getSession
-  io $ pprintClosureCommand session bind force str
+  pprintClosureCommand bind force str
 
 stepCmd :: String -> GHCi ()
 stepCmd []         = doContinue (const True) GHC.SingleStep
 
 stepCmd :: String -> GHCi ()
 stepCmd []         = doContinue (const True) GHC.SingleStep
@@ -1885,7 +1944,7 @@ stepModuleCmd  [] = do
     Nothing  -> stepCmd []
     Just _ -> do
        Just span <- getCurrentBreakSpan
     Nothing  -> stepCmd []
     Just _ -> do
        Just span <- getCurrentBreakSpan
-       let f some_span = optSrcSpanFileName span == optSrcSpanFileName some_span
+       let f some_span = srcSpanFileName_maybe span == srcSpanFileName_maybe some_span
        doContinue f GHC.SingleStep
 
 stepModuleCmd expression = stepCmd expression
        doContinue f GHC.SingleStep
 
 stepModuleCmd expression = stepCmd expression
@@ -1910,15 +1969,13 @@ 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 ()
 
 abandonCmd :: String -> GHCi ()
 abandonCmd = noArgs $ do
   afterRunStmt pred runResult
   return ()
 
 abandonCmd :: String -> GHCi ()
 abandonCmd = noArgs $ do
-  s <- getSession
-  b <- io $ GHC.abandon s -- the prompt will change to indicate the new context
+  b <- GHC.abandon -- the prompt will change to indicate the new context
   when (not b) $ io $ putStrLn "There is no computation running."
   return ()
 
   when (not b) $ io $ putStrLn "There is no computation running."
   return ()
 
@@ -1946,8 +2003,7 @@ historyCmd arg
   | otherwise       = io $ putStrLn "Syntax:  :history [num]"
   where
   history num = do
   | otherwise       = io $ putStrLn "Syntax:  :history [num]"
   where
   history num = do
-    s <- getSession
-    resumes <- io $ GHC.getResumeContext s
+    resumes <- GHC.getResumeContext
     case resumes of
       [] -> io $ putStrLn "Not stopped at a breakpoint"
       (r:_) -> do
     case resumes of
       [] -> io $ putStrLn "Not stopped at a breakpoint"
       (r:_) -> do
@@ -1957,7 +2013,7 @@ historyCmd arg
           [] -> io $ putStrLn $ 
                    "Empty history. Perhaps you forgot to use :trace?"
           _  -> do
           [] -> io $ putStrLn $ 
                    "Empty history. Perhaps you forgot to use :trace?"
           _  -> do
-                 spans <- mapM (io . GHC.getHistorySpan s) took
+                 spans <- mapM GHC.getHistorySpan took
                  let nums  = map (printf "-%-3d:") [(1::Int)..]
                      names = map GHC.historyEnclosingDecl took
                  printForUser (vcat(zipWith3 
                  let nums  = map (printf "-%-3d:") [(1::Int)..]
                      names = map GHC.historyEnclosingDecl took
                  printForUser (vcat(zipWith3 
@@ -1973,22 +2029,20 @@ bold c | do_bold   = text start_bold <> c <> text end_bold
 
 backCmd :: String -> GHCi ()
 backCmd = noArgs $ do
 
 backCmd :: String -> GHCi ()
 backCmd = noArgs $ do
-  s <- getSession
-  (names, _, span) <- io $ GHC.back s
-  printForUser $ ptext SLIT("Logged breakpoint at") <+> ppr span
-  printTypeOfNames s names
+  (names, _, span) <- GHC.back
+  printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr span
+  printTypeOfNames names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
   enqueueCommands [stop st]
 
 forwardCmd :: String -> GHCi ()
 forwardCmd = noArgs $ do
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
   enqueueCommands [stop st]
 
 forwardCmd :: String -> GHCi ()
 forwardCmd = noArgs $ do
-  s <- getSession
-  (names, ix, span) <- io $ GHC.forward s
+  (names, ix, span) <- GHC.forward
   printForUser $ (if (ix == 0)
   printForUser $ (if (ix == 0)
-                    then ptext SLIT("Stopped at")
-                    else ptext SLIT("Logged breakpoint at")) <+> ppr span
-  printTypeOfNames s names
+                    then ptext (sLit "Stopped at")
+                    else ptext (sLit "Logged breakpoint at")) <+> ppr span
+  printTypeOfNames names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
   enqueueCommands [stop st]
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
   enqueueCommands [stop st]
@@ -1996,18 +2050,17 @@ forwardCmd = noArgs $ do
 -- handle the "break" command
 breakCmd :: String -> GHCi ()
 breakCmd argLine = do
 -- handle the "break" command
 breakCmd :: String -> GHCi ()
 breakCmd argLine = do
-   session <- getSession
-   breakSwitch session $ words argLine
+   breakSwitch $ words argLine
 
 
-breakSwitch :: Session -> [String] -> GHCi ()
-breakSwitch _session [] = do
+breakSwitch :: [String] -> GHCi ()
+breakSwitch [] = do
    io $ putStrLn "The break command requires at least one argument."
    io $ putStrLn "The break command requires at least one argument."
-breakSwitch session (arg1:rest) 
-   | looksLikeModuleName arg1 = do
+breakSwitch (arg1:rest)
+   | 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
-        (toplevel, _) <- io $ GHC.getContext session 
+        (toplevel, _) <- GHC.getContext
         case toplevel of
            (mod : _) -> breakByModuleLine mod (read arg1) rest
            [] -> do 
         case toplevel of
            (mod : _) -> breakByModuleLine mod (read arg1) rest
            [] -> do 
@@ -2017,7 +2070,8 @@ breakSwitch session (arg1:rest)
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
-               then findBreakAndSet (GHC.nameModule name) $ 
+               then ASSERT( isExternalName name ) 
+                   findBreakAndSet (GHC.nameModule name) $ 
                          findBreakByCoord (Just (GHC.srcLocFile loc))
                                           (GHC.srcLocLine loc, 
                                            GHC.srcLocCol loc)
                          findBreakByCoord (Just (GHC.srcLocFile loc))
                                           (GHC.srcLocLine loc, 
                                            GHC.srcLocCol loc)
@@ -2041,7 +2095,7 @@ breakByModuleLine mod line args
    | otherwise = breakSyntax
 
 breakSyntax :: a
    | otherwise = breakSyntax
 
 breakSyntax :: a
-breakSyntax = throwDyn (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
+breakSyntax = ghcError (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet mod lookupTickTree = do 
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet mod lookupTickTree = do 
@@ -2121,7 +2175,7 @@ findBreakByCoord mb_file (line, col) arr
 do_bold :: Bool
 do_bold = (`isPrefixOf` unsafePerformIO mTerm) `any` ["xterm", "linux"]
     where mTerm = System.Environment.getEnv "TERM"
 do_bold :: Bool
 do_bold = (`isPrefixOf` unsafePerformIO mTerm) `any` ["xterm", "linux"]
     where mTerm = System.Environment.getEnv "TERM"
-                  `Exception.catch` \_ -> return "TERM not set"
+                  `catchIO` \_ -> return "TERM not set"
 
 start_bold :: String
 start_bold = "\ESC[1m"
 
 start_bold :: String
 start_bold = "\ESC[1m"
@@ -2132,15 +2186,27 @@ 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 resumes <- GHC.getResumeContext
+             case resumes of
+                 [] -> panic "No resumes"
+                 (r:_) ->
+                     do let traceIt = case GHC.resumeHistory r of
+                                      [] -> text "rerunning with :trace,"
+                                      _ -> empty
+                            doWhat = traceIt <+> text ":back then :list"
+                        printForUser (text "Unable to list source for" <+>
+                                      ppr span
+                                   $$ text "Try" <+> doWhat)
 listCmd str = list2 (words str)
 
 list2 :: [String] -> GHCi ()
 list2 [arg] | all isDigit arg = do
 listCmd str = list2 (words str)
 
 list2 :: [String] -> GHCi ()
 list2 [arg] | all isDigit arg = do
-    session <- getSession
-    (toplevel, _) <- io $ GHC.getContext session 
+    (toplevel, _) <- GHC.getContext
     case toplevel of
         [] -> io $ putStrLn "No module to list"
         (mod : _) -> listModuleLine mod (read arg)
     case toplevel of
         [] -> io $ putStrLn "No module to list"
         (mod : _) -> listModuleLine mod (read arg)
@@ -2152,7 +2218,8 @@ list2 [arg] = do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
                then do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
                then do
-                  tickArray <- getTickArray (GHC.nameModule name)
+                  tickArray <- ASSERT( isExternalName name )
+                              getTickArray (GHC.nameModule name)
                   let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
                                         (GHC.srcLocLine loc, GHC.srcLocCol loc)
                                         tickArray
                   let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
                                         (GHC.srcLocLine loc, GHC.srcLocCol loc)
                                         tickArray
@@ -2170,8 +2237,7 @@ list2  _other =
 
 listModuleLine :: Module -> Int -> GHCi ()
 listModuleLine modl line = do
 
 listModuleLine :: Module -> Int -> GHCi ()
 listModuleLine modl line = do
-   session <- getSession
-   graph <- io (GHC.getModuleGraph session)
+   graph <- GHC.getModuleGraph
    let this = filter ((== modl) . GHC.ms_mod) graph
    case this of
      [] -> panic "listModuleLine"
    let this = filter ((== modl) . GHC.ms_mod) graph
    case this of
      [] -> panic "listModuleLine"
@@ -2182,7 +2248,7 @@ listModuleLine modl line = do
 
 -- | list a section of a source file around a particular SrcSpan.
 -- If the highlight flag is True, also highlight the span using
 
 -- | list a section of a source file around a particular SrcSpan.
 -- If the highlight flag is True, also highlight the span using
--- start_bold/end_bold.
+-- start_bold\/end_bold.
 listAround :: SrcSpan -> Bool -> IO ()
 listAround span do_highlight = do
       contents <- BS.readFile (unpackFS file)
 listAround :: SrcSpan -> Bool -> IO ()
 listAround span do_highlight = do
       contents <- BS.readFile (unpackFS file)
@@ -2275,8 +2341,7 @@ mkTickArray ticks
 
 lookupModule :: String -> GHCi Module
 lookupModule modName
 
 lookupModule :: String -> GHCi Module
 lookupModule modName
-   = do session <- getSession 
-        io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
+   = GHC.findModule (GHC.mkModuleName modName) Nothing
 
 -- don't reset the counter back to zero?
 discardActiveBreakPoints :: GHCi ()
 
 -- don't reset the counter back to zero?
 discardActiveBreakPoints :: GHCi ()
@@ -2304,8 +2369,7 @@ turnOffBreak loc = do
 
 getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
 getModBreak mod = do
 
 getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
 getModBreak mod = do
-   session <- getSession
-   Just mod_info <- io $ GHC.getModuleInfo session mod
+   Just mod_info <- GHC.getModuleInfo mod
    let modBreaks  = GHC.modInfoModBreaks mod_info
    let array      = GHC.modBreaks_flags modBreaks
    let ticks      = GHC.modBreaks_locs  modBreaks
    let modBreaks  = GHC.modInfoModBreaks mod_info
    let array      = GHC.modBreaks_flags modBreaks
    let ticks      = GHC.modBreaks_locs  modBreaks
@@ -2315,4 +2379,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
-
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)