Replace uses of the old catch function with the new one

[ghc-hetmet.git] / ghc / InteractiveUI.hs
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs

index d620290..2f3ca85 100644 (file)
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1,7 +1,6 @@
  {-# OPTIONS -fno-cse #-}
  -- -fno-cse is needed for GLOBAL_VAR's to behave properly
  
  {-# OPTIONS -fno-cse #-}
  -- -fno-cse is needed for GLOBAL_VAR's to behave properly
  
-{-# OPTIONS -#include "Linker.h" #-}
  {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  -----------------------------------------------------------------------------
  --
  {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  -----------------------------------------------------------------------------
  --
@@ -23,23 +22,24 @@ import Debugger
  -- The GHC interface
  import qualified GHC hiding (resume, runStmt)
  import GHC              ( LoadHowMuch(..), Target(..),  TargetId(..),
  -- The GHC interface
  import qualified GHC hiding (resume, runStmt)
  import GHC              ( LoadHowMuch(..), Target(..),  TargetId(..),
-                          Module, ModuleName, TyThing(..), Phase,
-                          BreakIndex, SrcSpan, Resume, SingleStep,
+                          TyThing(..), Phase,
+                          BreakIndex, Resume, SingleStep,
                            Ghc, handleSourceError )
  import PprTyThing
  import DynFlags
  
  import Packages
                            Ghc, handleSourceError )
  import PprTyThing
  import DynFlags
  
  import Packages
-import PackageConfig
+-- import PackageConfig
  import UniqFM
  
  import UniqFM
  
-import HscTypes ( implicitTyThings, handleFlagWarnings )
+import HscTypes ( handleFlagWarnings )
+import HsImpExp
  import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
  import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
+import RdrName (RdrName)
  import Outputable       hiding (printForUser, printForUserPartWay)
  import Module           -- for ModuleEnv
  import Name
  import SrcLoc
  import Outputable       hiding (printForUser, printForUserPartWay)
  import Module           -- for ModuleEnv
  import Name
  import SrcLoc
-import ObjLink
  
  -- Other random utilities
  import CmdLineParser
  
  -- Other random utilities
  import CmdLineParser
@@ -54,6 +54,7 @@ import NameSet
  import Maybes          ( orElse, expectJust )
  import FastString
  import Encoding
  import Maybes          ( orElse, expectJust )
  import FastString
  import Encoding
+import Foreign.C
  
  #ifndef mingw32_HOST_OS
  import System.Posix hiding (getEnv)
  
  #ifndef mingw32_HOST_OS
  import System.Posix hiding (getEnv)
@@ -68,7 +69,6 @@ import Control.Monad.Trans
  --import SystemExts
  
  import Exception hiding (catch, block, unblock)
  --import SystemExts
  
  import Exception hiding (catch, block, unblock)
-import qualified Exception
  
  -- import Control.Concurrent
  
  
  -- import Control.Concurrent
  
@@ -88,7 +88,10 @@ import Control.Monad as Monad
  import Text.Printf
  import Foreign
  import GHC.Exts                ( unsafeCoerce# )
  import Text.Printf
  import Foreign
  import GHC.Exts                ( unsafeCoerce# )
-import GHC.IOBase      ( IOErrorType(InvalidArgument) )
+
+import GHC.IO.Exception        ( IOErrorType(InvalidArgument) )
+import GHC.IO.Handle    ( hFlushAll )
+
  import GHC.TopHandler
  
  import Data.IORef      ( IORef, readIORef, writeIORef )
  import GHC.TopHandler
  
  import Data.IORef      ( IORef, readIORef, writeIORef )
@@ -118,11 +121,11 @@ builtin_commands = [
    ("check",     keepGoing' checkModule,         completeHomeModule),
    ("continue",  keepGoing continueCmd,          noCompletion),
    ("cmd",       keepGoing cmdCmd,               completeExpression),
    ("check",     keepGoing' checkModule,         completeHomeModule),
    ("continue",  keepGoing continueCmd,          noCompletion),
    ("cmd",       keepGoing cmdCmd,               completeExpression),
-  ("ctags",     keepGoing createCTagsFileCmd,   completeFilename),
+  ("ctags",     keepGoing createCTagsWithLineNumbersCmd, completeFilename),
+  ("ctags!",    keepGoing createCTagsWithRegExesCmd, completeFilename),
    ("def",       keepGoing (defineMacro False),  completeExpression),
    ("def!",      keepGoing (defineMacro True),   completeExpression),
    ("delete",    keepGoing deleteCmd,            noCompletion),
    ("def",       keepGoing (defineMacro False),  completeExpression),
    ("def!",      keepGoing (defineMacro True),   completeExpression),
    ("delete",    keepGoing deleteCmd,            noCompletion),
-  ("e",         keepGoing editFile,             completeFilename),
    ("edit",      keepGoing editFile,             completeFilename),
    ("etags",     keepGoing createETagsFileCmd,   completeFilename),
    ("force",     keepGoing forceCmd,             completeExpression),
    ("edit",      keepGoing editFile,             completeFilename),
    ("etags",     keepGoing createETagsFileCmd,   completeFilename),
    ("force",     keepGoing forceCmd,             completeExpression),
@@ -133,7 +136,7 @@ builtin_commands = [
    ("kind",      keepGoing' kindOfType,          completeIdentifier),
    ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
    ("list",      keepGoing' listCmd,             noCompletion),
    ("kind",      keepGoing' kindOfType,          completeIdentifier),
    ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
    ("list",      keepGoing' listCmd,             noCompletion),
-  ("module",    keepGoing setContext,           completeModule),
+  ("module",    keepGoing setContext,           completeSetModule),
    ("main",      keepGoing runMain,              completeFilename),
    ("print",     keepGoing printCmd,             completeExpression),
    ("quit",      quit,                           noCompletion),
    ("main",      keepGoing runMain,              completeFilename),
    ("print",     keepGoing printCmd,             completeExpression),
    ("quit",      quit,                           noCompletion),
@@ -198,7 +201,8 @@ helpText =
   "                               (!: more details; *: all top-level names)\n" ++
   "   :cd <dir>                   change directory to <dir>\n" ++
   "   :cmd <expr>                 run the commands returned by <expr>::IO String\n" ++
   "                               (!: more details; *: all top-level names)\n" ++
   "   :cd <dir>                   change directory to <dir>\n" ++
   "   :cmd <expr>                 run the commands returned by <expr>::IO String\n" ++
- "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
+ "   :ctags[!] [<file>]          create tags file for Vi (default: \"tags\")\n" ++
+ "                               (!: use regex instead of line number)\n" ++
   "   :def <cmd> <expr>           define a command :<cmd>\n" ++
   "   :edit <file>                edit file\n" ++
   "   :edit                       edit last module\n" ++
   "   :def <cmd> <expr>           define a command :<cmd>\n" ++
   "   :edit <file>                edit file\n" ++
   "   :edit                       edit last module\n" ++
@@ -276,7 +280,7 @@ helpText =
  findEditor :: IO String
  findEditor = do
    getEnv "EDITOR" 
  findEditor :: IO String
  findEditor = do
    getEnv "EDITOR" 
-    `IO.catch` \_ -> do
+    `catchIO` \_ -> do
  #if mingw32_HOST_OS
          win <- System.Win32.getWindowsDirectory
          return (win </> "notepad.exe")
  #if mingw32_HOST_OS
          win <- System.Win32.getWindowsDirectory
          return (win </> "notepad.exe")
@@ -284,14 +288,24 @@ findEditor = do
          return ""
  #endif
  
          return ""
  #endif
  
+foreign import ccall unsafe "rts_isProfiled" isProfiled :: IO CInt
+
+default_progname, default_prompt, default_stop :: String
+default_progname = "<interactive>"
+default_prompt = "%s> "
+default_stop = ""
+
+default_args :: [String]
+default_args = []
+
  interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String]
                -> Ghc ()
  interactiveUI srcs maybe_exprs = do
     -- although GHCi compiles with -prof, it is not usable: the byte-code
     -- compiler and interpreter don't work with profiling.  So we check for
     -- this up front and emit a helpful error message (#2197)
  interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String]
                -> Ghc ()
  interactiveUI srcs maybe_exprs = do
     -- although GHCi compiles with -prof, it is not usable: the byte-code
     -- compiler and interpreter don't work with profiling.  So we check for
     -- this up front and emit a helpful error message (#2197)
-   m <- liftIO $ lookupSymbol "PushCostCentre"
-   when (isJust m) $ 
+   i <- liftIO $ isProfiled
+   when (i /= 0) $ 
       ghcError (InstallationError "GHCi cannot be used when compiled with -prof")
  
     -- HACK! If we happen to get into an infinite loop (eg the user
       ghcError (InstallationError "GHCi cannot be used when compiled with -prof")
  
     -- HACK! If we happen to get into an infinite loop (eg the user
@@ -302,9 +316,9 @@ interactiveUI 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.
-   liftIO $ newStablePtr stdin
-   liftIO $ newStablePtr stdout
-   liftIO $ newStablePtr stderr
+   _ <- liftIO $ newStablePtr stdin
+   _ <- liftIO $ newStablePtr stdout
+   _ <- liftIO $ newStablePtr stderr
  
      -- Initialise buffering for the *interpreted* I/O system
     initInterpBuffering
  
      -- Initialise buffering for the *interpreted* I/O system
     initInterpBuffering
@@ -320,18 +334,24 @@ interactiveUI srcs maybe_exprs = do
          -- We don't want the cmd line to buffer any input that might be
          -- intended for the program, so unbuffer stdin.
          hSetBuffering stdin NoBuffering
          -- We don't want the cmd line to buffer any input that might be
          -- intended for the program, so unbuffer stdin.
          hSetBuffering stdin NoBuffering
+#if defined(mingw32_HOST_OS)
+        -- On Unix, stdin will use the locale encoding.  The IO library
+        -- doesn't do this on Windows (yet), so for now we use UTF-8,
+        -- for consistency with GHC 6.10 and to make the tests work.
+        hSetEncoding stdin utf8
+#endif
  
     -- initial context is just the Prelude
     prel_mod <- GHC.lookupModule (GHC.mkModuleName "Prelude") Nothing
  
     -- initial context is just the Prelude
     prel_mod <- GHC.lookupModule (GHC.mkModuleName "Prelude") Nothing
-   GHC.setContext [] [prel_mod]
+   GHC.setContext [] [(prel_mod, Nothing)]
  
     default_editor <- liftIO $ findEditor
  
     startGHCi (runGHCi srcs maybe_exprs)
  
     default_editor <- liftIO $ findEditor
  
     startGHCi (runGHCi srcs maybe_exprs)
-        GHCiState{ progname = "<interactive>",
-                   args = [],
-                   prompt = "%s> ",
-                   stop = "",
+        GHCiState{ progname = default_progname,
+                   args = default_args,
+                   prompt = default_prompt,
+                   stop = default_stop,
                     editor = default_editor,
  --                   session = session,
                     options = [],
                     editor = default_editor,
  --                   session = session,
                     options = [],
@@ -349,51 +369,58 @@ interactiveUI srcs maybe_exprs = do
  
  withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a
  withGhcAppData right left = do
  
  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
+    either_dir <- IO.try (getAppUserDataDirectory "ghc")
+    case either_dir of
+        Right dir ->
+            do createDirectoryIfMissing False dir `catchIO` \_ -> return ()
+               right dir
+        _ -> left
  
  runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
  runGHCi paths maybe_exprs = do
  
  runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
  runGHCi paths maybe_exprs = do
-  let 
+  let
     read_dot_files = not opt_IgnoreDotGhci
  
     current_dir = return (Just ".ghci")
  
     read_dot_files = not opt_IgnoreDotGhci
  
     current_dir = return (Just ".ghci")
  
-   app_user_dir = io $ withGhcAppData 
+   app_user_dir = liftIO $ withGhcAppData
                      (\dir -> return (Just (dir </> "ghci.conf")))
                      (return Nothing)
  
     home_dir = do
                      (\dir -> return (Just (dir </> "ghci.conf")))
                      (return Nothing)
  
     home_dir = do
-    either_dir <- io $ IO.try (getEnv "HOME")
+    either_dir <- liftIO $ IO.try (getEnv "HOME")
      case either_dir of
        Right home -> return (Just (home </> ".ghci"))
        _ -> return Nothing
  
      case either_dir of
        Right home -> return (Just (home </> ".ghci"))
        _ -> return Nothing
  
+   canonicalizePath' :: FilePath -> IO (Maybe FilePath)
+   canonicalizePath' fp = liftM Just (canonicalizePath fp)
+                `catchIO` \_ -> return Nothing
+
     sourceConfigFile :: FilePath -> GHCi ()
     sourceConfigFile file = do
     sourceConfigFile :: FilePath -> GHCi ()
     sourceConfigFile file = do
-     exists <- io $ doesFileExist file
+     exists <- liftIO $ doesFileExist file
       when exists $ do
       when exists $ do
-       dir_ok  <- io $ checkPerms (getDirectory file)
-       file_ok <- io $ checkPerms file
+       dir_ok  <- liftIO $ checkPerms (getDirectory file)
+       file_ok <- liftIO $ checkPerms file
         when (dir_ok && file_ok) $ do
         when (dir_ok && file_ok) $ do
-         either_hdl <- io $ IO.try (openFile file ReadMode)
+         either_hdl <- liftIO $ IO.try (openFile file ReadMode)
           case either_hdl of
             Left _e   -> return ()
             -- NOTE: this assumes that runInputT won't affect the terminal;
             -- can we assume this will always be the case?
             -- This would be a good place for runFileInputT.
           case either_hdl of
             Left _e   -> return ()
             -- NOTE: this assumes that runInputT won't affect the terminal;
             -- can we assume this will always be the case?
             -- This would be a good place for runFileInputT.
-           Right hdl -> runInputTWithPrefs defaultPrefs defaultSettings $ do
-                            setLogAction
+           Right hdl ->
+               do runInputTWithPrefs defaultPrefs defaultSettings $
                              runCommands $ fileLoop hdl
                              runCommands $ fileLoop hdl
+                  liftIO (hClose hdl `catchIO` \_ -> return ())
       where
        getDirectory f = case takeDirectory f of "" -> "."; d -> d
  
    when (read_dot_files) $ do
       where
        getDirectory f = case takeDirectory f of "" -> "."; d -> d
  
    when (read_dot_files) $ do
-    cfgs0 <- sequence [ current_dir, app_user_dir, home_dir ]
-    cfgs <- io $ mapM canonicalizePath (catMaybes cfgs0)
-    mapM_ sourceConfigFile (nub cfgs)
+    mcfgs0 <- sequence [ current_dir, app_user_dir, home_dir ]
+    mcfgs <- liftIO $ mapM canonicalizePath' (catMaybes mcfgs0)
+    mapM_ sourceConfigFile $ nub $ catMaybes mcfgs
          -- nub, because we don't want to read .ghci twice if the
          -- CWD is $HOME.
  
          -- nub, because we don't want to read .ghci twice if the
          -- CWD is $HOME.
  
@@ -408,11 +435,11 @@ runGHCi paths maybe_exprs = do
                      filePaths' <- mapM (Encoding.decode . BS.pack) filePaths
                      loadModule (zip filePaths' phases)
       when (isJust maybe_exprs && failed ok) $
                      filePaths' <- mapM (Encoding.decode . BS.pack) filePaths
                      loadModule (zip filePaths' phases)
       when (isJust maybe_exprs && failed ok) $
-        io (exitWith (ExitFailure 1))
+        liftIO (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.
-  is_tty <- io (hIsTerminalDevice stdin)
+  is_tty <- liftIO (hIsTerminalDevice stdin)
    dflags <- getDynFlags
    let show_prompt = verbosity dflags > 0 || is_tty
  
    dflags <- getDynFlags
    let show_prompt = verbosity dflags > 0 || is_tty
  
@@ -425,28 +452,27 @@ runGHCi paths maybe_exprs = do
              -- just evaluate the expression we were given
              enqueueCommands exprs
              let handle e = do st <- getGHCiState
              -- just evaluate the expression we were given
              enqueueCommands exprs
              let handle e = do st <- getGHCiState
+                              -- flush the interpreter's stdout/stderr on exit (#3890)
+                              flushInterpBuffers
                                     -- Jump through some hoops to get the
                                     -- current progname in the exception text:
                                     -- <progname>: <exception>
                                     -- Jump through some hoops to get the
                                     -- current progname in the exception text:
                                     -- <progname>: <exception>
-                              io $ withProgName (progname st)
+                              liftIO $ withProgName (progname st)
                                     -- this used to be topHandlerFastExit, see #2228
                                     -- this used to be topHandlerFastExit, see #2228
-                                 $ topHandler e
+                                     $ topHandler e
              runInputTWithPrefs defaultPrefs defaultSettings $ do
              runInputTWithPrefs defaultPrefs defaultSettings $ do
-                setLogAction
                  runCommands' handle (return Nothing)
  
    -- and finally, exit
                  runCommands' handle (return Nothing)
  
    -- and finally, exit
-  io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
+  liftIO $ when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
  
  runGHCiInput :: InputT GHCi a -> GHCi a
  runGHCiInput f = do
  
  runGHCiInput :: InputT GHCi a -> GHCi a
  runGHCiInput f = do
-    histFile <- io $ withGhcAppData (\dir -> return (Just (dir </> "ghci_history")))
-                        (return Nothing)
+    histFile <- liftIO $ withGhcAppData (\dir -> return (Just (dir </> "ghci_history")))
+                                        (return Nothing)
      let settings = setComplete ghciCompleteWord
                      $ defaultSettings {historyFile = histFile}
      let settings = setComplete ghciCompleteWord
                      $ defaultSettings {historyFile = histFile}
-    runInputT settings $ do
-        setLogAction
-        f
+    runInputT settings f
  
  nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)
  nextInputLine show_prompt is_tty
  
  nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)
  nextInputLine show_prompt is_tty
@@ -479,7 +505,7 @@ checkPerms name =
         putStrLn $ "WARNING: " ++ name ++ " is owned by someone else, IGNORING!"
         return False
        else do
         putStrLn $ "WARNING: " ++ name ++ " is owned by someone else, IGNORING!"
         return False
        else do
-       let mode =  fileMode st
+       let mode =  System.Posix.fileMode st
         if (groupWriteMode == (mode `intersectFileModes` groupWriteMode))
            || (otherWriteMode == (mode `intersectFileModes` otherWriteMode)) 
            then do
         if (groupWriteMode == (mode `intersectFileModes` groupWriteMode))
            || (otherWriteMode == (mode `intersectFileModes` otherWriteMode)) 
            then do
@@ -501,7 +527,7 @@ fileLoop hdl = do
                  -- this can happen if the user closed stdin, or
                  -- perhaps did getContents which closes stdin at
                  -- EOF.
                  -- this can happen if the user closed stdin, or
                  -- perhaps did getContents which closes stdin at
                  -- EOF.
-        Right l -> fmap Just (Encoding.decode (BS.pack l))
+        Right l -> return (Just l)
  
  mkPrompt :: GHCi String
  mkPrompt = do
  
  mkPrompt :: GHCi String
  mkPrompt = do
@@ -525,15 +551,13 @@ mkPrompt = do
          dots | _:rs <- resumes, not (null rs) = text "... "
               | otherwise = empty
  
          dots | _:rs <- resumes, not (null rs) = text "... "
               | otherwise = empty
  
-        
-
          modules_bit = 
         -- ToDo: maybe...
         --  let (btoplevs, bexports) = fromMaybe ([],[]) (remembered_ctx st) in
         --  hsep (map (\m -> text "!*" <> ppr (GHC.moduleName m)) btoplevs) <+>
         --  hsep (map (\m -> char '!'  <> ppr (GHC.moduleName m)) bexports) <+>
               hsep (map (\m -> char '*'  <> ppr (GHC.moduleName m)) toplevs) <+>
          modules_bit = 
         -- ToDo: maybe...
         --  let (btoplevs, bexports) = fromMaybe ([],[]) (remembered_ctx st) in
         --  hsep (map (\m -> text "!*" <> ppr (GHC.moduleName m)) btoplevs) <+>
         --  hsep (map (\m -> char '!'  <> ppr (GHC.moduleName m)) bexports) <+>
               hsep (map (\m -> char '*'  <> ppr (GHC.moduleName m)) toplevs) <+>
-             hsep (map (ppr . GHC.moduleName) exports)
+             hsep (map (ppr . GHC.moduleName) (nub (map fst exports)))
  
          deflt_prompt = dots <> context_bit <> modules_bit
  
  
          deflt_prompt = dots <> context_bit <> modules_bit
  
@@ -560,9 +584,14 @@ runCommands = runCommands' handler
  runCommands' :: (SomeException -> GHCi Bool) -- Exception handler
               -> InputT GHCi (Maybe String) -> InputT GHCi ()
  runCommands' eh getCmd = do
  runCommands' :: (SomeException -> GHCi Bool) -- Exception handler
               -> InputT GHCi (Maybe String) -> InputT GHCi ()
  runCommands' eh getCmd = do
-    b <- handleGhcException (\e -> case e of
-                    Interrupted -> return False
-                    _other -> liftIO (print e) >> return True)
+    b <- ghandle (\e -> case fromException e of
+                          Just UserInterrupt -> return False
+                          _ -> case fromException e of
+                                 Just ghc_e ->
+                                   do liftIO (print (ghc_e :: GhcException))
+                                      return True
+                                 _other ->
+                                   liftIO (Exception.throwIO e))
              (runOneCommand eh getCmd)
      if b then return () else runCommands' eh getCmd
  
              (runOneCommand eh getCmd)
      if b then return () else runCommands' eh getCmd
  
@@ -578,7 +607,7 @@ runOneCommand eh getCmd = do
                 (doCommand c)
    where
      printErrorAndKeepGoing err = do
                 (doCommand c)
    where
      printErrorAndKeepGoing err = do
-        GHC.printExceptionAndWarnings err
+        GHC.printException err
          return False
  
      noSpace q = q >>= maybe (return Nothing)
          return False
  
      noSpace q = q >>= maybe (return Nothing)
@@ -605,13 +634,13 @@ runOneCommand eh getCmd = do
        maybe (liftIO (ioError collectError))
              (\l->if removeSpaces l == ":}" 
                   then return (Just $ removeSpaces c) 
        maybe (liftIO (ioError collectError))
              (\l->if removeSpaces l == ":}" 
                   then return (Just $ removeSpaces c) 
-                 else collectCommand q (c++map normSpace l))
+                 else collectCommand q (c ++ "\n" ++ map normSpace l))
        where normSpace '\r' = ' '
              normSpace   c  = c
      -- QUESTION: is userError the one to use here?
      collectError = userError "unterminated multiline command :{ .. :}"
      doCommand (':' : cmd) = specialCommand cmd
        where normSpace '\r' = ' '
              normSpace   c  = c
      -- QUESTION: is userError the one to use here?
      collectError = userError "unterminated multiline command :{ .. :}"
      doCommand (':' : cmd) = specialCommand cmd
-    doCommand stmt        = do timeIt $ lift $ runStmt stmt GHC.RunToCompletion
+    doCommand stmt        = do _ <- timeIt $ lift $ runStmt stmt GHC.RunToCompletion
                                 return False
  
  enqueueCommands :: [String] -> GHCi ()
                                 return False
  
  enqueueCommands :: [String] -> GHCi ()
@@ -622,10 +651,18 @@ enqueueCommands cmds = do
  
  runStmt :: String -> SingleStep -> GHCi Bool
  runStmt stmt step
  
  runStmt :: String -> SingleStep -> GHCi Bool
  runStmt stmt step
- | null (filter (not.isSpace) stmt) = return False
- | ["import", mod] <- words stmt    = keepGoing' setContext ('+':mod)
+ | null (filter (not.isSpace) stmt)
+ = return False
+ | "import " `isPrefixOf` stmt
+ = do newContextCmd (Import stmt); return False
   | otherwise
   | otherwise
- = do result <- GhciMonad.runStmt stmt step
+ = do -- In the new IO library, read handles buffer data even if the Handle
+      -- is set to NoBuffering.  This causes problems for GHCi where there
+      -- are really two stdin Handles.  So we flush any bufferred data in
+      -- GHCi's stdin Handle here (only relevant if stdin is attached to
+      -- a file, otherwise the read buffer can't be flushed).
+      _ <- liftIO $ IO.try $ hFlushAll stdin
+      result <- GhciMonad.runStmt stmt step
        afterRunStmt (const True) result
  
  --afterRunStmt :: GHC.RunResult -> GHCi Bool
        afterRunStmt (const True) result
  
  --afterRunStmt :: GHC.RunResult -> GHCi Bool
@@ -655,7 +692,7 @@ afterRunStmt step_here run_result = do
       _ -> return ()
  
    flushInterpBuffers
       _ -> return ()
  
    flushInterpBuffers
-  io installSignalHandlers
+  liftIO installSignalHandlers
    b <- isOptionSet RevertCAFs
    when b revertCAFs
  
    b <- isOptionSet RevertCAFs
    when b revertCAFs
  
@@ -723,7 +760,7 @@ lookupCommand "" = do
        Just c -> return $ GotCommand c
        Nothing -> return NoLastCommand
  lookupCommand str = do
        Just c -> return $ GotCommand c
        Nothing -> return NoLastCommand
  lookupCommand str = do
-  mc <- io $ lookupCommand' str
+  mc <- liftIO $ lookupCommand' str
    st <- getGHCiState
    setGHCiState st{ last_command = mc }
    return $ case mc of
    st <- getGHCiState
    setGHCiState st{ last_command = mc }
    return $ case mc of
@@ -731,9 +768,12 @@ lookupCommand str = do
             Nothing -> BadCommand
  
  lookupCommand' :: String -> IO (Maybe Command)
             Nothing -> BadCommand
  
  lookupCommand' :: String -> IO (Maybe Command)
-lookupCommand' str = do
+lookupCommand' ":" = return Nothing
+lookupCommand' str' = do
    macros <- readIORef macros_ref
    macros <- readIORef macros_ref
-  let cmds = builtin_commands ++ macros
+  let{ (str, cmds) = case str' of
+      ':' : rest -> (rest, builtin_commands)
+      _ -> (str', macros ++ builtin_commands) }
    -- look for exact match first, then the first prefix match
    return $ case [ c | c <- cmds, str == cmdName c ] of
             c:_ -> Just c
    -- look for exact match first, then the first prefix match
    return $ case [ c | c <- cmds, str == cmdName c ] of
             c:_ -> Just c
@@ -773,15 +813,15 @@ getCurrentBreakModule = do
  
  noArgs :: GHCi () -> String -> GHCi ()
  noArgs m "" = m
  
  noArgs :: GHCi () -> String -> GHCi ()
  noArgs m "" = m
-noArgs _ _  = io $ putStrLn "This command takes no arguments"
+noArgs _ _  = liftIO $ putStrLn "This command takes no arguments"
  
  help :: String -> GHCi ()
  
  help :: String -> GHCi ()
-help _ = io (putStr helpText)
+help _ = liftIO (putStr helpText)
  
  info :: String -> InputT GHCi ()
  info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
  
  info :: String -> InputT GHCi ()
  info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
-info s  = handleSourceError GHC.printExceptionAndWarnings $ do
-             { let names = words s
+info s  = handleSourceError GHC.printException $
+          do { let names = words s
              ; dflags <- getDynFlags
              ; let pefas = dopt Opt_PrintExplicitForalls dflags
              ; mapM_ (infoThing pefas) names }
              ; dflags <- getDynFlags
              ; let pefas = dopt Opt_PrintExplicitForalls dflags
              ; mapM_ (infoThing pefas) names }
@@ -791,7 +831,7 @@ info s  = handleSourceError GHC.printExceptionAndWarnings $ do
         mb_stuffs <- mapM GHC.getInfo names
         let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
         unqual <- GHC.getPrintUnqual
         mb_stuffs <- mapM GHC.getInfo names
         let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
         unqual <- GHC.getPrintUnqual
-       outputStrLn $ showSDocForUser unqual $
+       liftIO $ putStrLn $ showSDocForUser unqual $
                      vcat (intersperse (text "") $
                            map (pprInfo pefas) filtered)
  
                      vcat (intersperse (text "") $
                            map (pprInfo pefas) filtered)
  
@@ -800,9 +840,12 @@ info s  = handleSourceError GHC.printExceptionAndWarnings $ do
    -- constructor in the same type
  filterOutChildren :: (a -> TyThing) -> [a] -> [a]
  filterOutChildren get_thing xs 
    -- constructor in the same type
  filterOutChildren :: (a -> TyThing) -> [a] -> [a]
  filterOutChildren get_thing xs 
-  = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
+  = filterOut has_parent xs
    where
    where
-    implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
+    all_names = mkNameSet (map (getName . get_thing) xs)
+    has_parent x = case pprTyThingParent_maybe (get_thing x) of
+                     Just p  -> getName p `elemNameSet` all_names
+                     Nothing -> False
  
  pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
  pprInfo pefas (thing, fixity, insts)
  
  pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
  pprInfo pefas (thing, fixity, insts)
@@ -816,7 +859,7 @@ pprInfo pefas (thing, fixity, insts)
  
  runMain :: String -> GHCi ()
  runMain s = case toArgs s of
  
  runMain :: String -> GHCi ()
  runMain s = case toArgs s of
-            Left err   -> io (hPutStrLn stderr err)
+            Left err   -> liftIO (hPutStrLn stderr err)
              Right args ->
                  do dflags <- getDynFlags
                     case mainFunIs dflags of
              Right args ->
                  do dflags <- getDynFlags
                     case mainFunIs dflags of
@@ -825,7 +868,7 @@ runMain s = case toArgs s of
  
  runRun :: String -> GHCi ()
  runRun s = case toCmdArgs s of
  
  runRun :: String -> GHCi ()
  runRun s = case toCmdArgs s of
-           Left err          -> io (hPutStrLn stderr err)
+           Left err          -> liftIO (hPutStrLn stderr err)
             Right (cmd, args) -> doWithArgs args cmd
  
  doWithArgs :: [String] -> String -> GHCi ()
             Right (cmd, args) -> doWithArgs args cmd
  
  doWithArgs :: [String] -> String -> GHCi ()
@@ -854,10 +897,10 @@ changeDirectory "" = do
  changeDirectory dir = do
    graph <- GHC.getModuleGraph
    when (not (null graph)) $
  changeDirectory dir = do
    graph <- GHC.getModuleGraph
    when (not (null graph)) $
-        outputStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
+        liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
    prev_context <- GHC.getContext
    GHC.setTargets []
    prev_context <- GHC.getContext
    GHC.setTargets []
-  GHC.load LoadAllTargets
+  _ <- GHC.load LoadAllTargets
    lift $ setContextAfterLoad prev_context False []
    GHC.workingDirectoryChanged
    dir <- expandPath dir
    lift $ setContextAfterLoad prev_context False []
    GHC.workingDirectoryChanged
    dir <- expandPath dir
@@ -865,7 +908,7 @@ changeDirectory dir = do
  
  trySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag
  trySuccess act =
  
  trySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag
  trySuccess act =
-    handleSourceError (\e -> do GHC.printExceptionAndWarnings e
+    handleSourceError (\e -> do GHC.printException e
                                  return Failed) $ do
        act
  
                                  return Failed) $ do
        act
  
@@ -876,7 +919,7 @@ editFile str =
       let cmd = editor st
       when (null cmd) 
         $ ghcError (CmdLineError "editor not set, use :set editor")
       let cmd = editor st
       when (null cmd) 
         $ ghcError (CmdLineError "editor not set, use :set editor")
-     io $ system (cmd ++ ' ':file)
+     _ <- liftIO $ system (cmd ++ ' ':file)
       return ()
  
  -- The user didn't specify a file so we pick one for them.
       return ()
  
  -- The user didn't specify a file so we pick one for them.
@@ -912,15 +955,17 @@ chooseEditFile =
          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 ()
+defineMacro _ (':':_) =
+  liftIO $ putStrLn "macro name cannot start with a colon"
  defineMacro overwrite s = do
    let (macro_name, definition) = break isSpace s
  defineMacro overwrite s = do
    let (macro_name, definition) = break isSpace s
-  macros <- io (readIORef macros_ref)
+  macros <- liftIO (readIORef macros_ref)
    let defined = map cmdName macros
    if (null macro_name) 
         then if null defined
    let defined = map cmdName macros
    if (null macro_name) 
         then if null defined
-                then io $ putStrLn "no macros defined"
-                else io $ putStr ("the following macros are defined:\n" ++
-                                  unlines defined)
+                then liftIO $ putStrLn "no macros defined"
+                else liftIO $ putStr ("the following macros are defined:\n" ++
+                                      unlines defined)
         else do
    if (not overwrite && macro_name `elem` defined)
         then ghcError (CmdLineError 
         else do
    if (not overwrite && macro_name `elem` defined)
         then ghcError (CmdLineError 
@@ -934,14 +979,15 @@ defineMacro overwrite s = do
    let new_expr = '(' : definition ++ ") :: String -> IO String"
  
    -- compile the expression
    let new_expr = '(' : definition ++ ") :: String -> IO String"
  
    -- compile the expression
-  handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+  handleSourceError (\e -> GHC.printException e) $
+   do
      hv <- GHC.compileExpr new_expr
      hv <- GHC.compileExpr new_expr
-    io (writeIORef macros_ref --
-       (filtered ++ [(macro_name, lift . runMacro hv, noCompletion)]))
+    liftIO (writeIORef macros_ref --
+            (filtered ++ [(macro_name, lift . runMacro hv, noCompletion)]))
  
  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
-  str <- io ((unsafeCoerce# fun :: String -> IO String) s)
+  str <- liftIO ((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 ())
    -- make sure we force any exceptions in the result, while we are still
    -- inside the exception handler for commands:
    seqList str (return ())
@@ -951,37 +997,41 @@ runMacro fun s = do
  undefineMacro :: String -> GHCi ()
  undefineMacro str = mapM_ undef (words str) 
   where undef macro_name = do
  undefineMacro :: String -> GHCi ()
  undefineMacro str = mapM_ undef (words str) 
   where undef macro_name = do
-        cmds <- io (readIORef macros_ref)
+        cmds <- liftIO (readIORef macros_ref)
          if (macro_name `notElem` map cmdName cmds) 
            then ghcError (CmdLineError 
                 ("macro '" ++ macro_name ++ "' is not defined"))
            else do
          if (macro_name `notElem` map cmdName cmds) 
            then ghcError (CmdLineError 
                 ("macro '" ++ macro_name ++ "' is not defined"))
            else do
-            io (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds))
+            liftIO (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds))
  
  cmdCmd :: String -> GHCi ()
  cmdCmd str = do
    let expr = '(' : str ++ ") :: IO String"
  
  cmdCmd :: String -> GHCi ()
  cmdCmd str = do
    let expr = '(' : str ++ ") :: IO String"
-  handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+  handleSourceError (\e -> GHC.printException e) $
+   do
      hv <- GHC.compileExpr expr
      hv <- GHC.compileExpr expr
-    cmds <- io $ (unsafeCoerce# hv :: IO String)
+    cmds <- liftIO $ (unsafeCoerce# hv :: IO String)
      enqueueCommands (lines cmds)
      return ()
  
      enqueueCommands (lines cmds)
      return ()
  
+loadModuleName :: GHC.GhcMonad m => ImportDecl RdrName -> m Module
+loadModuleName = flip GHC.findModule Nothing . unLoc . ideclName
+
  loadModule :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
  loadModule fs = timeIt (loadModule' fs)
  
  loadModule_ :: [FilePath] -> InputT GHCi ()
  loadModule :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
  loadModule fs = timeIt (loadModule' fs)
  
  loadModule_ :: [FilePath] -> InputT GHCi ()
-loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return ()
+loadModule_ fs = loadModule (zip fs (repeat Nothing)) >> return ()
  
  loadModule' :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
  loadModule' files = do
    prev_context <- GHC.getContext
  
    -- unload first
  
  loadModule' :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
  loadModule' files = do
    prev_context <- GHC.getContext
  
    -- unload first
-  GHC.abandonAll
+  _ <- GHC.abandonAll
    lift discardActiveBreakPoints
    GHC.setTargets []
    lift discardActiveBreakPoints
    GHC.setTargets []
-  GHC.load LoadAllTargets
+  _ <- GHC.load LoadAllTargets
  
    let (filenames, phases) = unzip files
    exp_filenames <- mapM expandPath filenames
  
    let (filenames, phases) = unzip files
    exp_filenames <- mapM expandPath filenames
@@ -1000,9 +1050,9 @@ checkModule :: String -> InputT GHCi ()
  checkModule m = do
    let modl = GHC.mkModuleName m
    prev_context <- GHC.getContext
  checkModule m = do
    let modl = GHC.mkModuleName m
    prev_context <- GHC.getContext
-  ok <- handleSourceError (\e -> GHC.printExceptionAndWarnings e >> return False) $ do
+  ok <- handleSourceError (\e -> GHC.printException e >> return False) $ do
            r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
            r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
-          outputStrLn (showSDoc (
+          liftIO $ putStrLn $ showSDoc $
            case GHC.moduleInfo r of
              cm | Just scope <- GHC.modInfoTopLevelScope cm ->
                 let
            case GHC.moduleInfo r of
              cm | Just scope <- GHC.modInfoTopLevelScope cm ->
                 let
@@ -1011,19 +1061,19 @@ checkModule m = do
                 in
                         (text "global names: " <+> ppr global) $$
                         (text "local  names: " <+> ppr local)
                 in
                         (text "global names: " <+> ppr global) $$
                         (text "local  names: " <+> ppr local)
-            _ -> empty))
+            _ -> empty
            return True
    afterLoad (successIf ok) False prev_context
  
  reloadModule :: String -> InputT GHCi ()
  reloadModule m = do
    prev_context <- GHC.getContext
            return True
    afterLoad (successIf ok) False prev_context
  
  reloadModule :: String -> InputT GHCi ()
  reloadModule m = do
    prev_context <- GHC.getContext
-  doLoad True prev_context $
+  _ <- 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 :: Bool -> ([Module],[Module]) -> LoadHowMuch -> InputT GHCi SuccessFlag
+doLoad :: Bool -> ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> LoadHowMuch -> InputT 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.
  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.
@@ -1032,7 +1082,7 @@ doLoad retain_context prev_context howmuch = do
    afterLoad ok retain_context prev_context
    return ok
  
    afterLoad ok retain_context prev_context
    return ok
  
-afterLoad :: SuccessFlag -> Bool -> ([Module],[Module]) -> InputT GHCi ()
+afterLoad :: SuccessFlag -> Bool -> ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> InputT GHCi ()
  afterLoad ok retain_context prev_context = do
    lift revertCAFs  -- always revert CAFs on load.
    lift discardTickArrays
  afterLoad ok retain_context prev_context = do
    lift revertCAFs  -- always revert CAFs on load.
    lift discardTickArrays
@@ -1044,10 +1094,10 @@ afterLoad ok retain_context prev_context = do
    lift $ setContextAfterLoad prev_context retain_context loaded_mod_summaries
  
  
    lift $ setContextAfterLoad prev_context retain_context loaded_mod_summaries
  
  
-setContextAfterLoad :: ([Module],[Module]) -> Bool -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad :: ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> Bool -> [GHC.ModSummary] -> GHCi ()
  setContextAfterLoad prev keep_ctxt [] = do
    prel_mod <- getPrelude
  setContextAfterLoad prev keep_ctxt [] = do
    prel_mod <- getPrelude
-  setContextKeepingPackageModules prev keep_ctxt ([], [prel_mod])
+  setContextKeepingPackageModules prev keep_ctxt ([], [(prel_mod, Nothing)])
  setContextAfterLoad prev keep_ctxt ms = do
    -- load a target if one is available, otherwise load the topmost module.
    targets <- GHC.getTargets
  setContextAfterLoad prev keep_ctxt ms = do
    -- load a target if one is available, otherwise load the topmost module.
    targets <- GHC.getTargets
@@ -1075,20 +1125,21 @@ setContextAfterLoad prev keep_ctxt ms = do
         if b then setContextKeepingPackageModules prev keep_ctxt ([m], [])
                      else do
                  prel_mod <- getPrelude
         if b then setContextKeepingPackageModules prev keep_ctxt ([m], [])
                      else do
                  prel_mod <- getPrelude
-                setContextKeepingPackageModules prev keep_ctxt ([],[prel_mod,m])
+                setContextKeepingPackageModules prev keep_ctxt ([],[(prel_mod,Nothing),(m,Nothing)])
  
  -- | Keep any package modules (except Prelude) when changing the context.
  setContextKeepingPackageModules
  
  -- | Keep any package modules (except Prelude) when changing the context.
  setContextKeepingPackageModules
-        :: ([Module],[Module])          -- previous context
+        :: ([Module],[(Module, Maybe (ImportDecl RdrName))])          -- previous context
          -> Bool                         -- re-execute :module commands
          -> Bool                         -- re-execute :module commands
-        -> ([Module],[Module])          -- new context
+        -> ([Module],[(Module, Maybe (ImportDecl RdrName))])          -- new context
          -> GHCi ()
  setContextKeepingPackageModules prev_context keep_ctxt (as,bs) = do
    let (_,bs0) = prev_context
    prel_mod <- getPrelude
          -> GHCi ()
  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
-  GHC.setContext as (nub (bs1 ++ pkg_modules))
+  -- filter everything, not just lefts
+  let pkg_modules = filter ((\p -> not (isHomeModule p) && p /= prel_mod) . fst) bs0
+  let bs1 = if null as then nubBy sameFst ((prel_mod,Nothing) : bs) else bs
+  GHC.setContext as (nubBy sameFst (bs1 ++ pkg_modules))
    if keep_ctxt
       then do
            st <- getGHCiState
    if keep_ctxt
       then do
            st <- getGHCiState
@@ -1100,6 +1151,9 @@ setContextKeepingPackageModules prev_context keep_ctxt (as,bs) = do
  isHomeModule :: Module -> Bool
  isHomeModule mod = GHC.modulePackageId mod == mainPackageId
  
  isHomeModule :: Module -> Bool
  isHomeModule mod = GHC.modulePackageId mod == mainPackageId
  
+sameFst :: (Module, Maybe (ImportDecl RdrName)) -> (Module, Maybe (ImportDecl RdrName)) -> Bool
+sameFst x y = fst x == fst y
+
  modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> InputT GHCi ()
  modulesLoadedMsg ok mods = do
    dflags <- getDynFlags
  modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> InputT GHCi ()
  modulesLoadedMsg ok mods = do
    dflags <- getDynFlags
@@ -1110,30 +1164,32 @@ modulesLoadedMsg ok mods = do
             punctuate comma (map ppr mods)) <> text "."
     case ok of
      Failed ->
             punctuate comma (map ppr mods)) <> text "."
     case ok of
      Failed ->
-       outputStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas))
+       liftIO $ putStrLn $ showSDoc (text "Failed, modules loaded: " <> mod_commas)
      Succeeded  ->
      Succeeded  ->
-       outputStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas))
+       liftIO $ putStrLn $ showSDoc (text "Ok, modules loaded: " <> mod_commas)
  
  
  typeOfExpr :: String -> InputT GHCi ()
  typeOfExpr str 
  
  
  typeOfExpr :: String -> InputT GHCi ()
  typeOfExpr str 
-  = handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+  = handleSourceError GHC.printException
+  $ do
         ty <- GHC.exprType str
         dflags <- getDynFlags
         let pefas = dopt Opt_PrintExplicitForalls dflags
         ty <- GHC.exprType str
         dflags <- getDynFlags
         let pefas = dopt Opt_PrintExplicitForalls dflags
-       printForUser' $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
+       printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
  
  kindOfType :: String -> InputT GHCi ()
  kindOfType str 
  
  kindOfType :: String -> InputT GHCi ()
  kindOfType str 
-  = handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+  = handleSourceError GHC.printException
+  $ do
         ty <- GHC.typeKind str
         ty <- GHC.typeKind str
-       printForUser' $ text str <+> dcolon <+> ppr ty
+       printForUser $ text str <+> dcolon <+> ppr ty
  
  quit :: String -> InputT GHCi Bool
  quit _ = return True
  
  shellEscape :: String -> GHCi Bool
  
  quit :: String -> InputT GHCi Bool
  quit _ = return True
  
  shellEscape :: String -> GHCi Bool
-shellEscape str = io (system str >> return False)
+shellEscape str = liftIO (system str >> return False)
  
  -----------------------------------------------------------------------------
  -- Browsing a module's contents
  
  -----------------------------------------------------------------------------
  -- Browsing a module's contents
@@ -1154,8 +1210,8 @@ browseCmd bang m =
                  -- recently-added module occurs last, it seems.
          case (as,bs) of
            (as@(_:_), _)   -> browseModule bang (last as) True
                  -- recently-added module occurs last, it seems.
          case (as,bs) of
            (as@(_:_), _)   -> browseModule bang (last as) True
-          ([],  bs@(_:_)) -> browseModule bang (last bs) True
-          ([],  [])  -> ghcError (CmdLineError ":browse: no current module")
+          ([],  bs@(_:_)) -> browseModule bang (fst (last bs)) True
+          ([], [])  -> ghcError (CmdLineError ":browse: no current module")
      _ -> ghcError (CmdLineError "syntax:  :browse <module>")
  
  -- without bang, show items in context of their parents and omit children
      _ -> ghcError (CmdLineError "syntax:  :browse <module>")
  
  -- without bang, show items in context of their parents and omit children
@@ -1170,7 +1226,7 @@ browseModule bang modl exports_only = do
    -- just so we can get an appropriate PrintUnqualified
    (as,bs) <- GHC.getContext
    prel_mod <- lift getPrelude
    -- just so we can get an appropriate PrintUnqualified
    (as,bs) <- GHC.getContext
    prel_mod <- lift getPrelude
-  if exports_only then GHC.setContext [] [prel_mod,modl]
+  if exports_only then GHC.setContext [] [(prel_mod,Nothing), (modl,Nothing)]
                    else GHC.setContext [modl] []
    target_unqual <- GHC.getPrintUnqual
    GHC.setContext as bs
                    else GHC.setContext [modl] []
    target_unqual <- GHC.getPrintUnqual
    GHC.setContext as bs
@@ -1238,7 +1294,7 @@ browseModule bang modl exports_only = do
          let prettyThings = map (pretty pefas) things
              prettyThings' | bang      = annotate $ zip modNames prettyThings
                            | otherwise = prettyThings
          let prettyThings = map (pretty pefas) things
              prettyThings' | bang      = annotate $ zip modNames prettyThings
                            | otherwise = prettyThings
-        outputStrLn $ showSDocForUser unqual (vcat prettyThings')
+        liftIO $ putStrLn $ showSDocForUser unqual (vcat prettyThings')
          -- ToDo: modInfoInstances currently throws an exception for
          -- package modules.  When it works, we can do this:
          --        $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
          -- ToDo: modInfoInstances currently throws an exception for
          -- package modules.  When it works, we can do this:
          --        $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
@@ -1246,21 +1302,25 @@ browseModule bang modl exports_only = do
  -----------------------------------------------------------------------------
  -- Setting the module context
  
  -----------------------------------------------------------------------------
  -- Setting the module context
  
+newContextCmd :: CtxtCmd -> GHCi ()
+newContextCmd cmd = do
+  playCtxtCmd True cmd
+  st <- getGHCiState
+  let cmds = remembered_ctx st
+  setGHCiState st{ remembered_ctx = cmds ++ [cmd] }
+
  setContext :: String -> GHCi ()
  setContext str
  setContext :: String -> GHCi ()
  setContext str
-  | all sensible strs = do
-       playCtxtCmd True (cmd, as, bs)
-       st <- getGHCiState
-       setGHCiState st{ remembered_ctx = remembered_ctx st ++ [(cmd,as,bs)] }
+  | all sensible strs = newContextCmd cmd
    | otherwise = ghcError (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
    where
    | otherwise = ghcError (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
    where
-    (cmd, strs, as, bs) =
+    (cmd, strs) =
          case str of 
                  '+':stuff -> rest AddModules stuff
                  '-':stuff -> rest RemModules stuff
                  stuff     -> rest SetContext stuff
  
          case str of 
                  '+':stuff -> rest AddModules stuff
                  '-':stuff -> rest RemModules stuff
                  stuff     -> rest SetContext stuff
  
-    rest cmd stuff = (cmd, strs, as, bs)
+    rest cmd stuff = (cmd as bs, strs)
         where strs = words stuff
               (as,bs) = partitionWith starred strs
  
         where strs = words stuff
               (as,bs) = partitionWith starred strs
  
@@ -1270,42 +1330,60 @@ setContext str
      starred ('*':m) = Left m
      starred m       = Right m
  
      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
+playCtxtCmd:: Bool -> CtxtCmd -> GHCi ()
+playCtxtCmd fail cmd = do
      (prev_as,prev_bs) <- GHC.getContext
      (prev_as,prev_bs) <- GHC.getContext
-    (new_as, new_bs) <-
-      case cmd of
-        SetContext -> do
+    case cmd of
+        SetContext as bs -> do
+          (as',bs') <- do_checks as bs
            prel_mod <- getPrelude
            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
+          let bs'' = if null as && prel_mod `notElem` (map fst bs')
+                        then (prel_mod,Nothing):bs'
+                        else bs'
+          GHC.setContext as' bs''
+
+        AddModules as bs -> do
+          (as',bs') <- do_checks as bs
+          -- it should replace the old stuff, not the other way around
+          -- need deleteAllBy, not deleteFirstsBy for sameFst
+          let remaining_as = prev_as \\ (as' ++ map fst bs')
+              remaining_bs = deleteAllBy sameFst prev_bs (bs' ++ map contextualize as')
+          GHC.setContext (remaining_as ++ as') (remaining_bs ++ bs')
+
+        RemModules as bs -> do
+          (as',bs') <- do_checks as bs
+          let new_as = prev_as \\ (as' ++ map fst bs')
+              new_bs = deleteAllBy sameFst prev_bs (map contextualize as' ++ bs')
+          GHC.setContext new_as new_bs
+
+        Import str -> do
+          m_idecl <- maybe_fail $ GHC.parseImportDecl str
+          case m_idecl of
+            Nothing    -> return ()
+            Just idecl -> do
+              m_mdl <- maybe_fail $ loadModuleName idecl
+              case m_mdl of
+                Nothing -> return ()
+                Just m -> GHC.setContext prev_as (prev_bs ++ [(m, Just idecl)])
+    
    where
    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)
+    maybe_fail | fail      = liftM Just
+               | otherwise = trymaybe
+
+    do_checks as bs = do
+         as' <- mapM (maybe_fail . wantInterpretedModule) as
+         bs' <- mapM (maybe_fail . lookupModule) bs
+         return (catMaybes as', map contextualize (catMaybes bs'))
+
+    contextualize x = (x,Nothing)
+    deleteAllBy f a b = filter (\x->(not (any (f x) b))) a
+
+trymaybe ::GHCi a -> GHCi (Maybe a)
+trymaybe m = do
+    r <- ghciTry m
+    case r of
+      Left _  -> return Nothing
+      Right a -> return (Just a)
  
  ----------------------------------------------------------------------------
  -- Code for `:set'
  
  ----------------------------------------------------------------------------
  -- Code for `:set'
@@ -1321,28 +1399,26 @@ setCmd :: String -> GHCi ()
  setCmd ""
    = do st <- getGHCiState
         let opts = options st
  setCmd ""
    = do st <- getGHCiState
         let opts = options st
-       io $ putStrLn (showSDoc (
+       liftIO $ putStrLn (showSDoc (
               text "options currently set: " <> 
               if null opts
                    then text "none."
                    else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
            ))
         dflags <- getDynFlags
               text "options currently set: " <> 
               if null opts
                    then text "none."
                    else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
            ))
         dflags <- getDynFlags
-       io $ putStrLn (showSDoc (
+       liftIO $ putStrLn (showSDoc (
            vcat (text "GHCi-specific dynamic flag settings:" 
                 :map (flagSetting dflags) ghciFlags)
            ))
            vcat (text "GHCi-specific dynamic flag settings:" 
                 :map (flagSetting dflags) ghciFlags)
            ))
-       io $ putStrLn (showSDoc (
+       liftIO $ putStrLn (showSDoc (
            vcat (text "other dynamic, non-language, flag settings:" 
            vcat (text "other dynamic, non-language, flag settings:" 
-               :map (flagSetting dflags) nonLanguageDynFlags)
+               :map (flagSetting dflags) others)
            ))
    where flagSetting dflags (str, f, _)
            | dopt f dflags = text "  " <> text "-f"    <> text str
            | otherwise     = text "  " <> text "-fno-" <> text str
          (ghciFlags,others)  = partition (\(_, f, _) -> f `elem` flags)
                                          DynFlags.fFlags
            ))
    where flagSetting dflags (str, f, _)
            | dopt f dflags = text "  " <> text "-f"    <> text str
            | otherwise     = text "  " <> text "-fno-" <> text str
          (ghciFlags,others)  = partition (\(_, f, _) -> f `elem` flags)
                                          DynFlags.fFlags
-        nonLanguageDynFlags = filterOut (\(_, f, _) -> f `elem` languageOptions)
-                                        others
          flags = [Opt_PrintExplicitForalls
                  ,Opt_PrintBindResult
                  ,Opt_BreakOnException
          flags = [Opt_PrintExplicitForalls
                  ,Opt_PrintBindResult
                  ,Opt_BreakOnException
@@ -1353,17 +1429,17 @@ setCmd str
    = case getCmd str of
      Right ("args",   rest) ->
          case toArgs rest of
    = case getCmd str of
      Right ("args",   rest) ->
          case toArgs rest of
-            Left err -> io (hPutStrLn stderr err)
+            Left err -> liftIO (hPutStrLn stderr err)
              Right args -> setArgs args
      Right ("prog",   rest) ->
          case toArgs rest of
              Right [prog] -> setProg prog
              Right args -> setArgs args
      Right ("prog",   rest) ->
          case toArgs rest of
              Right [prog] -> setProg prog
-            _ -> io (hPutStrLn stderr "syntax: :set prog <progname>")
+            _ -> liftIO (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
      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)
+         Left err -> liftIO (hPutStrLn stderr err)
           Right wds -> setOptions wds
  
  setArgs, setOptions :: [String] -> GHCi ()
           Right wds -> setOptions wds
  
  setArgs, setOptions :: [String] -> GHCi ()
@@ -1401,13 +1477,13 @@ setStop cmd = do
  setPrompt value = do
    st <- getGHCiState
    if null value
  setPrompt value = do
    st <- getGHCiState
    if null value
-      then io $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
+      then liftIO $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
        else case value of
             '\"' : _ -> case reads value of
                         [(value', xs)] | all isSpace xs ->
                             setGHCiState (st { prompt = value' })
                         _ ->
        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."
+                           liftIO $ hPutStrLn stderr "Can't parse prompt string. Use Haskell syntax."
             _ -> setGHCiState (st { prompt = value })
  
  setOptions wds =
             _ -> setGHCiState (st { prompt = value })
  
  setOptions wds =
@@ -1421,8 +1497,8 @@ 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, warns) <- io $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts
-      handleFlagWarnings dflags' warns
+      (dflags', leftovers, warns) <- liftIO $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts
+      liftIO $ handleFlagWarnings dflags' warns
  
        if (not (null leftovers))
          then ghcError $ errorsToGhcException leftovers
  
        if (not (null leftovers))
          then ghcError $ errorsToGhcException leftovers
@@ -1434,10 +1510,10 @@ 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, resetting and loading new packages..."
+        liftIO $ hPutStrLn stderr "package flags have changed, resetting and loading new packages..."
          GHC.setTargets []
          GHC.setTargets []
-        GHC.load LoadAllTargets
-        io (linkPackages dflags new_pkgs)
+        _ <- GHC.load LoadAllTargets
+        liftIO (linkPackages dflags new_pkgs)
          -- package flags changed, we can't re-use any of the old context
          setContextAfterLoad ([],[]) False []
        return ()
          -- package flags changed, we can't re-use any of the old context
          setContextAfterLoad ([],[]) False []
        return ()
@@ -1445,22 +1521,32 @@ newDynFlags minus_opts = do
  
  unsetOptions :: String -> GHCi ()
  unsetOptions str
  
  unsetOptions :: String -> GHCi ()
  unsetOptions str
-  = do -- first, deal with the GHCi opts (+s, +t, etc.)
-       let opts = words str
-          (minus_opts, rest1) = partition isMinus opts
-          (plus_opts, rest2)  = partitionWith isPlus rest1
-
-       if (not (null rest2)) 
-         then io (putStrLn ("unknown option: '" ++ head rest2 ++ "'"))
-         else do
+  =   -- first, deal with the GHCi opts (+s, +t, etc.)
+     let opts = words str
+         (minus_opts, rest1) = partition isMinus opts
+         (plus_opts, rest2)  = partitionWith isPlus rest1
+         (other_opts, rest3) = partition (`elem` map fst defaulters) rest2
+
+         defaulters = 
+           [ ("args"  , setArgs default_args)
+           , ("prog"  , setProg default_progname)
+           , ("prompt", setPrompt default_prompt)
+           , ("editor", liftIO findEditor >>= setEditor)
+           , ("stop"  , setStop default_stop)
+           ]
+
+         no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
+         no_flag f = ghcError (ProgramError ("don't know how to reverse " ++ f))
+
+     in if (not (null rest3))
+           then liftIO (putStrLn ("unknown option: '" ++ head rest3 ++ "'"))
+           else do
+             mapM_ (fromJust.flip lookup defaulters) other_opts
  
  
-       mapM_ unsetOpt plus_opts
- 
-       let no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
-           no_flag f = ghcError (ProgramError ("don't know how to reverse " ++ f))
+             mapM_ unsetOpt plus_opts
  
  
-       no_flags <- mapM no_flag minus_opts
-       newDynFlags no_flags
+             no_flags <- mapM no_flag minus_opts
+             newDynFlags no_flags
  
  isMinus :: String -> Bool
  isMinus ('-':_) = True
  
  isMinus :: String -> Bool
  isMinus ('-':_) = True
@@ -1474,12 +1560,12 @@ setOpt, unsetOpt :: String -> GHCi ()
  
  setOpt str
    = case strToGHCiOpt str of
  
  setOpt str
    = case strToGHCiOpt str of
-       Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
+       Nothing -> liftIO (putStrLn ("unknown option: '" ++ str ++ "'"))
         Just o  -> setOption o
  
  unsetOpt str
    = case strToGHCiOpt str of
         Just o  -> setOption o
  
  unsetOpt str
    = case strToGHCiOpt str of
-       Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
+       Nothing -> liftIO (putStrLn ("unknown option: '" ++ str ++ "'"))
         Just o  -> unsetOption o
  
  strToGHCiOpt :: String -> (Maybe GHCiOption)
         Just o  -> unsetOption o
  
  strToGHCiOpt :: String -> (Maybe GHCiOption)
@@ -1500,14 +1586,14 @@ showCmd :: String -> GHCi ()
  showCmd str = do
    st <- getGHCiState
    case words str of
  showCmd str = do
    st <- getGHCiState
    case words str of
-        ["args"]     -> io $ putStrLn (show (args st))
-        ["prog"]     -> io $ putStrLn (show (progname st))
-        ["prompt"]   -> io $ putStrLn (show (prompt st))
-        ["editor"]   -> io $ putStrLn (show (editor st))
-        ["stop"]     -> io $ putStrLn (show (stop st))
+        ["args"]     -> liftIO $ putStrLn (show (args st))
+        ["prog"]     -> liftIO $ putStrLn (show (progname st))
+        ["prompt"]   -> liftIO $ putStrLn (show (prompt st))
+        ["editor"]   -> liftIO $ putStrLn (show (editor st))
+        ["stop"]     -> liftIO $ putStrLn (show (stop st))
         ["modules" ] -> showModules
         ["bindings"] -> showBindings
         ["modules" ] -> showModules
         ["bindings"] -> showBindings
-       ["linker"]   -> io showLinkerState
+       ["linker"]   -> liftIO showLinkerState
          ["breaks"]   -> showBkptTable
          ["context"]  -> showContext
          ["packages"]  -> showPackages
          ["breaks"]   -> showBkptTable
          ["context"]  -> showContext
          ["packages"]  -> showPackages
@@ -1519,7 +1605,7 @@ showModules :: GHCi ()
  showModules = do
    loaded_mods <- getLoadedModules
          -- we want *loaded* modules only, see #1734
  showModules = do
    loaded_mods <- getLoadedModules
          -- we want *loaded* modules only, see #1734
-  let show_one ms = do m <- GHC.showModule ms; io (putStrLn m)
+  let show_one ms = do m <- GHC.showModule ms; liftIO (putStrLn m)
    mapM_ show_one loaded_mods
  
  getLoadedModules :: GHC.GhcMonad m => m [GHC.ModSummary]
    mapM_ show_one loaded_mods
  
  getLoadedModules :: GHC.GhcMonad m => m [GHC.ModSummary]
@@ -1559,29 +1645,26 @@ showContext = do
  showPackages :: GHCi ()
  showPackages = do
    pkg_flags <- fmap packageFlags getDynFlags
  showPackages :: GHCi ()
  showPackages = do
    pkg_flags <- fmap packageFlags getDynFlags
-  io $ putStrLn $ showSDoc $ vcat $
+  liftIO $ putStrLn $ showSDoc $ vcat $
      text ("active package flags:"++if null pkg_flags then " none" else "")
      : map showFlag pkg_flags
      text ("active package flags:"++if null pkg_flags then " none" else "")
      : map showFlag pkg_flags
-  pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags
-  io $ putStrLn $ showSDoc $ vcat $
-    text "packages currently loaded:" 
-    : map (nest 2 . text . packageIdString) 
-               (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
+        showFlag (ExposePackageId p) = text $ "  -package-id " ++ p
  
  showLanguages :: GHCi ()
  showLanguages = do
     dflags <- getDynFlags
  
  showLanguages :: GHCi ()
  showLanguages = do
     dflags <- getDynFlags
-   io $ putStrLn $ showSDoc $ vcat $
+   liftIO $ putStrLn $ showSDoc $ vcat $
        text "active language flags:" :
        text "active language flags:" :
-      [text ("  -X" ++ str) | (str, f, _) <- DynFlags.xFlags, dopt f dflags]
+      [text ("  -X" ++ str) | (str, f, _) <- DynFlags.xFlags, xopt f dflags]
  
  -- -----------------------------------------------------------------------------
  -- Completion
  
  completeCmd, completeMacro, completeIdentifier, completeModule,
  
  -- -----------------------------------------------------------------------------
  -- Completion
  
  completeCmd, completeMacro, completeIdentifier, completeModule,
+    completeSetModule,
      completeHomeModule, completeSetOptions, completeShowOptions,
      completeHomeModuleOrFile, completeExpression
      :: CompletionFunc GHCi
      completeHomeModule, completeSetOptions, completeShowOptions,
      completeHomeModuleOrFile, completeExpression
      :: CompletionFunc GHCi
@@ -1604,9 +1687,13 @@ ghciCompleteWord line@(left,_) = case firstWord of
              Nothing -> return completeFilename
  
  completeCmd = wrapCompleter " " $ \w -> do
              Nothing -> return completeFilename
  
  completeCmd = wrapCompleter " " $ \w -> do
-  cmds <- liftIO $ readIORef macros_ref
-  return (filter (w `isPrefixOf`) (map (':':) 
-             (map cmdName (builtin_commands ++ cmds))))
+  macros <- liftIO $ readIORef macros_ref
+  let macro_names = map (':':) . map cmdName $ macros
+  let command_names = map (':':) . map cmdName $ builtin_commands
+  let{ candidates = case w of
+      ':' : ':' : _ -> map (':':) command_names
+      _ -> nub $ macro_names ++ command_names }
+  return $ filter (w `isPrefixOf`) candidates
  
  completeMacro = wrapIdentCompleter $ \w -> do
    cmds <- liftIO $ readIORef macros_ref
  
  completeMacro = wrapIdentCompleter $ \w -> do
    cmds <- liftIO $ readIORef macros_ref
@@ -1623,6 +1710,18 @@ completeModule = wrapIdentCompleter $ \w -> do
    return $ filter (w `isPrefixOf`)
          $ map (showSDoc.ppr) $ loaded_mods ++ pkg_mods
  
    return $ filter (w `isPrefixOf`)
          $ map (showSDoc.ppr) $ loaded_mods ++ pkg_mods
  
+completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
+  modules <- case m of
+    Just '-' -> do
+      (toplevs, exports) <- GHC.getContext
+      return $ map GHC.moduleName (nub (map fst exports) ++ toplevs)
+    _ -> do
+      dflags <- GHC.getSessionDynFlags
+      let pkg_mods = allExposedModules dflags
+      loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
+      return $ loaded_mods ++ pkg_mods
+  return $ filter (w `isPrefixOf`) $ map (showSDoc.ppr) modules
+
  completeHomeModule = wrapIdentCompleter listHomeModules
  
  listHomeModules :: String -> GHCi [String]
  completeHomeModule = wrapIdentCompleter listHomeModules
  
  listHomeModules :: String -> GHCi [String]
@@ -1660,6 +1759,12 @@ wrapCompleter breakChars fun = completeWord Nothing breakChars
  wrapIdentCompleter :: (String -> GHCi [String]) -> CompletionFunc GHCi
  wrapIdentCompleter = wrapCompleter word_break_chars
  
  wrapIdentCompleter :: (String -> GHCi [String]) -> CompletionFunc GHCi
  wrapIdentCompleter = wrapCompleter word_break_chars
  
+wrapIdentCompleterWithModifier :: String -> (Maybe Char -> String -> GHCi [String]) -> CompletionFunc GHCi
+wrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing word_break_chars
+    $ \rest -> fmap (map simpleCompletion) . fmap sort . fun (getModifier rest)
+ where
+  getModifier = find (`elem` modifChars)
+
  allExposedModules :: DynFlags -> [ModuleName]
  allExposedModules dflags 
   = concat (map exposedModules (filter exposed (eltsUFM pkg_db)))
  allExposedModules :: DynFlags -> [ModuleName]
  allExposedModules dflags 
   = concat (map exposedModules (filter exposed (eltsUFM pkg_db)))
@@ -1686,19 +1791,21 @@ handler :: SomeException -> GHCi Bool
  
  handler exception = do
    flushInterpBuffers
  
  handler exception = do
    flushInterpBuffers
-  io installSignalHandlers
+  liftIO installSignalHandlers
    ghciHandle handler (showException exception >> return False)
  
  showException :: SomeException -> GHCi ()
  showException se =
    ghciHandle handler (showException exception >> return False)
  
  showException :: SomeException -> GHCi ()
  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
-       Nothing                  -> putStrLn ("*** Exception: " ++ show se)
+  liftIO $ case fromException se of
+           -- 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                  ->
+               case fromException se of
+               Just UserInterrupt -> putStrLn "Interrupted."
+               _                  -> putStrLn ("*** Exception: " ++ show se)
  
  -----------------------------------------------------------------------------
  -- recursive exception handlers
  
  -----------------------------------------------------------------------------
  -- recursive exception handlers
@@ -1750,7 +1857,7 @@ wantNameFromInterpretedModule :: GHC.GhcMonad m
                                -> (Name -> m ())
                                -> m ()
  wantNameFromInterpretedModule noCanDo str and_then =
                                -> (Name -> m ())
                                -> m ()
  wantNameFromInterpretedModule noCanDo str and_then =
-  handleSourceError (GHC.printExceptionAndWarnings) $ do
+  handleSourceError GHC.printException $ do
     names <- GHC.parseName str
     case names of
        []    -> return ()
     names <- GHC.parseName str
     case names of
        []    -> return ()
@@ -1780,7 +1887,7 @@ pprintCommand bind force str = do
  
  stepCmd :: String -> GHCi ()
  stepCmd []         = doContinue (const True) GHC.SingleStep
  
  stepCmd :: String -> GHCi ()
  stepCmd []         = doContinue (const True) GHC.SingleStep
-stepCmd expression = do runStmt expression GHC.SingleStep; return ()
+stepCmd expression = runStmt expression GHC.SingleStep >> return ()
  
  stepLocalCmd :: String -> GHCi ()
  stepLocalCmd  [] = do 
  
  stepLocalCmd :: String -> GHCi ()
  stepLocalCmd  [] = do 
@@ -1818,7 +1925,7 @@ enclosingTickSpan mod src = do
  
  traceCmd :: String -> GHCi ()
  traceCmd []         = doContinue (const True) GHC.RunAndLogSteps
  
  traceCmd :: String -> GHCi ()
  traceCmd []         = doContinue (const True) GHC.RunAndLogSteps
-traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
+traceCmd expression = runStmt expression GHC.RunAndLogSteps >> return ()
  
  continueCmd :: String -> GHCi ()
  continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
  
  continueCmd :: String -> GHCi ()
  continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
@@ -1827,22 +1934,21 @@ continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
  doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
  doContinue pred step = do 
    runResult <- resume pred step
  doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
  doContinue pred step = do 
    runResult <- resume pred step
-  afterRunStmt pred runResult
+  _ <- afterRunStmt pred runResult
    return ()
  
  abandonCmd :: String -> GHCi ()
  abandonCmd = noArgs $ do
    b <- GHC.abandon -- the prompt will change to indicate the new context
    return ()
  
  abandonCmd :: String -> GHCi ()
  abandonCmd = noArgs $ do
    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) $ liftIO $ putStrLn "There is no computation running."
  
  deleteCmd :: String -> GHCi ()
  deleteCmd argLine = do
     deleteSwitch $ words argLine
     where
     deleteSwitch :: [String] -> GHCi ()
  
  deleteCmd :: String -> GHCi ()
  deleteCmd argLine = do
     deleteSwitch $ words argLine
     where
     deleteSwitch :: [String] -> GHCi ()
-   deleteSwitch [] = 
-      io $ putStrLn "The delete command requires at least one argument."
+   deleteSwitch [] =
+      liftIO $ putStrLn "The delete command requires at least one argument."
     -- delete all break points
     deleteSwitch ("*":_rest) = discardActiveBreakPoints
     deleteSwitch idents = do
     -- delete all break points
     deleteSwitch ("*":_rest) = discardActiveBreakPoints
     deleteSwitch idents = do
@@ -1857,28 +1963,28 @@ historyCmd :: String -> GHCi ()
  historyCmd arg
    | null arg        = history 20
    | all isDigit arg = history (read arg)
  historyCmd arg
    | null arg        = history 20
    | all isDigit arg = history (read arg)
-  | otherwise       = io $ putStrLn "Syntax:  :history [num]"
+  | otherwise       = liftIO $ putStrLn "Syntax:  :history [num]"
    where
    history num = do
      resumes <- GHC.getResumeContext
      case resumes of
    where
    history num = do
      resumes <- GHC.getResumeContext
      case resumes of
-      [] -> io $ putStrLn "Not stopped at a breakpoint"
+      [] -> liftIO $ putStrLn "Not stopped at a breakpoint"
        (r:_) -> do
          let hist = GHC.resumeHistory r
              (took,rest) = splitAt num hist
          case hist of
        (r:_) -> do
          let hist = GHC.resumeHistory r
              (took,rest) = splitAt num hist
          case hist of
-          [] -> io $ putStrLn $ 
+          [] -> liftIO $ putStrLn $
                     "Empty history. Perhaps you forgot to use :trace?"
            _  -> do
                   spans <- mapM GHC.getHistorySpan took
                   let nums  = map (printf "-%-3d:") [(1::Int)..]
                     "Empty history. Perhaps you forgot to use :trace?"
            _  -> do
                   spans <- mapM GHC.getHistorySpan took
                   let nums  = map (printf "-%-3d:") [(1::Int)..]
-                     names = map GHC.historyEnclosingDecl took
+                     names = map GHC.historyEnclosingDecls took
                   printForUser (vcat(zipWith3 
                                   (\x y z -> x <+> y <+> z) 
                                   (map text nums) 
                   printForUser (vcat(zipWith3 
                                   (\x y z -> x <+> y <+> z) 
                                   (map text nums) 
-                                 (map (bold . ppr) names)
+                                 (map (bold . hcat . punctuate colon . map text) names)
                                   (map (parens . ppr) spans)))
                                   (map (parens . ppr) spans)))
-                 io $ putStrLn $ if null rest then "<end of history>" else "..."
+                 liftIO $ putStrLn $ if null rest then "<end of history>" else "..."
  
  bold :: SDoc -> SDoc
  bold c | do_bold   = text start_bold <> c <> text end_bold
  
  bold :: SDoc -> SDoc
  bold c | do_bold   = text start_bold <> c <> text end_bold
@@ -1911,7 +2017,7 @@ breakCmd argLine = do
  
  breakSwitch :: [String] -> GHCi ()
  breakSwitch [] = do
  
  breakSwitch :: [String] -> GHCi ()
  breakSwitch [] = do
-   io $ putStrLn "The break command requires at least one argument."
+   liftIO $ putStrLn "The break command requires at least one argument."
  breakSwitch (arg1:rest)
     | looksLikeModuleName arg1 && not (null rest) = do
          mod <- wantInterpretedModule arg1
  breakSwitch (arg1:rest)
     | looksLikeModuleName arg1 && not (null rest) = do
          mod <- wantInterpretedModule arg1
@@ -1921,8 +2027,8 @@ breakSwitch (arg1:rest)
          case toplevel of
             (mod : _) -> breakByModuleLine mod (read arg1) rest
             [] -> do 
          case toplevel of
             (mod : _) -> breakByModuleLine mod (read arg1) rest
             [] -> do 
-              io $ putStrLn "Cannot find default module for breakpoint." 
-              io $ putStrLn "Perhaps no modules are loaded for debugging?"
+              liftIO $ putStrLn "Cannot find default module for breakpoint." 
+              liftIO $ putStrLn "Perhaps no modules are loaded for debugging?"
     | otherwise = do -- try parsing it as an identifier
          wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
          let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
     | otherwise = do -- try parsing it as an identifier
          wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
          let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
@@ -1959,9 +2065,9 @@ findBreakAndSet mod lookupTickTree = do
     tickArray <- getTickArray mod
     (breakArray, _) <- getModBreak mod
     case lookupTickTree tickArray of 
     tickArray <- getTickArray mod
     (breakArray, _) <- getModBreak mod
     case lookupTickTree tickArray of 
-      Nothing  -> io $ putStrLn $ "No breakpoints found at that location."
+      Nothing  -> liftIO $ putStrLn $ "No breakpoints found at that location."
        Just (tick, span) -> do
        Just (tick, span) -> do
-         success <- io $ setBreakFlag True breakArray tick 
+         success <- liftIO $ setBreakFlag True breakArray tick
           if success 
              then do
                 (alreadySet, nm) <- 
           if success 
              then do
                 (alreadySet, nm) <- 
@@ -2040,11 +2146,14 @@ end_bold :: String
  end_bold   = "\ESC[0m"
  
  listCmd :: String -> InputT GHCi ()
  end_bold   = "\ESC[0m"
  
  listCmd :: String -> InputT GHCi ()
-listCmd "" = do
+listCmd c = listCmd' c
+
+listCmd' :: String -> InputT GHCi ()
+listCmd' "" = do
     mb_span <- lift getCurrentBreakSpan
     case mb_span of
        Nothing ->
     mb_span <- lift getCurrentBreakSpan
     case mb_span of
        Nothing ->
-          printForUser' $ text "Not stopped at a breakpoint; nothing to list"
+          printForUser $ text "Not stopped at a breakpoint; nothing to list"
        Just span
         | GHC.isGoodSrcSpan span -> listAround span True
         | otherwise ->
        Just span
         | GHC.isGoodSrcSpan span -> listAround span True
         | otherwise ->
@@ -2056,16 +2165,16 @@ listCmd "" = do
                                        [] -> text "rerunning with :trace,"
                                        _ -> empty
                              doWhat = traceIt <+> text ":back then :list"
                                        [] -> text "rerunning with :trace,"
                                        _ -> empty
                              doWhat = traceIt <+> text ":back then :list"
-                        printForUser' (text "Unable to list source for" <+>
+                        printForUser (text "Unable to list source for" <+>
                                        ppr span
                                     $$ text "Try" <+> doWhat)
                                        ppr span
                                     $$ text "Try" <+> doWhat)
-listCmd str = list2 (words str)
+listCmd' str = list2 (words str)
  
  list2 :: [String] -> InputT GHCi ()
  list2 [arg] | all isDigit arg = do
      (toplevel, _) <- GHC.getContext
      case toplevel of
  
  list2 :: [String] -> InputT GHCi ()
  list2 [arg] | all isDigit arg = do
      (toplevel, _) <- GHC.getContext
      case toplevel of
-        [] -> outputStrLn "No module to list"
+        [] -> liftIO $ putStrLn "No module to list"
          (mod : _) -> listModuleLine mod (read arg)
  list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
          mod <- wantInterpretedModule arg1
          (mod : _) -> listModuleLine mod (read arg)
  list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
          mod <- wantInterpretedModule arg1
@@ -2087,10 +2196,10 @@ list2 [arg] = do
                    noCanDo name $ text "can't find its location: " <>
                                   ppr loc
      where
                    noCanDo name $ text "can't find its location: " <>
                                   ppr loc
      where
-        noCanDo n why = printForUser' $
+        noCanDo n why = printForUser $
              text "cannot list source code for " <> ppr n <> text ": " <> why
  list2  _other = 
              text "cannot list source code for " <> ppr n <> text ": " <> why
  list2  _other = 
-        outputStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
+        liftIO $ putStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
  
  listModuleLine :: Module -> Int -> InputT GHCi ()
  listModuleLine modl line = do
  
  listModuleLine :: Module -> Int -> InputT GHCi ()
  listModuleLine modl line = do
@@ -2131,13 +2240,13 @@ listAround span do_highlight = do
        let output = BS.intercalate (BS.pack "\n") prefixed
        utf8Decoded <- liftIO $ BS.useAsCStringLen output
                          $ \(p,n) -> utf8DecodeString (castPtr p) n
        let output = BS.intercalate (BS.pack "\n") prefixed
        utf8Decoded <- liftIO $ BS.useAsCStringLen output
                          $ \(p,n) -> utf8DecodeString (castPtr p) n
-      outputStrLn utf8Decoded
+      liftIO $ putStrLn utf8Decoded
    where
          file  = GHC.srcSpanFile span
          line1 = GHC.srcSpanStartLine span
    where
          file  = GHC.srcSpanFile span
          line1 = GHC.srcSpanStartLine span
-        col1  = GHC.srcSpanStartCol span
+        col1  = GHC.srcSpanStartCol span - 1
          line2 = GHC.srcSpanEndLine span
          line2 = GHC.srcSpanEndLine span
-        col2  = GHC.srcSpanEndCol span
+        col2  = GHC.srcSpanEndCol span - 1
  
          pad_before | line1 == 1 = 0
                     | otherwise  = 1
  
          pad_before | line1 == 1 = 0
                     | otherwise  = 1
@@ -2213,7 +2322,7 @@ lookupModule modName
  discardActiveBreakPoints :: GHCi ()
  discardActiveBreakPoints = do
     st <- getGHCiState
  discardActiveBreakPoints :: GHCi ()
  discardActiveBreakPoints = do
     st <- getGHCiState
-   mapM (turnOffBreak.snd) (breaks st)
+   mapM_ (turnOffBreak.snd) (breaks st)
     setGHCiState $ st { breaks = [] }
  
  deleteBreak :: Int -> GHCi ()
     setGHCiState $ st { breaks = [] }
  
  deleteBreak :: Int -> GHCi ()
@@ -2225,13 +2334,13 @@ deleteBreak identity = do
        then printForUser (text "Breakpoint" <+> ppr identity <+>
                           text "does not exist")
        else do
        then printForUser (text "Breakpoint" <+> ppr identity <+>
                           text "does not exist")
        else do
-           mapM (turnOffBreak.snd) this
+           mapM_ (turnOffBreak.snd) this
             setGHCiState $ st { breaks = rest }
  
  turnOffBreak :: BreakLocation -> GHCi Bool
  turnOffBreak loc = do
    (arr, _) <- getModBreak (breakModule loc)
             setGHCiState $ st { breaks = rest }
  
  turnOffBreak :: BreakLocation -> GHCi Bool
  turnOffBreak loc = do
    (arr, _) <- getModBreak (breakModule loc)
-  io $ setBreakFlag False arr (breakTick loc)
+  liftIO $ setBreakFlag False arr (breakTick loc)
  
  getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
  getModBreak mod = do
  
  getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
  getModBreak mod = do