projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Force the result of user-defined commands
[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs
diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index f5debfe..8a70787 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -21,9 +21,10 @@ import Debugger
 
 -- The GHC interface
 import qualified GHC hiding (resume, runStmt)
 
 -- The GHC interface
 import qualified GHC hiding (resume, runStmt)
-import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
+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 PprTyThing
 import DynFlags
 
@@ -33,7 +34,8 @@ import PackageConfig
 import UniqFM
 #endif
 
 import UniqFM
 #endif
 
-import HscTypes                ( implicitTyThings )
+import HscTypes                ( implicitTyThings, reflectGhc, reifyGhc
+                        , handleFlagWarnings )
 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
@@ -41,7 +43,6 @@ import Name
 import SrcLoc
 
 -- Other random utilities
 import SrcLoc
 
 -- Other random utilities
-import ErrUtils
 import CmdLineParser
 import Digraph
 import BasicTypes hiding (isTopLevel)
 import CmdLineParser
 import Digraph
 import BasicTypes hiding (isTopLevel)
@@ -51,9 +52,10 @@ import StaticFlags
 import Linker
 import Util
 import NameSet
 import Linker
 import Util
 import NameSet
-import Maybes          ( orElse )
+import Maybes          ( orElse, expectJust )
 import FastString
 import Encoding
 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)
@@ -83,7 +85,6 @@ import System.Directory
 import System.IO
 import System.IO.Error as IO
 import Data.Char
 import System.IO
 import System.IO.Error as IO
 import Data.Char
-import Data.Dynamic
 import Data.Array
 import Control.Monad as Monad
 import Text.Printf
 import Data.Array
 import Control.Monad as Monad
 import Text.Printf
@@ -95,10 +96,6 @@ import GHC.TopHandler
 
 import Data.IORef      ( IORef, readIORef, writeIORef )
 
 
 import Data.IORef      ( IORef, readIORef, writeIORef )
 
-#ifdef USE_EDITLINE
-import System.Posix.Internals ( setNonBlockingFD )
-#endif
-
 -----------------------------------------------------------------------------
 
 ghciWelcomeMsg :: String
 -----------------------------------------------------------------------------
 
 ghciWelcomeMsg :: String
@@ -146,7 +143,7 @@ builtin_commands = [
   ("reload",   keepGoing reloadModule,         Nothing, completeNone),
   ("run",      keepGoing runRun,               Nothing, completeIdentifier),
   ("set",      keepGoing setCmd,               Just flagWordBreakChars, completeSetOptions),
   ("reload",   keepGoing reloadModule,         Nothing, completeNone),
   ("run",      keepGoing runRun,               Nothing, completeIdentifier),
   ("set",      keepGoing setCmd,               Just flagWordBreakChars, completeSetOptions),
-  ("show",     keepGoing showCmd,              Nothing, completeNone),
+  ("show",     keepGoing showCmd,              Nothing, completeShowOptions),
   ("sprint",    keepGoing sprintCmd,            Nothing, completeIdentifier),
   ("step",      keepGoing stepCmd,              Nothing, completeIdentifier), 
   ("steplocal", keepGoing stepLocalCmd,         Nothing, completeIdentifier), 
   ("sprint",    keepGoing sprintCmd,            Nothing, completeIdentifier),
   ("step",      keepGoing stepCmd,              Nothing, completeIdentifier), 
   ("steplocal", keepGoing stepLocalCmd,         Nothing, completeIdentifier), 
@@ -254,7 +251,7 @@ helpText =
  "   :set prog <progname>        set the value returned by System.getProgName\n" ++
  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
  "   :set editor <cmd>           set the command used for :edit\n" ++
  "   :set prog <progname>        set the value returned by System.getProgName\n" ++
  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
  "   :set editor <cmd>           set the command used for :edit\n" ++
- "   :set stop <cmd>             set the command to run when a breakpoint is hit\n" ++
+ "   :set stop [<n>] <cmd>       set the command to run when a breakpoint is hit\n" ++
  "   :unset <option> ...         unset options\n" ++
  "\n" ++
  "  Options for ':set' and ':unset':\n" ++
  "   :unset <option> ...         unset options\n" ++
  "\n" ++
  "  Options for ':set' and ':unset':\n" ++
@@ -290,9 +287,9 @@ findEditor = do
         return ""
 #endif
 
         return ""
 #endif
 
-interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe [String]
-              -> IO ()
-interactiveUI session srcs maybe_exprs = do
+interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String]
+              -> Ghc ()
+interactiveUI srcs maybe_exprs = withTerminalReset $ 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
@@ -301,14 +298,14 @@ interactiveUI session srcs maybe_exprs = 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_exprs) $ 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
@@ -338,12 +335,10 @@ interactiveUI session srcs maybe_exprs = do
 #endif
 
    -- initial context is just the Prelude
 #endif
 
    -- initial context is just the Prelude
-   prel_mod <- GHC.findModule session (GHC.mkModuleName "Prelude") Nothing
-   GHC.setContext session [] [prel_mod]
-
-   default_editor <- findEditor
+   prel_mod <- GHC.findModule (GHC.mkModuleName "Prelude") Nothing
+   GHC.setContext [] [prel_mod]
 
 
-   cwd <- getCurrentDirectory
+   default_editor <- liftIO $ findEditor
 
    startGHCi (runGHCi srcs maybe_exprs)
         GHCiState{ progname = "<interactive>",
 
    startGHCi (runGHCi srcs maybe_exprs)
         GHCiState{ progname = "<interactive>",
@@ -351,7 +346,7 @@ interactiveUI session srcs maybe_exprs = do
                    prompt = "%s> ",
                    stop = "",
                    editor = default_editor,
                    prompt = "%s> ",
                    stop = "",
                    editor = default_editor,
-                   session = session,
+--                   session = session,
                    options = [],
                    prelude = prel_mod,
                    break_ctr = 0,
                    options = [],
                    prelude = prel_mod,
                    break_ctr = 0,
@@ -360,15 +355,15 @@ interactiveUI session srcs maybe_exprs = do
                    last_command = Nothing,
                    cmdqueue = [],
                    remembered_ctx = [],
                    last_command = Nothing,
                    cmdqueue = [],
                    remembered_ctx = [],
-                   virtual_path   = cwd,
                    ghc_e = isJust maybe_exprs
                  }
 
 #ifdef USE_EDITLINE
                    ghc_e = isJust maybe_exprs
                  }
 
 #ifdef USE_EDITLINE
-   Readline.stifleHistory 100
-   withGhcAppData (\dir -> Readline.writeHistory (dir </> "ghci_history"))
-                  (return True)
-   Readline.resetTerminal Nothing
+   liftIO $ do
+     Readline.stifleHistory 100
+     withGhcAppData (\dir -> Readline.writeHistory (dir </> "ghci_history"))
+                    (return True)
+     Readline.resetTerminal Nothing
 #endif
 
    return ()
 #endif
 
    return ()
@@ -380,6 +375,21 @@ withGhcAppData right left = do
       Right dir -> right dir
       _ -> left
 
       Right dir -> right dir
       _ -> left
 
+-- libedit doesn't always restore the terminal settings correctly (as of at 
+-- least 07/12/2008); see trac #2691.  Work around this by manually resetting
+-- the terminal outselves.
+withTerminalReset :: Ghc () -> Ghc ()
+#ifdef mingw32_HOST_OS
+withTerminalReset = id
+#else
+withTerminalReset f = do
+    isTTY <- liftIO $ hIsTerminalDevice stdout
+    if not isTTY
+        then f
+        else gbracket (liftIO $ getTerminalAttributes stdOutput)
+                (\attrs -> liftIO $ setTerminalAttributes stdOutput attrs Immediately)
+                (const f)
+#endif
 
 runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
 runGHCi paths maybe_exprs = do
 
 runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
 runGHCi paths maybe_exprs = do
@@ -566,9 +576,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 <-
@@ -580,7 +589,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
@@ -625,11 +634,8 @@ readlineLoop = do
                    return (Just str)
 
 withReadline :: IO a -> IO a
                    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
+withReadline = bracket_ stopTimer startTimer
+     --    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.
      --    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.
@@ -658,9 +664,15 @@ runCommands' eh getCmd = do
   case mb_cmd of 
     Nothing -> return ()
     Just c  -> do
   case mb_cmd of 
     Nothing -> return ()
     Just c  -> do
-      b <- ghciHandle eh (doCommand c)
+      b <- ghciHandle eh $
+             handleSourceError printErrorAndKeepGoing
+               (doCommand c)
       if b then return () else runCommands' eh getCmd
   where
       if b then return () else runCommands' eh getCmd
   where
+    printErrorAndKeepGoing err = do
+        GHC.printExceptionAndWarnings err
+        return False
+
     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
@@ -713,12 +725,11 @@ runStmt stmt step
 afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
 afterRunStmt _ (GHC.RunException e) = throw e
 afterRunStmt step_here run_result = do
 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
@@ -727,8 +738,8 @@ afterRunStmt step_here run_result = do
 --               printTypeOfNames session names
                let namesSorted = sortBy compareNames names
                tythings <- catMaybes `liftM` 
 --               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>"
                printForUserPartWay docs
                maybe (return ()) runBreakCmd mb_info
                -- run the command set with ":set stop <cmd>"
@@ -758,17 +769,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
@@ -819,8 +830,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
@@ -829,13 +839,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
@@ -858,20 +867,21 @@ help _ = io (putStr helpText)
 
 info :: String -> GHCi ()
 info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
 
 info :: String -> GHCi ()
 info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
-info s  = do { let names = words s
-            ; session <- getSession
+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
@@ -914,14 +924,13 @@ addModule :: [FilePath] -> GHCi ()
 addModule files = do
   revertCAFs                   -- always revert CAFs on load/add.
   files <- mapM expandPath files
 addModule files = do
   revertCAFs                   -- always revert CAFs on load/add.
   files <- mapM expandPath files
-  targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
-  session <- getSession
+  targets <- mapM (\m -> GHC.guessTarget m Nothing) files
   -- remove old targets with the same id; e.g. for :add *M
   -- remove old targets with the same id; e.g. for :add *M
-  io $ mapM_ (GHC.removeTarget session) [ tid | Target tid _ _ <- targets ]
-  io $ mapM_ (GHC.addTarget session) targets
-  prev_context <- io $ GHC.getContext session
-  ok <- io $ GHC.load session LoadAllTargets
-  afterLoad ok session False prev_context
+  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
@@ -931,18 +940,23 @@ 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 False []
-  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
 editFile :: String -> GHCi ()
 editFile str =
   do file <- if null str then chooseEditFile else return str
@@ -965,10 +979,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
@@ -978,7 +991,7 @@ 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
               Nothing   -> ghcError (CmdLineError "No files to edit.")
             case msum (map fromTarget targets) of
               Just file -> return file
               Nothing   -> ghcError (CmdLineError "No files to edit.")
@@ -1009,16 +1022,17 @@ 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
   str <- io ((unsafeCoerce# fun :: String -> IO String) s)
 
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
   str <- io ((unsafeCoerce# fun :: String -> IO String) s)
+  -- make sure we force any exceptions in the result, while we are still
+  -- inside the exception handler for commands:
+  seqList str (return ())
   enqueueCommands (lines str)
   return False
 
   enqueueCommands (lines str)
   return False
 
@@ -1035,14 +1049,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)
@@ -1052,85 +1063,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
-  io $ GHC.abandonAll session
+  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
+afterLoad :: SuccessFlag -> Bool -> ([Module],[Module]) -> GHCi ()
+afterLoad ok retain_context prev_context = do
   revertCAFs  -- always revert CAFs on load.
   discardTickArrays
   revertCAFs  -- always revert CAFs on load.
   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
 
-  setContextAfterLoad session prev_context retain_context loaded_mod_summaries
+  setContextAfterLoad prev_context retain_context loaded_mod_summaries
 
 
 
 
-setContextAfterLoad :: Session -> ([Module],[Module]) -> Bool -> [GHC.ModSummary] -> GHCi ()
-setContextAfterLoad session prev keep_ctxt [] = do
+setContextAfterLoad :: ([Module],[Module]) -> Bool -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad prev keep_ctxt [] = do
   prel_mod <- getPrelude
   prel_mod <- getPrelude
-  setContextKeepingPackageModules session prev keep_ctxt ([], [prel_mod])
-setContextAfterLoad session prev keep_ctxt 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
@@ -1151,25 +1160,24 @@ setContextAfterLoad session prev keep_ctxt ms = do
        = False
 
    load_this summary | m <- GHC.ms_mod summary = do
        = False
 
    load_this summary | m <- GHC.ms_mod summary = do
-       b <- io (GHC.moduleIsInterpreted session m)
-       if b then setContextKeepingPackageModules session prev keep_ctxt ([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 keep_ctxt ([],[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 ()
         -> Bool                         -- re-execute :module commands
         -> ([Module],[Module])          -- new context
         -> GHCi ()
-setContextKeepingPackageModules session prev_context keep_ctxt (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
   if keep_ctxt
      then do
           st <- getGHCiState
@@ -1198,22 +1206,17 @@ 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 $ sep [text str, nest 2 (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
@@ -1234,8 +1237,7 @@ 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.
                 -- Guess which module the user wants to browse.  Pick
                 -- modules that are interpreted first.  The most
                 -- recently-added module occurs last, it seems.
@@ -1251,21 +1253,20 @@ 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
     Nothing -> ghcError (CmdLineError ("unknown module: " ++
                                 GHC.moduleNameString (GHC.moduleName modl)))
   case mb_mod_info of
     Nothing -> ghcError (CmdLineError ("unknown module: " ++
                                 GHC.moduleNameString (GHC.moduleName modl)))
@@ -1281,7 +1282,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.
@@ -1291,10 +1293,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
@@ -1360,9 +1362,8 @@ setContext str
 playCtxtCmd :: Bool -> (CtxtCmd, [String], [String]) -> GHCi ()
 playCtxtCmd fail (cmd, as, bs)
   = do
 playCtxtCmd :: Bool -> (CtxtCmd, [String], [String]) -> GHCi ()
 playCtxtCmd fail (cmd, as, bs)
   = do
-    s <- getSession
     (as',bs') <- do_checks fail
     (as',bs') <- do_checks fail
-    (prev_as,prev_bs) <- io $ GHC.getContext s
+    (prev_as,prev_bs) <- GHC.getContext
     (new_as, new_bs) <-
       case cmd of
         SetContext -> do
     (new_as, new_bs) <-
       case cmd of
         SetContext -> do
@@ -1378,7 +1379,7 @@ playCtxtCmd fail (cmd, as, bs)
           let new_as = prev_as \\ (as' ++ bs')
               new_bs = prev_bs \\ (as' ++ bs')
           return (new_as, new_bs)
           let new_as = prev_as \\ (as' ++ bs')
               new_bs = prev_bs \\ (as' ++ bs')
           return (new_as, new_bs)
-    io $ GHC.setContext s new_as new_bs
+    GHC.setContext new_as new_bs
   where
     do_checks True = do
       as' <- mapM wantInterpretedModule as
   where
     do_checks True = do
       as' <- mapM wantInterpretedModule as
@@ -1490,10 +1491,13 @@ setPrompt value = do
   st <- getGHCiState
   if null value
       then io $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
   st <- getGHCiState
   if null value
       then io $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
-      else setGHCiState st{ prompt = remQuotes value }
-  where
-     remQuotes ('\"':xs) | not (null xs) && last xs == '\"' = init xs
-     remQuotes x = x
+      else case value of
+           '\"' : _ -> case reads value of
+                       [(value', xs)] | all isSpace xs ->
+                           setGHCiState (st { prompt = value' })
+                       _ ->
+                           io $ hPutStrLn stderr "Can't parse prompt string. Use Haskell syntax."
+           _ -> setGHCiState (st { prompt = value })
 
 setOptions wds =
    do -- first, deal with the GHCi opts (+s, +t, etc.)
 
 setOptions wds =
    do -- first, deal with the GHCi opts (+s, +t, etc.)
@@ -1507,7 +1511,7 @@ newDynFlags minus_opts = do
       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
       (dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts
       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
       (dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts
-      io $ handleFlagWarnings dflags' warns
+      handleFlagWarnings dflags' warns
 
       if (not (null leftovers))
         then ghcError $ errorsToGhcException leftovers
 
       if (not (null leftovers))
         then ghcError $ errorsToGhcException leftovers
@@ -1519,13 +1523,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 ([],[]) False []
+        setContextAfterLoad ([],[]) False []
       return ()
 
 
       return ()
 
 
@@ -1603,22 +1606,20 @@ showCmd str = do
 
 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
 
@@ -1637,8 +1638,7 @@ 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 =
@@ -1674,8 +1674,8 @@ completeNone :: String -> IO [String]
 completeNone _w = return []
 
 completeMacro, completeIdentifier, completeModule,
 completeNone _w = return []
 
 completeMacro, completeIdentifier, completeModule,
-    completeHomeModule, completeSetOptions, completeFilename,
-    completeHomeModuleOrFile 
+    completeHomeModule, completeSetOptions, completeShowOptions,
+    completeFilename, completeHomeModuleOrFile
     :: String -> IO [String]
 
 #ifdef USE_EDITLINE
     :: String -> IO [String]
 
 #ifdef USE_EDITLINE
@@ -1734,25 +1734,29 @@ 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))
 
 completeSetOptions w = do
   return (filter (w `isPrefixOf`) options)
   let home_mods = map GHC.ms_mod_name g
   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods))
 
 completeSetOptions w = do
   return (filter (w `isPrefixOf`) options)
-    where options = "args":"prog":allFlags
+    where options = "args":"prog":"prompt":"editor":"stop":flagList
+          flagList = map head $ group $ sort allFlags
+
+completeShowOptions w = do
+  return (filter (w `isPrefixOf`) options)
+    where options = ["args", "prog", "prompt", "editor", "stop",
+                     "modules", "bindings", "linker", "breaks",
+                     "context", "packages", "languages"]
 
 completeFilename w = do
     ws <- Readline.filenameCompletionFunction w
 
 completeFilename w = do
     ws <- Readline.filenameCompletionFunction w
@@ -1802,12 +1806,13 @@ allExposedModules dflags
  where
   pkg_db = pkgIdMap (pkgState dflags)
 #else
  where
   pkg_db = pkgIdMap (pkgState dflags)
 #else
-completeMacro      = completeNone
-completeIdentifier = completeNone
-completeModule     = completeNone
-completeHomeModule = completeNone
-completeSetOptions = completeNone
-completeFilename   = completeNone
+completeMacro       = completeNone
+completeIdentifier  = completeNone
+completeModule      = completeNone
+completeHomeModule  = completeNone
+completeSetOptions  = completeNone
+completeShowOptions = completeNone
+completeFilename    = completeNone
 completeHomeModuleOrFile=completeNone
 #endif
 
 completeHomeModuleOrFile=completeNone
 #endif
 
@@ -1832,28 +1837,15 @@ handler exception = do
   ghciHandle handler (showException exception >> return False)
 
 showException :: SomeException -> GHCi ()
   ghciHandle handler (showException exception >> return False)
 
 showException :: SomeException -> GHCi ()
-#if __GLASGOW_HASKELL__ < 609
-showException (DynException dyn) =
-  case fromDynamic dyn of
-    Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
-    Just Interrupted      -> io (putStrLn "Interrupted.")
-    Just (CmdLineError s) -> io (putStrLn s)    -- omit the location for CmdLineError
-    Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
-    Just other_ghc_ex     -> io (print other_ghc_ex)
-
-showException other_exception
-  = io (putStrLn ("*** Exception: " ++ show other_exception))
-#else
-showException (SomeException e) =
-  io $ case cast e of
+showException se =
+  io $ case fromException se 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
        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
+       Nothing                  -> putStrLn ("*** Exception: " ++ show se)
 
 -----------------------------------------------------------------------------
 -- recursive exception handlers
 
 -----------------------------------------------------------------------------
 -- recursive exception handlers
@@ -1864,14 +1856,16 @@ showException (SomeException e) =
 
 ghciHandle :: (SomeException -> GHCi a) -> GHCi a -> GHCi a
 ghciHandle h (GHCi m) = GHCi $ \s -> 
 
 ghciHandle :: (SomeException -> GHCi a) -> GHCi a -> GHCi a
 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 a -> GHCi (Either SomeException a)
-ghciTry (GHCi m) = GHCi $ \s -> Exception.try (m s) 
+ghciTry (GHCi m) = GHCi $ \s -> gtry (m s)
 
 -- ----------------------------------------------------------------------------
 -- Utils
 
 -- ----------------------------------------------------------------------------
 -- Utils
@@ -1890,12 +1884,11 @@ expandPathIO path =
 
 wantInterpretedModule :: String -> GHCi Module
 wantInterpretedModule str = do
 
 wantInterpretedModule :: String -> GHCi Module
 wantInterpretedModule str = do
-   session <- getSession
    modl <- lookupModule str
    dflags <- getDynFlags
    when (GHC.modulePackageId modl /= thisPackage dflags) $
       ghcError (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
    modl <- lookupModule str
    dflags <- getDynFlags
    when (GHC.modulePackageId modl /= thisPackage dflags) $
       ghcError (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
-   is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+   is_interpreted <- GHC.moduleIsInterpreted modl
    when (not is_interpreted) $
        ghcError (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
    return modl
    when (not is_interpreted) $
        ghcError (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
    return modl
@@ -1903,18 +1896,18 @@ wantInterpretedModule str = do
 wantNameFromInterpretedModule :: (Name -> SDoc -> GHCi ()) -> String
                               -> (Name -> GHCi ())
                               -> GHCi ()
 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"
@@ -1930,8 +1923,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
@@ -1987,8 +1979,7 @@ doContinue pred step = do
 
 abandonCmd :: String -> GHCi ()
 abandonCmd = noArgs $ do
 
 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 ()
 
@@ -2016,8 +2007,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
@@ -2027,7 +2017,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 
@@ -2043,22 +2033,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
+  (names, _, span) <- GHC.back
   printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr span
   printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr span
-  printTypeOfNames s names
+  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)
                     then ptext (sLit "Stopped at")
                     else ptext (sLit "Logged breakpoint at")) <+> ppr span
   printForUser $ (if (ix == 0)
                     then ptext (sLit "Stopped at")
                     else ptext (sLit "Logged breakpoint at")) <+> ppr span
-  printTypeOfNames s names
+  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]
@@ -2066,18 +2054,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) 
+breakSwitch (arg1:rest)
    | looksLikeModuleName arg1 && not (null rest) = do
         mod <- wantInterpretedModule arg1
         breakByModule mod rest
    | all isDigit arg1 = do
    | looksLikeModuleName arg1 && not (null rest) = 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 
@@ -2087,7 +2074,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)
@@ -2207,8 +2195,7 @@ listCmd "" = do
       Just span
        | GHC.isGoodSrcSpan span -> io $ listAround span True
        | otherwise ->
       Just span
        | GHC.isGoodSrcSpan span -> io $ listAround span True
        | otherwise ->
-          do s <- getSession
-             resumes <- io $ GHC.getResumeContext s
+          do resumes <- GHC.getResumeContext
              case resumes of
                  [] -> panic "No resumes"
                  (r:_) ->
              case resumes of
                  [] -> panic "No resumes"
                  (r:_) ->
@@ -2223,8 +2210,7 @@ listCmd str = list2 (words str)
 
 list2 :: [String] -> GHCi ()
 list2 [arg] | all isDigit arg = do
 
 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)
@@ -2236,7 +2222,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
@@ -2254,13 +2241,12 @@ 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"
      summ:_ -> do
    let this = filter ((== modl) . GHC.ms_mod) graph
    case this of
      [] -> panic "listModuleLine"
      summ:_ -> do
-           let filename = fromJust (ml_hs_file (GHC.ms_location summ))
+           let filename = expectJust "listModuleLine" (ml_hs_file (GHC.ms_location summ))
                loc = GHC.mkSrcLoc (mkFastString (filename)) line 0
            io $ listAround (GHC.srcLocSpan loc) False
 
                loc = GHC.mkSrcLoc (mkFastString (filename)) line 0
            io $ listAround (GHC.srcLocSpan loc) False
 
@@ -2359,8 +2345,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 ()
@@ -2388,8 +2373,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
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)