Use haskeline, rather than editline, for line editing in ghci

5 files changed, 2795 insertions, 7 deletions

diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
new file mode 100644
index 0000000000..341e94a5e3
--- /dev/null
+++ b/ghc/GhciMonad.hs
@@ -0,0 +1,389 @@
+{-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
+-----------------------------------------------------------------------------
+--
+-- Monadery code used in InteractiveUI
+--
+-- (c) The GHC Team 2005-2006
+--
+-----------------------------------------------------------------------------
+
+module GhciMonad where
+
+#include "HsVersions.h"
+
+import qualified GHC
+import Outputable       hiding (printForUser, printForUserPartWay)
+import qualified Pretty
+import qualified Outputable
+import Panic            hiding (showException)
+import Util
+import DynFlags
+import HscTypes hiding (liftIO)
+import SrcLoc
+import Module
+import ObjLink
+import Linker
+import StaticFlags
+import qualified MonadUtils
+import qualified ErrUtils
+
+import Exception
+import Data.Maybe
+import Numeric
+import Data.Array
+import Data.Char
+import Data.Int         ( Int64 )
+import Data.IORef
+import Data.List
+import System.CPUTime
+import System.Environment
+import System.IO
+import Control.Monad as Monad
+import GHC.Exts
+
+import System.Console.Haskeline (CompletionFunc, InputT)
+import qualified System.Console.Haskeline as Haskeline
+import System.Console.Haskeline.Encoding
+import Control.Monad.Trans as Trans
+import qualified Data.ByteString as B
+
+-----------------------------------------------------------------------------
+-- GHCi monad
+
+type Command = (String, String -> InputT GHCi Bool, CompletionFunc GHCi)
+
+data GHCiState = GHCiState
+     { 
+	progname       :: String,
+	args	       :: [String],
+        prompt         :: String,
+	editor         :: String,
+        stop           :: String,
+	options        :: [GHCiOption],
+        prelude        :: GHC.Module,
+        break_ctr      :: !Int,
+        breaks         :: ![(Int, BreakLocation)],
+        tickarrays     :: ModuleEnv TickArray,
+                -- tickarrays caches the TickArray for loaded modules,
+                -- so that we don't rebuild it each time the user sets
+                -- a breakpoint.
+        -- ":" at the GHCi prompt repeats the last command, so we
+        -- remember is here:
+        last_command   :: Maybe Command,
+        cmdqueue       :: [String],
+        remembered_ctx :: [(CtxtCmd, [String], [String])],
+             -- we remember the :module commands between :loads, so that
+             -- on a :reload we can replay them.  See bugs #2049,
+             -- \#1873, #1360. Previously we tried to remember modules that
+             -- were supposed to be in the context but currently had errors,
+             -- but this was complicated.  Just replaying the :module commands
+             -- seems to be the right thing.
+        ghc_e :: Bool -- True if this is 'ghc -e' (or runghc)
+     }
+
+data CtxtCmd
+  = SetContext
+  | AddModules
+  | RemModules
+
+type TickArray = Array Int [(BreakIndex,SrcSpan)]
+
+data GHCiOption 
+	= ShowTiming		-- show time/allocs after evaluation
+	| ShowType		-- show the type of expressions
+	| RevertCAFs		-- revert CAFs after every evaluation
+	deriving Eq
+
+data BreakLocation
+   = BreakLocation
+   { breakModule :: !GHC.Module
+   , breakLoc    :: !SrcSpan
+   , breakTick   :: {-# UNPACK #-} !Int
+   , onBreakCmd  :: String
+   } 
+
+instance Eq BreakLocation where
+  loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
+                 breakTick loc1   == breakTick loc2
+
+prettyLocations :: [(Int, BreakLocation)] -> SDoc
+prettyLocations []   = text "No active breakpoints." 
+prettyLocations locs = vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ reverse $ locs
+
+instance Outputable BreakLocation where
+   ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+>
+                if null (onBreakCmd loc)
+                   then empty
+                   else doubleQuotes (text (onBreakCmd loc))
+
+recordBreak :: BreakLocation -> GHCi (Bool{- was already present -}, Int)
+recordBreak brkLoc = do
+   st <- getGHCiState
+   let oldActiveBreaks = breaks st 
+   -- don't store the same break point twice
+   case [ nm | (nm, loc) <- oldActiveBreaks, loc == brkLoc ] of
+     (nm:_) -> return (True, nm)
+     [] -> do
+      let oldCounter = break_ctr st
+          newCounter = oldCounter + 1
+      setGHCiState $ st { break_ctr = newCounter,
+                          breaks = (oldCounter, brkLoc) : oldActiveBreaks
+                        }
+      return (False, oldCounter)
+
+newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> Ghc a }
+
+reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
+reflectGHCi (s, gs) m = unGhc (unGHCi m gs) s
+
+reifyGHCi :: ((Session, IORef GHCiState) -> IO a) -> GHCi a
+reifyGHCi f = GHCi f'
+  where
+    -- f' :: IORef GHCiState -> Ghc a
+    f' gs = reifyGhc (f'' gs)
+    -- f'' :: IORef GHCiState -> Session -> IO a
+    f'' gs s = f (s, gs)
+
+startGHCi :: GHCi a -> GHCiState -> Ghc a
+startGHCi g state = do ref <- liftIO $ newIORef state; unGHCi g ref
+
+instance Monad GHCi where
+  (GHCi m) >>= k  =  GHCi $ \s -> m s >>= \a -> unGHCi (k a) s
+  return a  = GHCi $ \_ -> return a
+
+instance Functor GHCi where
+    fmap f m = m >>= return . f
+
+ghciHandleGhcException :: (GhcException -> GHCi a) -> GHCi a -> GHCi a
+ghciHandleGhcException = handleGhcException
+
+getGHCiState :: GHCi GHCiState
+getGHCiState   = GHCi $ \r -> liftIO $ readIORef r
+setGHCiState :: GHCiState -> GHCi ()
+setGHCiState s = GHCi $ \r -> liftIO $ writeIORef r s
+
+liftGhc :: Ghc a -> GHCi a
+liftGhc m = GHCi $ \_ -> m
+
+instance MonadUtils.MonadIO GHCi where
+  liftIO = liftGhc . MonadUtils.liftIO
+
+instance Trans.MonadIO Ghc where
+  liftIO = MonadUtils.liftIO
+
+instance GhcMonad GHCi where
+  setSession s' = liftGhc $ setSession s'
+  getSession    = liftGhc $ getSession
+
+instance GhcMonad (InputT GHCi) where
+  setSession = lift . setSession
+  getSession = lift getSession
+
+instance MonadUtils.MonadIO (InputT GHCi) where
+  liftIO = Trans.liftIO
+
+instance WarnLogMonad (InputT GHCi) where
+  setWarnings = lift . setWarnings
+  getWarnings = lift getWarnings
+
+instance ExceptionMonad GHCi where
+  gcatch m h = GHCi $ \r -> unGHCi m r `gcatch` (\e -> unGHCi (h e) r)
+  gblock (GHCi m)   = GHCi $ \r -> gblock (m r)
+  gunblock (GHCi m) = GHCi $ \r -> gunblock (m r)
+
+instance WarnLogMonad GHCi where
+  setWarnings warns = liftGhc $ setWarnings warns
+  getWarnings = liftGhc $ getWarnings
+
+instance MonadIO GHCi where
+  liftIO = io
+
+instance Haskeline.MonadException GHCi where
+  catch = gcatch
+  block = gblock
+  unblock = gunblock
+
+instance ExceptionMonad (InputT GHCi) where
+    gcatch = Haskeline.catch
+    gblock = Haskeline.block
+    gunblock = Haskeline.unblock
+
+-- for convenience...
+getPrelude :: GHCi Module
+getPrelude = getGHCiState >>= return . prelude
+
+getDynFlags :: GhcMonad m => m DynFlags
+getDynFlags = do
+  GHC.getSessionDynFlags
+
+setDynFlags :: DynFlags -> GHCi [PackageId]
+setDynFlags dflags = do 
+  GHC.setSessionDynFlags dflags
+
+isOptionSet :: GHCiOption -> GHCi Bool
+isOptionSet opt
+ = do st <- getGHCiState
+      return (opt `elem` options st)
+
+setOption :: GHCiOption -> GHCi ()
+setOption opt
+ = do st <- getGHCiState
+      setGHCiState (st{ options = opt : filter (/= opt) (options st) })
+
+unsetOption :: GHCiOption -> GHCi ()
+unsetOption opt
+ = do st <- getGHCiState
+      setGHCiState (st{ options = filter (/= opt) (options st) })
+
+io :: IO a -> GHCi a
+io = MonadUtils.liftIO
+
+printForUser :: SDoc -> GHCi ()
+printForUser doc = do
+  unqual <- GHC.getPrintUnqual
+  io $ Outputable.printForUser stdout unqual doc
+
+printForUser' :: SDoc -> InputT GHCi ()
+printForUser' doc = do
+    unqual <- GHC.getPrintUnqual
+    Haskeline.outputStrLn $ showSDocForUser unqual doc
+
+printForUserPartWay :: SDoc -> GHCi ()
+printForUserPartWay doc = do
+  unqual <- GHC.getPrintUnqual
+  io $ Outputable.printForUserPartWay stdout opt_PprUserLength unqual doc
+
+-- We set log_action to write encoded output.
+-- This fails whenever GHC tries to mention an (already encoded) filename,
+-- but I don't know how to work around that.
+setLogAction :: InputT GHCi ()
+setLogAction = do
+    encoder <- getEncoder
+    dflags <- GHC.getSessionDynFlags
+    GHC.setSessionDynFlags dflags {log_action = logAction encoder}
+    return ()
+  where
+    logAction encoder severity srcSpan style msg = case severity of
+        GHC.SevInfo -> printEncErrs encoder (msg style)
+        GHC.SevFatal -> printEncErrs encoder (msg style)
+        _ -> do
+            hPutChar stderr '\n'
+            printEncErrs encoder (ErrUtils.mkLocMessage srcSpan msg style)
+    printEncErrs encoder doc = do
+        str <- encoder (Pretty.showDocWith Pretty.PageMode doc)
+        B.hPutStrLn stderr str
+        hFlush stderr
+
+runStmt :: String -> GHC.SingleStep -> GHCi GHC.RunResult
+runStmt expr step = do
+  st <- getGHCiState
+  reifyGHCi $ \x ->
+    withProgName (progname st) $
+    withArgs (args st) $
+      reflectGHCi x $ do
+        GHC.handleSourceError (\e -> do GHC.printExceptionAndWarnings e
+                                        return GHC.RunFailed) $ do
+          GHC.runStmt expr step
+
+resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.RunResult
+resume canLogSpan step = GHC.resume canLogSpan step
+
+-- --------------------------------------------------------------------------
+-- timing & statistics
+
+timeIt :: InputT GHCi a -> InputT GHCi a
+timeIt action
+  = do b <- lift $ isOptionSet ShowTiming
+       if not b 
+	  then action 
+	  else do allocs1 <- liftIO $ getAllocations
+		  time1   <- liftIO $ getCPUTime
+		  a <- action
+		  allocs2 <- liftIO $ getAllocations
+		  time2   <- liftIO $ getCPUTime
+		  liftIO $ printTimes (fromIntegral (allocs2 - allocs1)) 
+				  (time2 - time1)
+		  return a
+
+foreign import ccall unsafe "getAllocations" getAllocations :: IO Int64
+	-- defined in ghc/rts/Stats.c
+
+printTimes :: Integer -> Integer -> IO ()
+printTimes allocs psecs
+   = do let secs = (fromIntegral psecs / (10^(12::Integer))) :: Float
+	    secs_str = showFFloat (Just 2) secs
+	putStrLn (showSDoc (
+		 parens (text (secs_str "") <+> text "secs" <> comma <+> 
+			 text (show allocs) <+> text "bytes")))
+
+-----------------------------------------------------------------------------
+-- reverting CAFs
+	
+revertCAFs :: GHCi ()
+revertCAFs = do
+  io $ rts_revertCAFs
+  s <- getGHCiState
+  when (not (ghc_e s)) $ io turnOffBuffering
+	-- Have to turn off buffering again, because we just 
+	-- reverted stdout, stderr & stdin to their defaults.
+
+foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()  
+	-- Make it "safe", just in case
+
+-----------------------------------------------------------------------------
+-- To flush buffers for the *interpreted* computation we need
+-- to refer to *its* stdout/stderr handles
+
+GLOBAL_VAR(stdin_ptr,  error "no stdin_ptr",  Ptr ())
+GLOBAL_VAR(stdout_ptr, error "no stdout_ptr", Ptr ())
+GLOBAL_VAR(stderr_ptr, error "no stderr_ptr", Ptr ())
+
+-- After various attempts, I believe this is the least bad way to do
+-- what we want.  We know look up the address of the static stdin,
+-- stdout, and stderr closures in the loaded base package, and each
+-- time we need to refer to them we cast the pointer to a Handle.
+-- This avoids any problems with the CAF having been reverted, because
+-- we'll always get the current value.
+--
+-- The previous attempt that didn't work was to compile an expression
+-- like "hSetBuffering stdout NoBuffering" into an expression of type
+-- IO () and run this expression each time we needed it, but the
+-- problem is that evaluating the expression might cache the contents
+-- of the Handle rather than referring to it from its static address
+-- each time.  There's no safe workaround for this.
+
+initInterpBuffering :: Ghc ()
+initInterpBuffering = do -- make sure these are linked
+    dflags <- GHC.getSessionDynFlags
+    liftIO $ do
+      initDynLinker dflags
+
+        -- ToDo: we should really look up these names properly, but
+        -- it's a fiddle and not all the bits are exposed via the GHC
+        -- interface.
+      mb_stdin_ptr  <- ObjLink.lookupSymbol "base_GHCziHandle_stdin_closure"
+      mb_stdout_ptr <- ObjLink.lookupSymbol "base_GHCziHandle_stdout_closure"
+      mb_stderr_ptr <- ObjLink.lookupSymbol "base_GHCziHandle_stderr_closure"
+
+      let f ref (Just ptr) = writeIORef ref ptr
+          f _   Nothing    = panic "interactiveUI:setBuffering2"
+      zipWithM f [stdin_ptr,stdout_ptr,stderr_ptr]
+                 [mb_stdin_ptr,mb_stdout_ptr,mb_stderr_ptr]
+      return ()
+
+flushInterpBuffers :: GHCi ()
+flushInterpBuffers
+ = io $ do getHandle stdout_ptr >>= hFlush
+           getHandle stderr_ptr >>= hFlush
+
+turnOffBuffering :: IO ()
+turnOffBuffering
+ = do hdls <- mapM getHandle [stdin_ptr,stdout_ptr,stderr_ptr]
+      mapM_ (\h -> hSetBuffering h NoBuffering) hdls
+
+getHandle :: IORef (Ptr ()) -> IO Handle
+getHandle ref = do
+  (Ptr addr) <- readIORef ref
+  case addrToHValue# addr of (# hval #) -> return (unsafeCoerce# hval)
diff --git a/ghc/GhciTags.hs b/ghc/GhciTags.hs
new file mode 100644
index 0000000000..b53a56f967
--- /dev/null
+++ b/ghc/GhciTags.hs
@@ -0,0 +1,140 @@
+-----------------------------------------------------------------------------
+--
+-- GHCi's :ctags and :etags commands
+--
+-- (c) The GHC Team 2005-2007
+--
+-----------------------------------------------------------------------------
+
+module GhciTags (createCTagsFileCmd, createETagsFileCmd) where
+
+import GHC
+import GhciMonad
+import Outputable
+import Util
+
+-- ToDo: figure out whether we need these, and put something appropriate
+-- into the GHC API instead
+import Name (nameOccName)
+import OccName (pprOccName)
+import MonadUtils
+
+import Data.Maybe
+import Panic
+import Data.List
+import Control.Monad
+import System.IO
+import System.IO.Error as IO
+
+-----------------------------------------------------------------------------
+-- create tags file for currently loaded modules.
+
+createETagsFileCmd, createCTagsFileCmd :: String -> GHCi ()
+
+createCTagsFileCmd ""   = ghciCreateTagsFile CTags "tags"
+createCTagsFileCmd file = ghciCreateTagsFile CTags file
+
+createETagsFileCmd ""    = ghciCreateTagsFile ETags "TAGS"
+createETagsFileCmd file  = ghciCreateTagsFile ETags file
+
+data TagsKind = ETags | CTags
+
+ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
+ghciCreateTagsFile kind file = do
+  createTagsFile kind file
+
+-- ToDo: 
+-- 	- remove restriction that all modules must be interpreted
+--	  (problem: we don't know source locations for entities unless
+--	  we compiled the module.
+--
+--	- extract createTagsFile so it can be used from the command-line
+--	  (probably need to fix first problem before this is useful).
+--
+createTagsFile :: TagsKind -> FilePath -> GHCi ()
+createTagsFile tagskind tagFile = do
+  graph <- GHC.getModuleGraph
+  let ms = map GHC.ms_mod graph
+      tagModule m = do 
+        is_interpreted <- GHC.moduleIsInterpreted m
+        -- should we just skip these?
+        when (not is_interpreted) $
+          ghcError (CmdLineError ("module '" 
+                                ++ GHC.moduleNameString (GHC.moduleName m)
+                                ++ "' is not interpreted"))
+        mbModInfo <- GHC.getModuleInfo m
+        unqual <-
+          case mbModInfo of
+             Just minf -> do
+                mb_print_unqual <- GHC.mkPrintUnqualifiedForModule minf
+                return (fromMaybe GHC.alwaysQualify mb_print_unqual)
+             Nothing ->
+                return GHC.alwaysQualify
+        case mbModInfo of 
+          Just modInfo -> return $! listTags unqual modInfo 
+          _            -> return []
+
+  mtags <- mapM tagModule ms
+  either_res <- liftIO $ collateAndWriteTags tagskind tagFile $ concat mtags
+  case either_res of
+    Left e  -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e
+    Right _ -> return ()
+
+listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
+listTags unqual modInfo =
+	   [ tagInfo unqual name loc 
+           | name <- GHC.modInfoExports modInfo
+           , let loc = srcSpanStart (nameSrcSpan name)
+           , isGoodSrcLoc loc
+           ]
+
+type TagInfo = (String -- tag name
+               ,String -- file name
+               ,Int    -- line number
+               ,Int    -- column number
+               )
+
+-- get tag info, for later translation into Vim or Emacs style
+tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo
+tagInfo unqual name loc
+    = ( showSDocForUser unqual $ pprOccName (nameOccName name)
+      , showSDocForUser unqual $ ftext (srcLocFile loc)
+      , srcLocLine loc
+      , srcLocCol loc
+      )
+
+collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
+collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al
+  let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos
+  IO.try (writeFile file tags)
+collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
+  let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2
+      groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
+  tagGroups <- mapM tagFileGroup groups 
+  IO.try (writeFile file $ concat tagGroups)
+  where
+    tagFileGroup [] = ghcError (CmdLineError "empty tag file group??")
+    tagFileGroup group@((_,fileName,_,_):_) = do
+      file <- readFile fileName -- need to get additional info from sources..
+      let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
+          sortedGroup = sortLe byLine group
+          tags = unlines $ perFile sortedGroup 1 0 $ lines file
+      return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
+    perFile (tagInfo@(_tag, _file, lNo, _colNo):tags) count pos lines@(line:lines')
+     | lNo >  count = perFile (tagInfo:tags) (count+1) (pos+length line) lines'
+     | lNo == count = showETag tagInfo line pos : perFile tags count pos lines
+    perFile _ _ _ _ = []
+
+-- simple ctags format, for Vim et al
+showTag :: TagInfo -> String
+showTag (tag, file, lineNo, _colNo)
+    =  tag ++ "\t" ++ file ++ "\t" ++ show lineNo
+
+-- etags format, for Emacs/XEmacs
+showETag :: TagInfo -> String -> Int -> String
+showETag (tag, _file, lineNo, colNo) line charPos
+    =  take colNo line ++ tag
+    ++ "\x7f" ++ tag
+    ++ "\x01" ++ show lineNo
+    ++ "," ++ show charPos
+
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
new file mode 100644
index 0000000000..4aa441eb36
--- /dev/null
+++ b/ghc/InteractiveUI.hs
@@ -0,0 +1,2237 @@
+{-# OPTIONS -fno-cse #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
+{-# OPTIONS -#include "Linker.h" #-}
+-----------------------------------------------------------------------------
+--
+-- GHC Interactive User Interface
+--
+-- (c) The GHC Team 2005-2006
+--
+-----------------------------------------------------------------------------
+
+module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
+
+#include "HsVersions.h"
+
+import qualified GhciMonad
+import GhciMonad hiding (runStmt)
+import GhciTags
+import Debugger
+
+-- The GHC interface
+import qualified GHC hiding (resume, runStmt)
+import GHC              ( LoadHowMuch(..), Target(..),  TargetId(..),
+                          Module, ModuleName, TyThing(..), Phase,
+                          BreakIndex, SrcSpan, Resume, SingleStep,
+                          Ghc, handleSourceError )
+import PprTyThing
+import DynFlags
+
+import Packages
+import PackageConfig
+import UniqFM
+
+import HscTypes ( implicitTyThings, handleFlagWarnings )
+import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
+import Outputable       hiding (printForUser, printForUserPartWay)
+import Module           -- for ModuleEnv
+import Name
+import SrcLoc
+
+-- Other random utilities
+import CmdLineParser
+import Digraph
+import BasicTypes hiding (isTopLevel)
+import Panic      hiding (showException)
+import Config
+import StaticFlags
+import Linker
+import Util
+import NameSet
+import Maybes		( orElse, expectJust )
+import FastString
+import Encoding
+
+#ifndef mingw32_HOST_OS
+import System.Posix hiding (getEnv)
+#else
+import qualified System.Win32
+#endif
+
+import System.Console.Haskeline as Haskeline
+import qualified System.Console.Haskeline.Encoding as Encoding
+import Control.Monad.Trans
+
+--import SystemExts
+
+import Exception hiding (catch, block, unblock)
+import qualified Exception
+
+-- import Control.Concurrent
+
+import System.FilePath
+import qualified Data.ByteString.Char8 as BS
+import Data.List
+import Data.Maybe
+import System.Cmd
+import System.Environment
+import System.Exit	( exitWith, ExitCode(..) )
+import System.Directory
+import System.IO
+import System.IO.Error as IO
+import Data.Char
+import Data.Array
+import Control.Monad as Monad
+import Text.Printf
+import Foreign
+import GHC.Exts		( unsafeCoerce# )
+import GHC.IOBase	( IOErrorType(InvalidArgument) )
+import GHC.TopHandler
+
+import Data.IORef	( IORef, readIORef, writeIORef )
+
+-----------------------------------------------------------------------------
+
+ghciWelcomeMsg :: String
+ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
+                 ": http://www.haskell.org/ghc/  :? for help"
+
+cmdName :: Command -> String
+cmdName (n,_,_) = n
+
+GLOBAL_VAR(macros_ref, [], [Command])
+
+builtin_commands :: [Command]
+builtin_commands = [
+  -- Hugs users are accustomed to :e, so make sure it doesn't overlap
+  ("?",         keepGoing help,                 noCompletion),
+  ("add",       keepGoingPaths addModule,       completeFilename),
+  ("abandon",   keepGoing abandonCmd,           noCompletion),
+  ("break",     keepGoing breakCmd,             completeIdentifier),
+  ("back",      keepGoing backCmd,              noCompletion),
+  ("browse",    keepGoing' (browseCmd False),   completeModule),
+  ("browse!",   keepGoing' (browseCmd True),    completeModule),
+  ("cd",        keepGoing' changeDirectory,     completeFilename),
+  ("check",     keepGoing' checkModule,         completeHomeModule),
+  ("continue",  keepGoing continueCmd,          noCompletion),
+  ("cmd",       keepGoing cmdCmd,               completeExpression),
+  ("ctags",     keepGoing createCTagsFileCmd,   completeFilename),
+  ("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),
+  ("forward",   keepGoing forwardCmd,           noCompletion),
+  ("help",      keepGoing help,                 noCompletion),
+  ("history",   keepGoing historyCmd,           noCompletion),
+  ("info",      keepGoing' info,                completeIdentifier),
+  ("kind",      keepGoing' kindOfType,          completeIdentifier),
+  ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
+  ("list",      keepGoing' listCmd,             noCompletion),
+  ("module",    keepGoing setContext,           completeModule),
+  ("main",      keepGoing runMain,              completeFilename),
+  ("print",     keepGoing printCmd,             completeExpression),
+  ("quit",      quit,                           noCompletion),
+  ("reload",    keepGoing' reloadModule,        noCompletion),
+  ("run",       keepGoing runRun,               completeFilename),
+  ("set",       keepGoing setCmd,               completeSetOptions),
+  ("show",      keepGoing showCmd,              completeShowOptions),
+  ("sprint",    keepGoing sprintCmd,            completeExpression),
+  ("step",      keepGoing stepCmd,              completeIdentifier),
+  ("steplocal", keepGoing stepLocalCmd,         completeIdentifier),
+  ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
+  ("type",      keepGoing' typeOfExpr,          completeExpression),
+  ("trace",     keepGoing traceCmd,             completeExpression),
+  ("undef",     keepGoing undefineMacro,        completeMacro),
+  ("unset",     keepGoing unsetOptions,         completeSetOptions)
+  ]
+
+
+-- We initialize readline (in the interactiveUI function) to use 
+-- word_break_chars as the default set of completion word break characters.
+-- This can be overridden for a particular command (for example, filename
+-- expansion shouldn't consider '/' to be a word break) by setting the third
+-- entry in the Command tuple above.
+-- 
+-- NOTE: in order for us to override the default correctly, any custom entry
+-- must be a SUBSET of word_break_chars.
+word_break_chars :: String
+word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~"
+                       specials = "(),;[]`{}"
+                       spaces = " \t\n"
+                   in spaces ++ specials ++ symbols
+
+flagWordBreakChars :: String
+flagWordBreakChars = " \t\n"
+
+
+keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi Bool)
+keepGoing a str = keepGoing' (lift . a) str
+
+keepGoing' :: Monad m => (String -> m ()) -> String -> m Bool
+keepGoing' a str = a str >> return False
+
+keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi Bool)
+keepGoingPaths a str
+ = do case toArgs str of
+          Left err -> Encoding.encode err >>= liftIO . BS.hPutStrLn stderr
+          Right args -> a args
+      return False
+
+shortHelpText :: String
+shortHelpText = "use :? for help.\n"
+
+helpText :: String
+helpText =
+ " Commands available from the prompt:\n" ++
+ "\n" ++
+ "   <statement>                 evaluate/run <statement>\n" ++
+ "   :                           repeat last command\n" ++
+ "   :{\\n ..lines.. \\n:}\\n       multiline command\n" ++
+ "   :add [*]<module> ...        add module(s) to the current target set\n" ++
+ "   :browse[!] [[*]<mod>]       display the names defined by module <mod>\n" ++
+ "                               (!: more details; *: all top-level names)\n" ++
+ "   :cd <dir>                   change directory to <dir>\n" ++
+ "   :cmd <expr>                 run the commands returned by <expr>::IO String\n" ++
+ "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
+ "   :def <cmd> <expr>           define a command :<cmd>\n" ++
+ "   :edit <file>                edit file\n" ++
+ "   :edit                       edit last module\n" ++
+ "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
+ "   :help, :?                   display this list of commands\n" ++
+ "   :info [<name> ...]          display information about the given names\n" ++
+ "   :kind <type>                show the kind of <type>\n" ++
+ "   :load [*]<module> ...       load module(s) and their dependents\n" ++
+ "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
+ "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
+ "   :quit                       exit GHCi\n" ++
+ "   :reload                     reload the current module set\n" ++
+ "   :run function [<arguments> ...] run the function with the given arguments\n" ++
+ "   :type <expr>                show the type of <expr>\n" ++
+ "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
+ "   :!<command>                 run the shell command <command>\n" ++
+ "\n" ++
+ " -- Commands for debugging:\n" ++
+ "\n" ++
+ "   :abandon                    at a breakpoint, abandon current computation\n" ++
+ "   :back                       go back in the history (after :trace)\n" ++
+ "   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" ++
+ "   :break <name>               set a breakpoint on the specified function\n" ++
+ "   :continue                   resume after a breakpoint\n" ++
+ "   :delete <number>            delete the specified breakpoint\n" ++
+ "   :delete *                   delete all breakpoints\n" ++
+ "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
+ "   :forward                    go forward in the history (after :back)\n" ++
+ "   :history [<n>]              after :trace, show the execution history\n" ++
+ "   :list                       show the source code around current breakpoint\n" ++
+ "   :list identifier            show the source code for <identifier>\n" ++
+ "   :list [<module>] <line>     show the source code around line number <line>\n" ++
+ "   :print [<name> ...]         prints a value without forcing its computation\n" ++
+ "   :sprint [<name> ...]        simplifed version of :print\n" ++
+ "   :step                       single-step after stopping at a breakpoint\n"++
+ "   :step <expr>                single-step into <expr>\n"++
+ "   :steplocal                  single-step within the current top-level binding\n"++
+ "   :stepmodule                 single-step restricted to the current module\n"++
+ "   :trace                      trace after stopping at a breakpoint\n"++
+ "   :trace <expr>               evaluate <expr> with tracing on (see :history)\n"++
+
+ "\n" ++
+ " -- Commands for changing settings:\n" ++
+ "\n" ++
+ "   :set <option> ...           set options\n" ++
+ "   :set args <arg> ...         set the arguments returned by System.getArgs\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 [<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" ++
+ "\n" ++
+ "    +r            revert top-level expressions after each evaluation\n" ++
+ "    +s            print timing/memory stats after each evaluation\n" ++
+ "    +t            print type after evaluation\n" ++
+ "    -<flags>      most GHC command line flags can also be set here\n" ++
+ "                         (eg. -v2, -fglasgow-exts, etc.)\n" ++
+ "                    for GHCi-specific flags, see User's Guide,\n"++
+ "                    Flag reference, Interactive-mode options\n" ++
+ "\n" ++
+ " -- Commands for displaying information:\n" ++
+ "\n" ++
+ "   :show bindings              show the current bindings made at the prompt\n" ++
+ "   :show breaks                show the active breakpoints\n" ++
+ "   :show context               show the breakpoint context\n" ++
+ "   :show modules               show the currently loaded modules\n" ++
+ "   :show packages              show the currently active package flags\n" ++
+ "   :show languages             show the currently active language flags\n" ++
+ "   :show <setting>             show value of <setting>, which is one of\n" ++
+ "                                  [args, prog, prompt, editor, stop]\n" ++
+ "\n" 
+
+findEditor :: IO String
+findEditor = do
+  getEnv "EDITOR" 
+    `IO.catch` \_ -> do
+#if mingw32_HOST_OS
+        win <- System.Win32.getWindowsDirectory
+        return (win </> "notepad.exe")
+#else
+        return ""
+#endif
+
+interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String]
+              -> Ghc ()
+interactiveUI srcs maybe_exprs = do
+   -- HACK! If we happen to get into an infinite loop (eg the user
+   -- types 'let x=x in x' at the prompt), then the thread will block
+   -- on a blackhole, and become unreachable during GC.  The GC will
+   -- detect that it is unreachable and send it the NonTermination
+   -- exception.  However, since the thread is unreachable, everything
+   -- 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
+
+    -- Initialise buffering for the *interpreted* I/O system
+   initInterpBuffering
+
+   liftIO $ when (isNothing maybe_exprs) $ do
+        -- Only for GHCi (not runghc and ghc -e):
+
+        -- Turn buffering off for the compiled program's stdout/stderr
+        turnOffBuffering
+        -- Turn buffering off for GHCi's stdout
+        hFlush stdout
+        hSetBuffering stdout 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
+
+   -- initial context is just the Prelude
+   prel_mod <- GHC.lookupModule (GHC.mkModuleName "Prelude") Nothing
+   GHC.setContext [] [prel_mod]
+
+   default_editor <- liftIO $ findEditor
+
+   startGHCi (runGHCi srcs maybe_exprs)
+        GHCiState{ progname = "<interactive>",
+                   args = [],
+                   prompt = "%s> ",
+                   stop = "",
+                   editor = default_editor,
+--                   session = session,
+                   options = [],
+                   prelude = prel_mod,
+                   break_ctr = 0,
+                   breaks = [],
+                   tickarrays = emptyModuleEnv,
+                   last_command = Nothing,
+                   cmdqueue = [],
+                   remembered_ctx = [],
+                   ghc_e = isJust maybe_exprs
+                 }
+
+   return ()
+
+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
+
+runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
+runGHCi paths maybe_exprs = do
+  let 
+   read_dot_files = not opt_IgnoreDotGhci
+
+   current_dir = return (Just ".ghci")
+
+   app_user_dir = io $ withGhcAppData 
+                    (\dir -> return (Just (dir </> "ghci.conf")))
+                    (return Nothing)
+
+   home_dir = do
+    either_dir <- io $ IO.try (getEnv "HOME")
+    case either_dir of
+      Right home -> return (Just (home </> ".ghci"))
+      _ -> return Nothing
+
+   sourceConfigFile :: FilePath -> GHCi ()
+   sourceConfigFile file = do
+     exists <- io $ doesFileExist file
+     when exists $ do
+       dir_ok  <- io $ checkPerms (getDirectory file)
+       file_ok <- io $ checkPerms file
+       when (dir_ok && file_ok) $ do
+         either_hdl <- io $ 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.
+           Right hdl -> runInputTWithPrefs defaultPrefs defaultSettings $ do
+                            setLogAction
+                            runCommands $ fileLoop hdl
+     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)
+        -- nub, because we don't want to read .ghci twice if the
+        -- CWD is $HOME.
+
+  -- Perform a :load for files given on the GHCi command line
+  -- When in -e mode, if the load fails then we want to stop
+  -- immediately rather than going on to evaluate the expression.
+  when (not (null paths)) $ do
+     ok <- ghciHandle (\e -> do showException e; return Failed) $
+                -- TODO: this is a hack.
+                runInputTWithPrefs defaultPrefs defaultSettings $ do
+                    let (filePaths, phases) = unzip paths
+                    filePaths' <- mapM (Encoding.decode . BS.pack) filePaths
+                    loadModule (zip filePaths' phases)
+     when (isJust maybe_exprs && failed ok) $
+        io (exitWith (ExitFailure 1))
+
+  -- if verbosity is greater than 0, or we are connected to a
+  -- terminal, display the prompt in the interactive loop.
+  is_tty <- io (hIsTerminalDevice stdin)
+  dflags <- getDynFlags
+  let show_prompt = verbosity dflags > 0 || is_tty
+
+  case maybe_exprs of
+        Nothing ->
+          do
+            -- enter the interactive loop
+            runGHCiInput $ runCommands $ haskelineLoop show_prompt
+        Just exprs -> do
+            -- just evaluate the expression we were given
+            enqueueCommands exprs
+            let handle e = do st <- getGHCiState
+                                   -- Jump through some hoops to get the
+                                   -- current progname in the exception text:
+                                   -- <progname>: <exception>
+                              io $ withProgName (progname st)
+                                   -- this used to be topHandlerFastExit, see #2228
+                                 $ topHandler e
+            runInputTWithPrefs defaultPrefs defaultSettings $ do
+                setLogAction
+                runCommands' handle (return Nothing)
+
+  -- and finally, exit
+  io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
+
+runGHCiInput :: InputT GHCi a -> GHCi a
+runGHCiInput f = do
+    histFile <- io $ withGhcAppData (\dir -> return (Just (dir </> "ghci_history")))
+                        (return Nothing)
+    let settings = setComplete ghciCompleteWord
+                    $ defaultSettings {historyFile = histFile}
+    runInputT settings $ do
+        setLogAction
+        f
+
+-- TODO really bad name
+haskelineLoop :: Bool -> InputT GHCi (Maybe String)
+haskelineLoop show_prompt = do
+    prompt <- if show_prompt then lift mkPrompt else return ""
+    l <- getInputLine prompt
+    return l
+
+
+-- NOTE: We only read .ghci files if they are owned by the current user,
+-- and aren't world writable.  Otherwise, we could be accidentally 
+-- running code planted by a malicious third party.
+
+-- Furthermore, We only read ./.ghci if . is owned by the current user
+-- and isn't writable by anyone else.  I think this is sufficient: we
+-- don't need to check .. and ../.. etc. because "."  always refers to
+-- the same directory while a process is running.
+
+checkPerms :: String -> IO Bool
+#ifdef mingw32_HOST_OS
+checkPerms _ =
+  return True
+#else
+checkPerms name =
+  handleIO (\_ -> return False) $ do
+     st <- getFileStatus name
+     me <- getRealUserID
+     if fileOwner st /= me then do
+   	putStrLn $ "WARNING: " ++ name ++ " is owned by someone else, IGNORING!"
+   	return False
+      else do
+   	let mode =  fileMode st
+   	if (groupWriteMode == (mode `intersectFileModes` groupWriteMode))
+   	   || (otherWriteMode == (mode `intersectFileModes` otherWriteMode)) 
+   	   then do
+   	       putStrLn $ "*** WARNING: " ++ name ++ 
+   			  " is writable by someone else, IGNORING!"
+   	       return False
+   	  else return True
+#endif
+
+fileLoop :: MonadIO m => Handle -> InputT m (Maybe String)
+fileLoop hdl = do
+   l <- liftIO $ IO.try (BS.hGetLine hdl)
+   case l of
+        Left e | isEOFError e              -> return Nothing
+               | InvalidArgument <- etype  -> return Nothing
+               | otherwise                 -> liftIO $ ioError e
+                where etype = ioeGetErrorType e
+                -- treat InvalidArgument in the same way as EOF:
+                -- this can happen if the user closed stdin, or
+                -- perhaps did getContents which closes stdin at
+                -- EOF.
+        Right l -> fmap Just (Encoding.decode l)
+
+mkPrompt :: GHCi String
+mkPrompt = do
+  (toplevs,exports) <- GHC.getContext
+  resumes <- GHC.getResumeContext
+  -- st <- getGHCiState
+
+  context_bit <-
+        case resumes of
+            [] -> return empty
+            r:_ -> do
+                let ix = GHC.resumeHistoryIx r
+                if ix == 0
+                   then return (brackets (ppr (GHC.resumeSpan r)) <> space)
+                   else do
+                        let hist = GHC.resumeHistory r !! (ix-1)
+                        span <- GHC.getHistorySpan hist
+                        return (brackets (ppr (negate ix) <> char ':' 
+                                          <+> ppr span) <> space)
+  let
+        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) <+>
+             hsep (map (ppr . GHC.moduleName) exports)
+
+        deflt_prompt = dots <> context_bit <> modules_bit
+
+        f ('%':'s':xs) = deflt_prompt <> f xs
+        f ('%':'%':xs) = char '%' <> f xs
+        f (x:xs) = char x <> f xs
+        f [] = empty
+   --
+  st <- getGHCiState
+  return (showSDoc (f (prompt st)))
+
+
+queryQueue :: GHCi (Maybe String)
+queryQueue = do
+  st <- getGHCiState
+  case cmdqueue st of
+    []   -> return Nothing
+    c:cs -> do setGHCiState st{ cmdqueue = cs }
+               return (Just c)
+
+runCommands :: InputT GHCi (Maybe String) -> InputT GHCi ()
+runCommands = runCommands' handler
+
+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)
+            (runOneCommand eh getCmd)
+    if b then return () else runCommands' eh getCmd
+
+runOneCommand :: (SomeException -> GHCi Bool) -> InputT GHCi (Maybe String)
+            -> InputT GHCi Bool
+runOneCommand eh getCmd = do
+  mb_cmd <- noSpace (lift queryQueue)
+  mb_cmd <- maybe (noSpace getCmd) (return . Just) mb_cmd
+  case mb_cmd of
+    Nothing -> return True
+    Just c  -> ghciHandle (lift . eh) $
+             handleSourceError printErrorAndKeepGoing
+               (doCommand c)
+  where
+    printErrorAndKeepGoing err = do
+        GHC.printExceptionAndWarnings err
+        return False
+
+    noSpace q = q >>= maybe (return Nothing)
+                            (\c->case removeSpaces c of 
+                                   ""   -> noSpace q
+                                   ":{" -> multiLineCmd q
+                                   c    -> return (Just c) )
+    multiLineCmd q = do
+      st <- lift getGHCiState
+      let p = prompt st
+      lift $ setGHCiState st{ prompt = "%s| " }
+      mb_cmd <- collectCommand q ""
+      lift $ getGHCiState >>= \st->setGHCiState st{ prompt = p }
+      return mb_cmd
+    -- we can't use removeSpaces for the sublines here, so 
+    -- multiline commands are somewhat more brittle against
+    -- fileformat errors (such as \r in dos input on unix), 
+    -- we get rid of any extra spaces for the ":}" test; 
+    -- we also avoid silent failure if ":}" is not found;
+    -- and since there is no (?) valid occurrence of \r (as 
+    -- opposed to its String representation, "\r") inside a
+    -- ghci command, we replace any such with ' ' (argh:-(
+    collectCommand q c = q >>= 
+      maybe (liftIO (ioError collectError))
+            (\l->if removeSpaces l == ":}" 
+                 then return (Just $ removeSpaces c) 
+                 else collectCommand q (c++map normSpace l))
+      where normSpace '\r' = ' '
+            normSpace   c  = c
+    -- QUESTION: is userError the one to use here?
+    collectError = userError "unterminated multiline command :{ .. :}"
+    doCommand (':' : cmd) = specialCommand cmd
+    doCommand stmt        = do timeIt $ lift $ runStmt stmt GHC.RunToCompletion
+                               return False
+
+enqueueCommands :: [String] -> GHCi ()
+enqueueCommands cmds = do
+  st <- getGHCiState
+  setGHCiState st{ cmdqueue = cmds ++ cmdqueue st }
+
+
+runStmt :: String -> SingleStep -> GHCi Bool
+runStmt stmt step
+ | null (filter (not.isSpace) stmt) = return False
+ | ["import", mod] <- words stmt    = keepGoing' setContext ('+':mod)
+ | otherwise
+ = do result <- GhciMonad.runStmt stmt step
+      afterRunStmt (const True) result
+
+--afterRunStmt :: GHC.RunResult -> GHCi Bool
+                                 -- False <=> the statement failed to compile
+afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
+afterRunStmt _ (GHC.RunException e) = throw e
+afterRunStmt step_here run_result = do
+  resumes <- GHC.getResumeContext
+  case run_result of
+     GHC.RunOk names -> do
+        show_types <- isOptionSet ShowType
+        when show_types $ printTypeOfNames names
+     GHC.RunBreak _ names mb_info
+         | isNothing  mb_info ||
+           step_here (GHC.resumeSpan $ head resumes) -> do
+               mb_id_loc <- toBreakIdAndLocation mb_info
+               let breakCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
+               if (null breakCmd)
+                 then printStoppedAtBreakInfo (head resumes) names
+                 else enqueueCommands [breakCmd]
+               -- run the command set with ":set stop <cmd>"
+               st <- getGHCiState
+               enqueueCommands [stop st]
+               return ()
+         | otherwise -> resume step_here GHC.SingleStep >>=
+                        afterRunStmt step_here >> return ()
+     _ -> return ()
+
+  flushInterpBuffers
+  io installSignalHandlers
+  b <- isOptionSet RevertCAFs
+  when b revertCAFs
+
+  return (case run_result of GHC.RunOk _ -> True; _ -> False)
+
+toBreakIdAndLocation ::
+  Maybe GHC.BreakInfo -> GHCi (Maybe (Int, BreakLocation))
+toBreakIdAndLocation Nothing = return Nothing
+toBreakIdAndLocation (Just info) = do
+  let mod = GHC.breakInfo_module info
+      nm  = GHC.breakInfo_number info
+  st <- getGHCiState
+  return $ listToMaybe [ id_loc | id_loc@(_,loc) <- breaks st,
+                                  breakModule loc == mod,
+                                  breakTick loc == nm ]
+
+printStoppedAtBreakInfo :: Resume -> [Name] -> GHCi ()
+printStoppedAtBreakInfo resume names = do
+  printForUser $ ptext (sLit "Stopped at") <+>
+    ppr (GHC.resumeSpan resume)
+  --  printTypeOfNames session names
+  let namesSorted = sortBy compareNames names
+  tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
+  docs <- pprTypeAndContents [id | AnId id <- tythings]
+  printForUserPartWay docs
+
+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)
+
+printTypeOfName :: Name -> GHCi ()
+printTypeOfName n
+   = do maybe_tything <- GHC.lookupName n
+        case maybe_tything of
+            Nothing    -> return ()
+            Just thing -> printTyThing thing
+
+
+data MaybeCommand = GotCommand Command | BadCommand | NoLastCommand
+
+specialCommand :: String -> InputT GHCi Bool
+specialCommand ('!':str) = lift $ shellEscape (dropWhile isSpace str)
+specialCommand str = do
+  let (cmd,rest) = break isSpace str
+  maybe_cmd <- lift $ lookupCommand cmd
+  case maybe_cmd of
+    GotCommand (_,f,_) -> f (dropWhile isSpace rest)
+    BadCommand ->
+      do liftIO $ hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
+                           ++ shortHelpText)
+         return False
+    NoLastCommand ->
+      do liftIO $ hPutStr stdout ("there is no last command to perform\n"
+                           ++ shortHelpText)
+         return False
+
+lookupCommand :: String -> GHCi (MaybeCommand)
+lookupCommand "" = do
+  st <- getGHCiState
+  case last_command st of
+      Just c -> return $ GotCommand c
+      Nothing -> return NoLastCommand
+lookupCommand str = do
+  mc <- io $ lookupCommand' str
+  st <- getGHCiState
+  setGHCiState st{ last_command = mc }
+  return $ case mc of
+           Just c -> GotCommand c
+           Nothing -> BadCommand
+
+lookupCommand' :: String -> IO (Maybe Command)
+lookupCommand' str = do
+  macros <- readIORef macros_ref
+  let cmds = builtin_commands ++ macros
+  -- look for exact match first, then the first prefix match
+  return $ case [ c | c <- cmds, str == cmdName c ] of
+           c:_ -> Just c
+           [] -> case [ c | c@(s,_,_) <- cmds, str `isPrefixOf` s ] of
+                 [] -> Nothing
+                 c:_ -> Just c
+
+getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
+getCurrentBreakSpan = do
+  resumes <- GHC.getResumeContext
+  case resumes of
+    [] -> return Nothing
+    (r:_) -> do
+        let ix = GHC.resumeHistoryIx r
+        if ix == 0
+           then return (Just (GHC.resumeSpan r))
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                span <- GHC.getHistorySpan hist
+                return (Just span)
+
+getCurrentBreakModule :: GHCi (Maybe Module)
+getCurrentBreakModule = do
+  resumes <- GHC.getResumeContext
+  case resumes of
+    [] -> return Nothing
+    (r:_) -> do
+        let ix = GHC.resumeHistoryIx r
+        if ix == 0
+           then return (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                return $ Just $ GHC.getHistoryModule  hist
+
+-----------------------------------------------------------------------------
+-- Commands
+
+noArgs :: GHCi () -> String -> GHCi ()
+noArgs m "" = m
+noArgs _ _  = io $ putStrLn "This command takes no arguments"
+
+help :: String -> GHCi ()
+help _ = io (putStr helpText)
+
+info :: String -> InputT GHCi ()
+info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
+info s  = handleSourceError GHC.printExceptionAndWarnings $ do
+             { let names = words s
+	     ; dflags <- getDynFlags
+	     ; let pefas = dopt Opt_PrintExplicitForalls dflags
+	     ; mapM_ (infoThing pefas) names }
+  where
+    infoThing pefas str = do
+	names     <- GHC.parseName str
+	mb_stuffs <- mapM GHC.getInfo names
+	let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
+	unqual <- GHC.getPrintUnqual
+	outputStrLn $ 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
+  -- constructor in the same type
+filterOutChildren :: (a -> TyThing) -> [a] -> [a]
+filterOutChildren get_thing xs 
+  = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
+  where
+    implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
+
+pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
+pprInfo pefas (thing, fixity, insts)
+  =  pprTyThingInContextLoc pefas thing
+  $$ show_fixity fixity
+  $$ vcat (map GHC.pprInstance insts)
+  where
+    show_fixity fix 
+	| fix == GHC.defaultFixity = empty
+	| otherwise		   = ppr fix <+> ppr (GHC.getName thing)
+
+runMain :: String -> GHCi ()
+runMain s = case toArgs s of
+            Left err   -> io (hPutStrLn stderr err)
+            Right args ->
+                do dflags <- getDynFlags
+                   case mainFunIs dflags of
+                       Nothing -> doWithArgs args "main"
+                       Just f  -> doWithArgs args f
+
+runRun :: String -> GHCi ()
+runRun s = case toCmdArgs s of
+           Left err          -> io (hPutStrLn stderr err)
+           Right (cmd, args) -> doWithArgs args cmd
+
+doWithArgs :: [String] -> String -> GHCi ()
+doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++
+                                       show args ++ " (" ++ cmd ++ ")"]
+
+addModule :: [FilePath] -> InputT GHCi ()
+addModule files = do
+  lift revertCAFs -- always revert CAFs on load/add.
+  files <- mapM expandPath files
+  targets <- mapM (\m -> GHC.guessTarget m Nothing) files
+  -- remove old targets with the same id; e.g. for :add *M
+  mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets ]
+  mapM_ GHC.addTarget targets
+  prev_context <- GHC.getContext
+  ok <- trySuccess $ GHC.load LoadAllTargets
+  afterLoad ok False prev_context
+
+changeDirectory :: String -> InputT GHCi ()
+changeDirectory "" = do
+  -- :cd on its own changes to the user's home directory
+  either_dir <- liftIO $ IO.try getHomeDirectory
+  case either_dir of
+     Left _e -> return ()
+     Right dir -> changeDirectory dir
+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"
+  prev_context <- GHC.getContext
+  GHC.setTargets []
+  GHC.load LoadAllTargets
+  lift $ setContextAfterLoad prev_context False []
+  GHC.workingDirectoryChanged
+  dir <- expandPath dir
+  liftIO $ setCurrentDirectory dir
+
+trySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag
+trySuccess act =
+    handleSourceError (\e -> do GHC.printExceptionAndWarnings e
+                                return Failed) $ do
+      act
+
+editFile :: String -> GHCi ()
+editFile str =
+  do file <- if null str then chooseEditFile else return str
+     st <- getGHCiState
+     let cmd = editor st
+     when (null cmd) 
+       $ ghcError (CmdLineError "editor not set, use :set editor")
+     io $ system (cmd ++ ' ':file)
+     return ()
+
+-- The user didn't specify a file so we pick one for them.
+-- Our strategy is to pick the first module that failed to load,
+-- or otherwise the first target.
+--
+-- XXX: Can we figure out what happened if the depndecy analysis fails
+--      (e.g., because the porgrammeer mistyped the name of a module)?
+-- XXX: Can we figure out the location of an error to pass to the editor?
+-- XXX: if we could figure out the list of errors that occured during the
+-- last load/reaload, then we could start the editor focused on the first
+-- of those.
+chooseEditFile :: GHCi String
+chooseEditFile =
+  do let hasFailed x = fmap not $ GHC.isLoaded $ GHC.ms_mod_name x
+
+     graph <- GHC.getModuleGraph
+     failed_graph <- filterM hasFailed graph
+     let order g  = flattenSCCs $ GHC.topSortModuleGraph True g Nothing
+         pick xs  = case xs of
+                      x : _ -> GHC.ml_hs_file (GHC.ms_location x)
+                      _     -> Nothing
+
+     case pick (order failed_graph) of
+       Just file -> return file
+       Nothing   -> 
+         do targets <- GHC.getTargets
+            case msum (map fromTarget targets) of
+              Just file -> return file
+              Nothing   -> ghcError (CmdLineError "No files to edit.")
+          
+  where fromTarget (GHC.Target (GHC.TargetFile f _) _ _) = Just f
+        fromTarget _ = Nothing -- when would we get a module target?
+
+defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
+defineMacro overwrite s = do
+  let (macro_name, definition) = break isSpace s
+  macros <- io (readIORef macros_ref)
+  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)
+	else do
+  if (not overwrite && macro_name `elem` defined)
+	then ghcError (CmdLineError 
+		("macro '" ++ macro_name ++ "' is already defined"))
+	else do
+
+  let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
+
+  -- give the expression a type signature, so we can be sure we're getting
+  -- something of the right type.
+  let new_expr = '(' : definition ++ ") :: String -> IO String"
+
+  -- compile the expression
+  handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+    hv <- GHC.compileExpr new_expr
+    io (writeIORef macros_ref --
+	(filtered ++ [(macro_name, lift . runMacro hv, noCompletion)]))
+
+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
+
+undefineMacro :: String -> GHCi ()
+undefineMacro str = mapM_ undef (words str) 
+ where undef macro_name = do
+        cmds <- io (readIORef macros_ref)
+        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))
+
+cmdCmd :: String -> GHCi ()
+cmdCmd str = do
+  let expr = '(' : str ++ ") :: IO String"
+  handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+    hv <- GHC.compileExpr expr
+    cmds <- io $ (unsafeCoerce# hv :: IO String)
+    enqueueCommands (lines cmds)
+    return ()
+
+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' :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
+loadModule' files = do
+  prev_context <- GHC.getContext
+
+  -- unload first
+  GHC.abandonAll
+  lift discardActiveBreakPoints
+  GHC.setTargets []
+  GHC.load LoadAllTargets
+
+  let (filenames, phases) = unzip files
+  exp_filenames <- mapM expandPath filenames
+  let files' = zip exp_filenames phases
+  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.
+
+  GHC.setTargets targets
+  doLoad False prev_context LoadAllTargets
+
+checkModule :: String -> InputT GHCi ()
+checkModule m = do
+  let modl = GHC.mkModuleName m
+  prev_context <- GHC.getContext
+  ok <- handleSourceError (\e -> GHC.printExceptionAndWarnings e >> return False) $ do
+          r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
+          outputStrLn (showSDoc (
+	   case GHC.moduleInfo r of
+	     cm | Just scope <- GHC.modInfoTopLevelScope cm ->
+		let
+		    (local,global) = ASSERT( all isExternalName scope )
+		    		     partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
+		in
+			(text "global names: " <+> ppr global) $$
+		        (text "local  names: " <+> ppr local)
+	     _ -> empty))
+          return True
+  afterLoad (successIf ok) False prev_context
+
+reloadModule :: String -> InputT GHCi ()
+reloadModule m = do
+  prev_context <- GHC.getContext
+  doLoad True prev_context $
+        if null m then LoadAllTargets 
+                  else LoadUpTo (GHC.mkModuleName m)
+  return ()
+
+doLoad :: Bool -> ([Module],[Module]) -> 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.
+  lift discardActiveBreakPoints
+  ok <- trySuccess $ GHC.load howmuch
+  afterLoad ok retain_context prev_context
+  return ok
+
+afterLoad :: SuccessFlag -> Bool -> ([Module],[Module]) -> InputT GHCi ()
+afterLoad ok retain_context prev_context = do
+  lift revertCAFs  -- always revert CAFs on load.
+  lift discardTickArrays
+  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
+
+  lift $ setContextAfterLoad prev_context retain_context loaded_mod_summaries
+
+
+setContextAfterLoad :: ([Module],[Module]) -> Bool -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad prev keep_ctxt [] = do
+  prel_mod <- getPrelude
+  setContextKeepingPackageModules prev keep_ctxt ([], [prel_mod])
+setContextAfterLoad prev keep_ctxt ms = do
+  -- load a target if one is available, otherwise load the topmost module.
+  targets <- GHC.getTargets
+  case [ m | Just m <- map (findTarget ms) targets ] of
+	[]    -> 
+	  let graph' = flattenSCCs (GHC.topSortModuleGraph True ms Nothing) in
+	  load_this (last graph')	  
+	(m:_) -> 
+	  load_this m
+ where
+   findTarget ms t
+    = case filter (`matches` t) ms of
+	[]    -> Nothing
+	(m:_) -> Just m
+
+   summary `matches` Target (TargetModule m) _ _
+	= GHC.ms_mod_name summary == m
+   summary `matches` Target (TargetFile f _) _ _ 
+	| Just f' <- GHC.ml_hs_file (GHC.ms_location summary)	= f == f'
+   _ `matches` _
+	= False
+
+   load_this summary | m <- GHC.ms_mod summary = do
+	b <- GHC.moduleIsInterpreted m
+	if b then setContextKeepingPackageModules prev keep_ctxt ([m], [])
+       	     else do
+                prel_mod <- getPrelude
+                setContextKeepingPackageModules prev keep_ctxt ([],[prel_mod,m])
+
+-- | Keep any package modules (except Prelude) when changing the context.
+setContextKeepingPackageModules
+        :: ([Module],[Module])          -- previous context
+        -> Bool                         -- re-execute :module commands
+        -> ([Module],[Module])          -- new context
+        -> 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))
+  if keep_ctxt
+     then do
+          st <- getGHCiState
+          mapM_ (playCtxtCmd False) (remembered_ctx st)
+     else do
+          st <- getGHCiState
+          setGHCiState st{ remembered_ctx = [] }
+
+isHomeModule :: Module -> Bool
+isHomeModule mod = GHC.modulePackageId mod == mainPackageId
+
+modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> InputT GHCi ()
+modulesLoadedMsg ok mods = do
+  dflags <- getDynFlags
+  when (verbosity dflags > 0) $ do
+   let mod_commas 
+	| null mods = text "none."
+	| otherwise = hsep (
+	    punctuate comma (map ppr mods)) <> text "."
+   case ok of
+    Failed ->
+       outputStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas))
+    Succeeded  ->
+       outputStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas))
+
+
+typeOfExpr :: String -> InputT GHCi ()
+typeOfExpr str 
+  = 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 -> InputT GHCi ()
+kindOfType str 
+  = handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
+       ty <- GHC.typeKind str
+       printForUser' $ text str <+> dcolon <+> ppr ty
+
+quit :: String -> InputT GHCi Bool
+quit _ = return True
+
+shellEscape :: String -> GHCi Bool
+shellEscape str = io (system str >> return False)
+
+-----------------------------------------------------------------------------
+-- Browsing a module's contents
+
+browseCmd :: Bool -> String -> InputT GHCi ()
+browseCmd bang m = 
+  case words m of
+    ['*':s] | looksLikeModuleName s -> do 
+        m <- lift $ wantInterpretedModule s
+        browseModule bang m False
+    [s] | looksLikeModuleName s -> do
+        m <- lift $ lookupModule s
+        browseModule bang m True
+    [] -> do
+        (as,bs) <- GHC.getContext
+                -- Guess which module the user wants to browse.  Pick
+                -- modules that are interpreted first.  The most
+                -- recently-added module occurs last, it seems.
+        case (as,bs) of
+          (as@(_:_), _)   -> browseModule bang (last as) True
+          ([],  bs@(_:_)) -> browseModule bang (last bs) True
+          ([],  [])  -> ghcError (CmdLineError ":browse: no current module")
+    _ -> ghcError (CmdLineError "syntax:  :browse <module>")
+
+-- without bang, show items in context of their parents and omit children
+-- with bang, show class methods and data constructors separately, and
+--            indicate import modules, to aid qualifying unqualified names
+-- with sorted, sort items alphabetically
+browseModule :: Bool -> Module -> Bool -> InputT GHCi ()
+browseModule bang modl exports_only = do
+  -- :browse! reports qualifiers wrt current context
+  current_unqual <- GHC.getPrintUnqual
+  -- Temporarily set the context to the module we're interested in,
+  -- 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]
+                  else GHC.setContext [modl] []
+  target_unqual <- GHC.getPrintUnqual
+  GHC.setContext as bs
+
+  let unqual = if bang then current_unqual else target_unqual
+
+  mb_mod_info <- GHC.getModuleInfo modl
+  case mb_mod_info of
+    Nothing -> ghcError (CmdLineError ("unknown module: " ++
+                                GHC.moduleNameString (GHC.moduleName modl)))
+    Just mod_info -> do
+        dflags <- getDynFlags
+        let names
+               | exports_only = GHC.modInfoExports mod_info
+               | otherwise    = GHC.modInfoTopLevelScope mod_info
+                                `orElse` []
+
+                -- sort alphabetically name, but putting
+                -- locally-defined identifiers first.
+                -- We would like to improve this; see #1799.
+            sorted_names = loc_sort local ++ occ_sort external
+                where 
+                (local,external) = 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.
+                loc_sort names
+                      | n:_ <- names, isGoodSrcSpan (nameSrcSpan n)
+                      = sortBy (compare `on` nameSrcSpan) names
+                      | otherwise
+                      = occ_sort names
+
+        mb_things <- mapM GHC.lookupName sorted_names
+        let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things)
+
+        rdr_env <- GHC.getGRE
+
+        let pefas              = dopt Opt_PrintExplicitForalls dflags
+            things | bang      = catMaybes mb_things
+                   | otherwise = filtered_things
+            pretty | bang      = pprTyThing
+                   | otherwise = pprTyThingInContext
+
+            labels  [] = text "-- not currently imported"
+            labels  l  = text $ intercalate "\n" $ map qualifier l
+            qualifier  = maybe "-- defined locally" 
+                             (("-- imported via "++) . intercalate ", " 
+                               . map GHC.moduleNameString)
+            importInfo = RdrName.getGRE_NameQualifier_maybes rdr_env
+            modNames   = map (importInfo . GHC.getName) things
+                                        
+            -- annotate groups of imports with their import modules
+            -- the default ordering is somewhat arbitrary, so we group 
+            -- by header and sort groups; the names themselves should
+            -- really come in order of source appearance.. (trac #1799)
+            annotate mts = concatMap (\(m,ts)->labels m:ts)
+                         $ sortBy cmpQualifiers $ group mts
+              where cmpQualifiers = 
+                      compare `on` (map (fmap (map moduleNameFS)) . fst)
+            group []            = []
+            group mts@((m,_):_) = (m,map snd g) : group ng
+              where (g,ng) = partition ((==m).fst) mts
+
+        let prettyThings = map (pretty pefas) things
+            prettyThings' | bang      = annotate $ zip modNames prettyThings
+                          | otherwise = prettyThings
+        outputStrLn $ showSDocForUser unqual (vcat prettyThings')
+        -- ToDo: modInfoInstances currently throws an exception for
+        -- package modules.  When it works, we can do this:
+        --        $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
+
+-----------------------------------------------------------------------------
+-- Setting the module context
+
+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)] }
+  | otherwise = ghcError (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
+  where
+    (cmd, strs, as, bs) =
+        case str of 
+                '+':stuff -> rest AddModules stuff
+                '-':stuff -> rest RemModules stuff
+                stuff     -> rest SetContext stuff
+
+    rest cmd stuff = (cmd, strs, as, bs)
+       where strs = words stuff
+             (as,bs) = partitionWith starred strs
+
+    sensible ('*':m) = looksLikeModuleName m
+    sensible m       = looksLikeModuleName m
+
+    starred ('*':m) = Left m
+    starred m       = Right m
+
+playCtxtCmd :: Bool -> (CtxtCmd, [String], [String]) -> GHCi ()
+playCtxtCmd fail (cmd, as, bs)
+  = do
+    (as',bs') <- do_checks fail
+    (prev_as,prev_bs) <- GHC.getContext
+    (new_as, new_bs) <-
+      case cmd of
+        SetContext -> do
+          prel_mod <- getPrelude
+          let bs'' = if null as && prel_mod `notElem` bs' then prel_mod:bs'
+                                                          else bs'
+          return (as',bs'')
+        AddModules -> do
+          let as_to_add = as' \\ (prev_as ++ prev_bs)
+              bs_to_add = bs' \\ (prev_as ++ prev_bs)
+          return (prev_as ++ as_to_add, prev_bs ++ bs_to_add)
+        RemModules -> do
+          let new_as = prev_as \\ (as' ++ bs')
+              new_bs = prev_bs \\ (as' ++ bs')
+          return (new_as, new_bs)
+    GHC.setContext new_as new_bs
+  where
+    do_checks True = do
+      as' <- mapM wantInterpretedModule as
+      bs' <- mapM lookupModule bs
+      return (as',bs')
+    do_checks False = do
+      as' <- mapM (trymaybe . wantInterpretedModule) as
+      bs' <- mapM (trymaybe . lookupModule) bs
+      return (catMaybes as', catMaybes bs')
+
+    trymaybe m = do
+        r <- ghciTry m
+        case r of
+          Left _  -> return Nothing
+          Right a -> return (Just a)
+
+----------------------------------------------------------------------------
+-- Code for `:set'
+
+-- set options in the interpreter.  Syntax is exactly the same as the
+-- ghc command line, except that certain options aren't available (-C,
+-- -E etc.)
+--
+-- This is pretty fragile: most options won't work as expected.  ToDo:
+-- figure out which ones & disallow them.
+
+setCmd :: String -> GHCi ()
+setCmd ""
+  = do st <- getGHCiState
+       let opts = options st
+       io $ putStrLn (showSDoc (
+   	      text "options currently set: " <> 
+   	      if null opts
+   		   then text "none."
+   		   else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
+   	   ))
+       dflags <- getDynFlags
+       io $ putStrLn (showSDoc (
+          vcat (text "GHCi-specific dynamic flag settings:" 
+               :map (flagSetting dflags) ghciFlags)
+          ))
+       io $ putStrLn (showSDoc (
+          vcat (text "other dynamic, non-language, flag settings:" 
+               :map (flagSetting dflags) nonLanguageDynFlags)
+          ))
+  where flagSetting dflags (str, f, _)
+          | dopt f dflags = text "  " <> text "-f"    <> text str
+          | otherwise     = text "  " <> text "-fno-" <> text str
+        (ghciFlags,others)  = partition (\(_, f, _) -> f `elem` flags)
+                                        DynFlags.fFlags
+        nonLanguageDynFlags = filterOut (\(_, f, _) -> f `elem` languageOptions)
+                                        others
+        flags = [Opt_PrintExplicitForalls
+                ,Opt_PrintBindResult
+                ,Opt_BreakOnException
+                ,Opt_BreakOnError
+                ,Opt_PrintEvldWithShow
+                ] 
+setCmd str
+  = case getCmd str of
+    Right ("args",   rest) ->
+        case toArgs rest of
+            Left err -> io (hPutStrLn stderr err)
+            Right args -> setArgs args
+    Right ("prog",   rest) ->
+        case toArgs rest of
+            Right [prog] -> setProg prog
+            _ -> io (hPutStrLn stderr "syntax: :set prog <progname>")
+    Right ("prompt", rest) -> setPrompt $ dropWhile isSpace rest
+    Right ("editor", rest) -> setEditor $ dropWhile isSpace rest
+    Right ("stop",   rest) -> setStop   $ dropWhile isSpace rest
+    _ -> case toArgs str of
+         Left err -> io (hPutStrLn stderr err)
+         Right wds -> setOptions wds
+
+setArgs, setOptions :: [String] -> GHCi ()
+setProg, setEditor, setStop, setPrompt :: String -> GHCi ()
+
+setArgs args = do
+  st <- getGHCiState
+  setGHCiState st{ args = args }
+
+setProg prog = do
+  st <- getGHCiState
+  setGHCiState st{ progname = prog }
+
+setEditor cmd = do
+  st <- getGHCiState
+  setGHCiState st{ editor = cmd }
+
+setStop str@(c:_) | isDigit c
+  = do let (nm_str,rest) = break (not.isDigit) str
+           nm = read nm_str
+       st <- getGHCiState
+       let old_breaks = breaks st
+       if all ((/= nm) . fst) old_breaks
+              then printForUser (text "Breakpoint" <+> ppr nm <+>
+                                 text "does not exist")
+              else do
+       let new_breaks = map fn old_breaks
+           fn (i,loc) | i == nm   = (i,loc { onBreakCmd = dropWhile isSpace rest })
+                      | otherwise = (i,loc)
+       setGHCiState st{ breaks = new_breaks }
+setStop cmd = do
+  st <- getGHCiState
+  setGHCiState st{ stop = cmd }
+
+setPrompt value = do
+  st <- getGHCiState
+  if null value
+      then io $ 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' })
+                       _ ->
+                           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.)
+      let (plus_opts, minus_opts)  = partitionWith isPlus wds
+      mapM_ setOpt plus_opts
+      -- then, dynamic flags
+      newDynFlags minus_opts
+
+newDynFlags :: [String] -> GHCi ()
+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
+
+      if (not (null leftovers))
+        then ghcError $ errorsToGhcException leftovers
+        else return ()
+
+      new_pkgs <- setDynFlags dflags'
+
+      -- if the package flags changed, we should reset the context
+      -- 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..."
+        GHC.setTargets []
+        GHC.load LoadAllTargets
+        io (linkPackages dflags new_pkgs)
+        -- package flags changed, we can't re-use any of the old context
+        setContextAfterLoad ([],[]) False []
+      return ()
+
+
+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
+
+       mapM_ unsetOpt plus_opts
+ 
+       let no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
+           no_flag f = ghcError (ProgramError ("don't know how to reverse " ++ f))
+
+       no_flags <- mapM no_flag minus_opts
+       newDynFlags no_flags
+
+isMinus :: String -> Bool
+isMinus ('-':_) = True
+isMinus _ = False
+
+isPlus :: String -> Either String String
+isPlus ('+':opt) = Left opt
+isPlus other     = Right other
+
+setOpt, unsetOpt :: String -> GHCi ()
+
+setOpt str
+  = case strToGHCiOpt str of
+	Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
+	Just o  -> setOption o
+
+unsetOpt str
+  = case strToGHCiOpt str of
+	Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
+	Just o  -> unsetOption o
+
+strToGHCiOpt :: String -> (Maybe GHCiOption)
+strToGHCiOpt "s" = Just ShowTiming
+strToGHCiOpt "t" = Just ShowType
+strToGHCiOpt "r" = Just RevertCAFs
+strToGHCiOpt _   = Nothing
+
+optToStr :: GHCiOption -> String
+optToStr ShowTiming = "s"
+optToStr ShowType   = "t"
+optToStr RevertCAFs = "r"
+
+-- ---------------------------------------------------------------------------
+-- code for `:show'
+
+showCmd :: String -> GHCi ()
+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))
+	["modules" ] -> showModules
+	["bindings"] -> showBindings
+	["linker"]   -> io showLinkerState
+        ["breaks"]   -> showBkptTable
+        ["context"]  -> showContext
+        ["packages"]  -> showPackages
+        ["languages"]  -> showLanguages
+	_ -> ghcError (CmdLineError ("syntax:  :show [ args | prog | prompt | editor | stop | modules | bindings\n"++
+                                     "               | breaks | context | packages | languages ]"))
+
+showModules :: GHCi ()
+showModules = do
+  loaded_mods <- getLoadedModules
+        -- we want *loaded* modules only, see #1734
+  let show_one ms = do m <- GHC.showModule ms; io (putStrLn m)
+  mapM_ show_one loaded_mods
+
+getLoadedModules :: GHC.GhcMonad m => m [GHC.ModSummary]
+getLoadedModules = do
+  graph <- GHC.getModuleGraph
+  filterM (GHC.isLoaded . GHC.ms_mod_name) graph
+
+showBindings :: GHCi ()
+showBindings = do
+  bindings <- GHC.getBindings
+  docs     <- pprTypeAndContents
+                  [ id | AnId id <- sortBy compareTyThings bindings]
+  printForUserPartWay docs
+
+compareTyThings :: TyThing -> TyThing -> Ordering
+t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
+
+printTyThing :: TyThing -> GHCi ()
+printTyThing tyth = do dflags <- getDynFlags
+                       let pefas = dopt Opt_PrintExplicitForalls dflags
+		       printForUser (pprTyThing pefas tyth)
+
+showBkptTable :: GHCi ()
+showBkptTable = do
+  st <- getGHCiState
+  printForUser $ prettyLocations (breaks st)
+
+showContext :: GHCi ()
+showContext = do
+   resumes <- GHC.getResumeContext
+   printForUser $ vcat (map pp_resume (reverse resumes))
+  where
+   pp_resume resume =
+        ptext (sLit "--> ") <> text (GHC.resumeStmt resume)
+        $$ nest 2 (ptext (sLit "Stopped at") <+> ppr (GHC.resumeSpan resume))
+
+showPackages :: GHCi ()
+showPackages = do
+  pkg_flags <- fmap packageFlags getDynFlags
+  io $ putStrLn $ showSDoc $ vcat $
+    text ("active package flags:"++if null pkg_flags then " none" else "")
+    : map showFlag pkg_flags
+  pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags
+  io $ putStrLn $ showSDoc $ vcat $
+    text "packages currently loaded:" 
+    : map (nest 2 . text . packageIdString) 
+               (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
+
+showLanguages :: GHCi ()
+showLanguages = do
+   dflags <- getDynFlags
+   io $ putStrLn $ showSDoc $ vcat $
+      text "active language flags:" :
+      [text ("  -X" ++ str) | (str, f, _) <- DynFlags.xFlags, dopt f dflags]
+
+-- -----------------------------------------------------------------------------
+-- Completion
+
+completeCmd, completeMacro, completeIdentifier, completeModule,
+    completeHomeModule, completeSetOptions, completeShowOptions,
+    completeHomeModuleOrFile, completeExpression
+    :: CompletionFunc GHCi
+
+ghciCompleteWord :: CompletionFunc GHCi
+ghciCompleteWord line@(left,_) = case firstWord of
+    ':':cmd     | null rest     -> completeCmd line
+                | otherwise     -> do
+                        completion <- lookupCompletion cmd
+                        completion line
+    "import"    -> completeModule line
+    _           -> completeExpression line
+  where
+    (firstWord,rest) = break isSpace $ dropWhile isSpace $ reverse left
+    lookupCompletion ('!':_) = return completeFilename
+    lookupCompletion c = do
+        maybe_cmd <- liftIO $ lookupCommand' c
+        case maybe_cmd of
+            Just (_,_,f) -> return f
+            Nothing -> return completeFilename
+
+completeCmd = wrapCompleter " " $ \w -> do
+  cmds <- liftIO $ readIORef macros_ref
+  return (filter (w `isPrefixOf`) (map (':':) 
+             (map cmdName (builtin_commands ++ cmds))))
+
+completeMacro = wrapIdentCompleter $ \w -> do
+  cmds <- liftIO $ readIORef macros_ref
+  return (filter (w `isPrefixOf`) (map cmdName cmds))
+
+completeIdentifier = wrapIdentCompleter $ \w -> do
+  rdrs <- GHC.getRdrNamesInScope
+  return (filter (w `isPrefixOf`) (map (showSDoc.ppr) rdrs))
+
+completeModule = wrapIdentCompleter $ \w -> do
+  dflags <- GHC.getSessionDynFlags
+  let pkg_mods = allExposedModules dflags
+  loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
+  return $ filter (w `isPrefixOf`)
+        $ map (showSDoc.ppr) $ loaded_mods ++ pkg_mods
+
+completeHomeModule = wrapIdentCompleter listHomeModules
+
+listHomeModules :: String -> GHCi [String]
+listHomeModules w = do
+    g <- GHC.getModuleGraph
+    let home_mods = map GHC.ms_mod_name g
+    return $ sort $ filter (w `isPrefixOf`)
+            $ map (showSDoc.ppr) home_mods
+
+completeSetOptions = wrapCompleter flagWordBreakChars $ \w -> do
+  return (filter (w `isPrefixOf`) options)
+    where options = "args":"prog":"prompt":"editor":"stop":flagList
+          flagList = map head $ group $ sort allFlags
+
+completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do
+  return (filter (w `isPrefixOf`) options)
+    where options = ["args", "prog", "prompt", "editor", "stop",
+                     "modules", "bindings", "linker", "breaks",
+                     "context", "packages", "languages"]
+
+completeHomeModuleOrFile = completeWord Nothing filenameWordBreakChars
+                $ unionComplete (fmap (map simpleCompletion) . listHomeModules)
+                            listFiles
+
+unionComplete :: Monad m => (a -> m [b]) -> (a -> m [b]) -> a -> m [b]
+unionComplete f1 f2 line = do
+  cs1 <- f1 line
+  cs2 <- f2 line
+  return (cs1 ++ cs2)
+
+wrapCompleter :: String -> (String -> GHCi [String]) -> CompletionFunc GHCi
+wrapCompleter breakChars fun = completeWord Nothing breakChars
+    $ fmap (map simpleCompletion) . fmap sort . fun
+
+wrapIdentCompleter :: (String -> GHCi [String]) -> CompletionFunc GHCi
+wrapIdentCompleter = wrapCompleter word_break_chars
+
+allExposedModules :: DynFlags -> [ModuleName]
+allExposedModules dflags 
+ = concat (map exposedModules (filter exposed (eltsUFM pkg_db)))
+ where
+  pkg_db = pkgIdMap (pkgState dflags)
+
+completeExpression = completeQuotedWord (Just '\\') "\"" listFiles
+                        completeIdentifier
+
+-- ---------------------------------------------------------------------------
+-- User code exception handling
+
+-- This is the exception handler for exceptions generated by the
+-- user's code and exceptions coming from children sessions; 
+-- it normally just prints out the exception.  The
+-- handler must be recursive, in case showing the exception causes
+-- more exceptions to be raised.
+--
+-- Bugfix: if the user closed stdout or stderr, the flushing will fail,
+-- raising another exception.  We therefore don't put the recursive
+-- handler arond the flushing operation, so if stderr is closed
+-- GHCi will just die gracefully rather than going into an infinite loop.
+handler :: SomeException -> GHCi Bool
+
+handler exception = do
+  flushInterpBuffers
+  io installSignalHandlers
+  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)
+
+-----------------------------------------------------------------------------
+-- recursive exception handlers
+
+-- Don't forget to unblock async exceptions in the handler, or if we're
+-- in an exception loop (eg. let a = error a in a) the ^C exception
+-- may never be delivered.  Thanks to Marcin for pointing out the bug.
+
+ghciHandle :: MonadException m => (SomeException -> m a) -> m a -> m a
+ghciHandle h m = Haskeline.catch m $ \e -> unblock (h e)
+
+ghciTry :: GHCi a -> GHCi (Either SomeException a)
+ghciTry (GHCi m) = GHCi $ \s -> gtry (m s)
+
+-- ----------------------------------------------------------------------------
+-- Utils
+
+-- TODO: won't work if home dir is encoded.
+-- (changeDirectory may not work either in that case.)
+expandPath :: MonadIO m => String -> InputT m String
+expandPath path = do
+    exp_path <- liftIO $ expandPathIO path
+    enc <- fmap BS.unpack $ Encoding.encode exp_path
+    return enc
+
+expandPathIO :: String -> IO String
+expandPathIO path = 
+  case dropWhile isSpace path of
+   ('~':d) -> do
+	tilde <- getHomeDirectory -- will fail if HOME not defined
+	return (tilde ++ '/':d)
+   other -> 
+	return other
+
+wantInterpretedModule :: GHC.GhcMonad m => String -> m Module
+wantInterpretedModule str = do
+   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 <- GHC.moduleIsInterpreted modl
+   when (not is_interpreted) $
+       ghcError (CmdLineError ("module '" ++ str ++ "' is not interpreted; try \':add *" ++ str ++ "' first"))
+   return modl
+
+wantNameFromInterpretedModule :: GHC.GhcMonad m
+                              => (Name -> SDoc -> m ())
+                              -> String
+                              -> (Name -> m ())
+                              -> m ()
+wantNameFromInterpretedModule noCanDo str and_then =
+  handleSourceError (GHC.printExceptionAndWarnings) $ do
+   names <- GHC.parseName str
+   case names of
+      []    -> return ()
+      (n:_) -> do
+            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
+            is_interpreted <- GHC.moduleIsInterpreted modl
+            if not is_interpreted
+               then noCanDo n $ text "module " <> ppr modl <>
+                                text " is not interpreted"
+               else and_then n
+
+-- -----------------------------------------------------------------------------
+-- commands for debugger
+
+sprintCmd, printCmd, forceCmd :: String -> GHCi ()
+sprintCmd = pprintCommand False False
+printCmd  = pprintCommand True False
+forceCmd  = pprintCommand False True
+
+pprintCommand :: Bool -> Bool -> String -> GHCi ()
+pprintCommand bind force str = do
+  pprintClosureCommand bind force str
+
+stepCmd :: String -> GHCi ()
+stepCmd []         = doContinue (const True) GHC.SingleStep
+stepCmd expression = do runStmt expression GHC.SingleStep; return ()
+
+stepLocalCmd :: String -> GHCi ()
+stepLocalCmd  [] = do 
+  mb_span <- getCurrentBreakSpan
+  case mb_span of
+    Nothing  -> stepCmd []
+    Just loc -> do
+       Just mod <- getCurrentBreakModule
+       current_toplevel_decl <- enclosingTickSpan mod loc
+       doContinue (`isSubspanOf` current_toplevel_decl) GHC.SingleStep
+
+stepLocalCmd expression = stepCmd expression
+
+stepModuleCmd :: String -> GHCi ()
+stepModuleCmd  [] = do 
+  mb_span <- getCurrentBreakSpan
+  case mb_span of
+    Nothing  -> stepCmd []
+    Just _ -> do
+       Just span <- getCurrentBreakSpan
+       let f some_span = srcSpanFileName_maybe span == srcSpanFileName_maybe some_span
+       doContinue f GHC.SingleStep
+
+stepModuleCmd expression = stepCmd expression
+
+-- | Returns the span of the largest tick containing the srcspan given
+enclosingTickSpan :: Module -> SrcSpan -> GHCi SrcSpan
+enclosingTickSpan mod src = do
+  ticks <- getTickArray mod
+  let line = srcSpanStartLine src
+  ASSERT (inRange (bounds ticks) line) do
+  let enclosing_spans = [ span | (_,span) <- ticks ! line
+                               , srcSpanEnd span >= srcSpanEnd src]
+  return . head . sortBy leftmost_largest $ enclosing_spans
+
+traceCmd :: String -> GHCi ()
+traceCmd []         = doContinue (const True) GHC.RunAndLogSteps
+traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
+
+continueCmd :: String -> GHCi ()
+continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
+
+-- doContinue :: SingleStep -> GHCi ()
+doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
+doContinue pred step = do 
+  runResult <- resume pred step
+  afterRunStmt pred runResult
+  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 ()
+
+deleteCmd :: String -> GHCi ()
+deleteCmd argLine = do
+   deleteSwitch $ words argLine
+   where
+   deleteSwitch :: [String] -> GHCi ()
+   deleteSwitch [] = 
+      io $ putStrLn "The delete command requires at least one argument."
+   -- delete all break points
+   deleteSwitch ("*":_rest) = discardActiveBreakPoints
+   deleteSwitch idents = do
+      mapM_ deleteOneBreak idents 
+      where
+      deleteOneBreak :: String -> GHCi ()
+      deleteOneBreak str
+         | all isDigit str = deleteBreak (read str)
+         | otherwise = return ()
+
+historyCmd :: String -> GHCi ()
+historyCmd arg
+  | null arg        = history 20
+  | all isDigit arg = history (read arg)
+  | otherwise       = io $ putStrLn "Syntax:  :history [num]"
+  where
+  history num = do
+    resumes <- GHC.getResumeContext
+    case resumes of
+      [] -> io $ putStrLn "Not stopped at a breakpoint"
+      (r:_) -> do
+        let hist = GHC.resumeHistory r
+            (took,rest) = splitAt num hist
+        case hist of
+          [] -> io $ putStrLn $ 
+                   "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
+                 printForUser (vcat(zipWith3 
+                                 (\x y z -> x <+> y <+> z) 
+                                 (map text nums) 
+                                 (map (bold . ppr) names)
+                                 (map (parens . ppr) spans)))
+                 io $ putStrLn $ if null rest then "<end of history>" else "..."
+
+bold :: SDoc -> SDoc
+bold c | do_bold   = text start_bold <> c <> text end_bold
+       | otherwise = c
+
+backCmd :: String -> GHCi ()
+backCmd = noArgs $ do
+  (names, _, span) <- GHC.back
+  printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr span
+  printTypeOfNames names
+   -- run the command set with ":set stop <cmd>"
+  st <- getGHCiState
+  enqueueCommands [stop st]
+
+forwardCmd :: String -> GHCi ()
+forwardCmd = noArgs $ do
+  (names, ix, span) <- GHC.forward
+  printForUser $ (if (ix == 0)
+                    then ptext (sLit "Stopped at")
+                    else ptext (sLit "Logged breakpoint at")) <+> ppr span
+  printTypeOfNames names
+   -- run the command set with ":set stop <cmd>"
+  st <- getGHCiState
+  enqueueCommands [stop st]
+
+-- handle the "break" command
+breakCmd :: String -> GHCi ()
+breakCmd argLine = do
+   breakSwitch $ words argLine
+
+breakSwitch :: [String] -> GHCi ()
+breakSwitch [] = do
+   io $ putStrLn "The break command requires at least one argument."
+breakSwitch (arg1:rest)
+   | looksLikeModuleName arg1 && not (null rest) = do
+        mod <- wantInterpretedModule arg1
+        breakByModule mod rest
+   | all isDigit arg1 = do
+        (toplevel, _) <- GHC.getContext
+        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?"
+   | otherwise = do -- try parsing it as an identifier
+        wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
+        if GHC.isGoodSrcLoc loc
+               then ASSERT( isExternalName name ) 
+	       	    findBreakAndSet (GHC.nameModule name) $ 
+                         findBreakByCoord (Just (GHC.srcLocFile loc))
+                                          (GHC.srcLocLine loc, 
+                                           GHC.srcLocCol loc)
+               else noCanDo name $ text "can't find its location: " <> ppr loc
+       where
+          noCanDo n why = printForUser $
+                text "cannot set breakpoint on " <> ppr n <> text ": " <> why
+
+breakByModule :: Module -> [String] -> GHCi () 
+breakByModule mod (arg1:rest)
+   | all isDigit arg1 = do  -- looks like a line number
+        breakByModuleLine mod (read arg1) rest
+breakByModule _ _
+   = breakSyntax
+
+breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
+breakByModuleLine mod line args
+   | [] <- args = findBreakAndSet mod $ findBreakByLine line
+   | [col] <- args, all isDigit col =
+        findBreakAndSet mod $ findBreakByCoord Nothing (line, read col)
+   | otherwise = breakSyntax
+
+breakSyntax :: a
+breakSyntax = ghcError (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
+
+findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
+findBreakAndSet mod lookupTickTree = do 
+   tickArray <- getTickArray mod
+   (breakArray, _) <- getModBreak mod
+   case lookupTickTree tickArray of 
+      Nothing  -> io $ putStrLn $ "No breakpoints found at that location."
+      Just (tick, span) -> do
+         success <- io $ setBreakFlag True breakArray tick 
+         if success 
+            then do
+               (alreadySet, nm) <- 
+                     recordBreak $ BreakLocation
+                             { breakModule = mod
+                             , breakLoc = span
+                             , breakTick = tick
+                             , onBreakCmd = ""
+                             }
+               printForUser $
+                  text "Breakpoint " <> ppr nm <>
+                  if alreadySet 
+                     then text " was already set at " <> ppr span
+                     else text " activated at " <> ppr span
+            else do
+            printForUser $ text "Breakpoint could not be activated at" 
+                                 <+> ppr span
+
+-- When a line number is specified, the current policy for choosing
+-- the best breakpoint is this:
+--    - the leftmost complete subexpression on the specified line, or
+--    - the leftmost subexpression starting on the specified line, or
+--    - the rightmost subexpression enclosing the specified line
+--
+findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
+findBreakByLine line arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    listToMaybe (sortBy (leftmost_largest `on` snd)  complete)   `mplus`
+    listToMaybe (sortBy (leftmost_smallest `on` snd) incomplete) `mplus`
+    listToMaybe (sortBy (rightmost `on` snd) ticks)
+  where 
+        ticks = arr ! line
+
+        starts_here = [ tick | tick@(_,span) <- ticks,
+                               GHC.srcSpanStartLine span == line ]
+
+        (complete,incomplete) = partition ends_here starts_here
+            where ends_here (_,span) = GHC.srcSpanEndLine span == line
+
+findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
+                 -> Maybe (BreakIndex,SrcSpan)
+findBreakByCoord mb_file (line, col) arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    listToMaybe (sortBy (rightmost `on` snd) contains ++
+                 sortBy (leftmost_smallest `on` snd) after_here)
+  where 
+        ticks = arr ! line
+
+        -- the ticks that span this coordinate
+        contains = [ tick | tick@(_,span) <- ticks, span `spans` (line,col),
+                            is_correct_file span ]
+
+        is_correct_file span
+                 | Just f <- mb_file = GHC.srcSpanFile span == f
+                 | otherwise         = True
+
+        after_here = [ tick | tick@(_,span) <- ticks,
+                              GHC.srcSpanStartLine span == line,
+                              GHC.srcSpanStartCol span >= col ]
+
+-- For now, use ANSI bold on terminals that we know support it.
+-- Otherwise, we add a line of carets under the active expression instead.
+-- In particular, on Windows and when running the testsuite (which sets
+-- TERM to vt100 for other reasons) we get carets.
+-- We really ought to use a proper termcap/terminfo library.
+do_bold :: Bool
+do_bold = (`isPrefixOf` unsafePerformIO mTerm) `any` ["xterm", "linux"]
+    where mTerm = System.Environment.getEnv "TERM"
+                  `catchIO` \_ -> return "TERM not set"
+
+start_bold :: String
+start_bold = "\ESC[1m"
+end_bold :: String
+end_bold   = "\ESC[0m"
+
+listCmd :: String -> InputT GHCi ()
+listCmd "" = do
+   mb_span <- lift getCurrentBreakSpan
+   case mb_span of
+      Nothing ->
+          printForUser' $ text "Not stopped at a breakpoint; nothing to list"
+      Just span
+       | GHC.isGoodSrcSpan span -> listAround span True
+       | otherwise ->
+          do resumes <- GHC.getResumeContext
+             case resumes of
+                 [] -> panic "No resumes"
+                 (r:_) ->
+                     do let traceIt = case GHC.resumeHistory r of
+                                      [] -> text "rerunning with :trace,"
+                                      _ -> empty
+                            doWhat = traceIt <+> text ":back then :list"
+                        printForUser' (text "Unable to list source for" <+>
+                                      ppr span
+                                   $$ text "Try" <+> doWhat)
+listCmd str = list2 (words str)
+
+list2 :: [String] -> InputT GHCi ()
+list2 [arg] | all isDigit arg = do
+    (toplevel, _) <- GHC.getContext
+    case toplevel of
+        [] -> outputStrLn "No module to list"
+        (mod : _) -> listModuleLine mod (read arg)
+list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
+        mod <- wantInterpretedModule arg1
+        listModuleLine mod (read arg2)
+list2 [arg] = do
+        wantNameFromInterpretedModule noCanDo arg $ \name -> do
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
+        if GHC.isGoodSrcLoc loc
+               then do
+                  tickArray <- ASSERT( isExternalName name )
+		  	       lift $ getTickArray (GHC.nameModule name)
+                  let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
+                                        (GHC.srcLocLine loc, GHC.srcLocCol loc)
+                                        tickArray
+                  case mb_span of
+                    Nothing       -> listAround (GHC.srcLocSpan loc) False
+                    Just (_,span) -> listAround span False
+               else
+                  noCanDo name $ text "can't find its location: " <>
+                                 ppr loc
+    where
+        noCanDo n why = printForUser' $
+            text "cannot list source code for " <> ppr n <> text ": " <> why
+list2  _other = 
+        outputStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
+
+listModuleLine :: Module -> Int -> InputT GHCi ()
+listModuleLine modl line = do
+   graph <- GHC.getModuleGraph
+   let this = filter ((== modl) . GHC.ms_mod) graph
+   case this of
+     [] -> panic "listModuleLine"
+     summ:_ -> do
+           let filename = expectJust "listModuleLine" (ml_hs_file (GHC.ms_location summ))
+               loc = GHC.mkSrcLoc (mkFastString (filename)) line 0
+           listAround (GHC.srcLocSpan loc) False
+
+-- | list a section of a source file around a particular SrcSpan.
+-- If the highlight flag is True, also highlight the span using
+-- start_bold\/end_bold.
+
+-- GHC files are UTF-8, so we can implement this by:
+-- 1) read the file in as a BS and syntax highlight it as before
+-- 2) convert the BS to String using utf-string, and write it out.
+-- It would be better if we could convert directly between UTF-8 and the
+-- console encoding, of course.
+listAround :: MonadIO m => SrcSpan -> Bool -> InputT m ()
+listAround span do_highlight = do
+      contents <- liftIO $ BS.readFile (unpackFS file)
+      let 
+          lines = BS.split '\n' contents
+          these_lines = take (line2 - line1 + 1 + pad_before + pad_after) $ 
+                        drop (line1 - 1 - pad_before) $ lines
+          fst_line = max 1 (line1 - pad_before)
+          line_nos = [ fst_line .. ]
+
+          highlighted | do_highlight = zipWith highlight line_nos these_lines
+                      | otherwise    = [\p -> BS.concat[p,l] | l <- these_lines]
+
+          bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
+          prefixed = zipWith ($) highlighted bs_line_nos
+      --
+      let output = BS.intercalate (BS.pack "\n") prefixed
+      utf8Decoded <- liftIO $ BS.useAsCStringLen output
+                        $ \(p,n) -> utf8DecodeString (castPtr p) n
+      outputStrLn utf8Decoded
+  where
+        file  = GHC.srcSpanFile span
+        line1 = GHC.srcSpanStartLine span
+        col1  = GHC.srcSpanStartCol span
+        line2 = GHC.srcSpanEndLine span
+        col2  = GHC.srcSpanEndCol span
+
+        pad_before | line1 == 1 = 0
+                   | otherwise  = 1
+        pad_after = 1
+
+        highlight | do_bold   = highlight_bold
+                  | otherwise = highlight_carets
+
+        highlight_bold no line prefix
+          | no == line1 && no == line2
+          = let (a,r) = BS.splitAt col1 line
+                (b,c) = BS.splitAt (col2-col1) r
+            in
+            BS.concat [prefix, a,BS.pack start_bold,b,BS.pack end_bold,c]
+          | no == line1
+          = let (a,b) = BS.splitAt col1 line in
+            BS.concat [prefix, a, BS.pack start_bold, b]
+          | no == line2
+          = let (a,b) = BS.splitAt col2 line in
+            BS.concat [prefix, a, BS.pack end_bold, b]
+          | otherwise   = BS.concat [prefix, line]
+
+        highlight_carets no line prefix
+          | no == line1 && no == line2
+          = BS.concat [prefix, line, nl, indent, BS.replicate col1 ' ',
+                                         BS.replicate (col2-col1) '^']
+          | no == line1
+          = BS.concat [indent, BS.replicate (col1 - 2) ' ', BS.pack "vv", nl, 
+                                         prefix, line]
+          | no == line2
+          = BS.concat [prefix, line, nl, indent, BS.replicate col2 ' ',
+                                         BS.pack "^^"]
+          | otherwise   = BS.concat [prefix, line]
+         where
+           indent = BS.pack ("  " ++ replicate (length (show no)) ' ')
+           nl = BS.singleton '\n'
+
+-- --------------------------------------------------------------------------
+-- Tick arrays
+
+getTickArray :: Module -> GHCi TickArray
+getTickArray modl = do
+   st <- getGHCiState
+   let arrmap = tickarrays st
+   case lookupModuleEnv arrmap modl of
+      Just arr -> return arr
+      Nothing  -> do
+        (_breakArray, ticks) <- getModBreak modl 
+        let arr = mkTickArray (assocs ticks)
+        setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
+        return arr
+
+discardTickArrays :: GHCi ()
+discardTickArrays = do
+   st <- getGHCiState
+   setGHCiState st{tickarrays = emptyModuleEnv}
+
+mkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray
+mkTickArray ticks
+  = accumArray (flip (:)) [] (1, max_line) 
+        [ (line, (nm,span)) | (nm,span) <- ticks,
+                              line <- srcSpanLines span ]
+    where
+        max_line = foldr max 0 (map GHC.srcSpanEndLine (map snd ticks))
+        srcSpanLines span = [ GHC.srcSpanStartLine span .. 
+                              GHC.srcSpanEndLine span ]
+
+lookupModule :: GHC.GhcMonad m => String -> m Module
+lookupModule modName
+   = GHC.lookupModule (GHC.mkModuleName modName) Nothing
+
+-- don't reset the counter back to zero?
+discardActiveBreakPoints :: GHCi ()
+discardActiveBreakPoints = do
+   st <- getGHCiState
+   mapM (turnOffBreak.snd) (breaks st)
+   setGHCiState $ st { breaks = [] }
+
+deleteBreak :: Int -> GHCi ()
+deleteBreak identity = do
+   st <- getGHCiState
+   let oldLocations    = breaks st
+       (this,rest)     = partition (\loc -> fst loc == identity) oldLocations
+   if null this 
+      then printForUser (text "Breakpoint" <+> ppr identity <+>
+                         text "does not exist")
+      else do
+           mapM (turnOffBreak.snd) this
+           setGHCiState $ st { breaks = rest }
+
+turnOffBreak :: BreakLocation -> GHCi Bool
+turnOffBreak loc = do
+  (arr, _) <- getModBreak (breakModule loc)
+  io $ setBreakFlag False arr (breakTick loc)
+
+getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
+getModBreak mod = do
+   Just mod_info <- GHC.getModuleInfo mod
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let array      = GHC.modBreaks_flags modBreaks
+   let ticks      = GHC.modBreaks_locs  modBreaks
+   return (array, ticks)
+
+setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool 
+setBreakFlag toggle array index
+   | toggle    = GHC.setBreakOn array index 
+   | otherwise = GHC.setBreakOff array index
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 3374edf62d..df3b515386 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -28,15 +28,29 @@ Executable ghc
     Main-Is: Main.hs
     if flag(base3)
         Build-Depends: base       >= 3   && < 5,
-                       directory  >= 1   && < 1.1
+                       array      >= 0.1 && < 0.3,
+                       bytestring >= 0.9 && < 0.10,
+                       directory  >= 1   && < 1.1,
+                       process    >= 1   && < 1.1
     else
         Build-Depends: base < 3
     Build-Depends: base, ghc
     Build-Depends: filepath >= 1 && < 1.2
+    if os(windows)
+        Build-Depends: Win32
+    else
+        Build-Depends: unix
 
     GHC-Options: -Wall
     if flag(ghci)
         CPP-Options: -DGHCI
+        GHC-Options: -fno-warn-name-shadowing
+        Other-Modules: InteractiveUI, GhciMonad, GhciTags
+        Build-Depends: mtl, haskeline
+        Extensions: ForeignFunctionInterface,
+                    UnboxedTuples,
+                    FlexibleInstances,
+                    MagicHash
 
     Extensions: CPP, PatternGuards
 
diff --git a/ghc/ghc.mk b/ghc/ghc.mk
index ccd4c5d685..3a3edec1ce 100644
--- a/ghc/ghc.mk
+++ b/ghc/ghc.mk
@@ -41,8 +41,8 @@ endif
 
 ghc_stage1_MODULES = Main
 
-ghc_stage2_MODULES = $(ghc_stage1_MODULES)
-ghc_stage3_MODULES = $(ghc_stage1_MODULES)
+ghc_stage2_MODULES = $(ghc_stage1_MODULES) GhciMonad GhciTags InteractiveUI
+ghc_stage3_MODULES = $(ghc_stage2_MODULES)
 
 ghc_stage1_PROG = ghc-stage1$(exeext)
 ghc_stage2_PROG = ghc-stage2$(exeext)
@@ -53,10 +53,18 @@ ghc_stage1_USE_BOOT_LIBS = YES
 ghc_stage1_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage1_VERSION)
 ghc_stage2_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage2_VERSION)
 ghc_stage3_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage3_VERSION)
-
-ghc_stage1_HC_OPTS += -XCPP -XPatternGuards
-ghc_stage2_HC_OPTS += -XCPP -XPatternGuards
-ghc_stage3_HC_OPTS += -XCPP -XPatternGuards
+ghc_stage2_HC_OPTS += -package haskeline
+ghc_stage3_HC_OPTS += -package haskeline
+
+ghc_language_extension_flags = -XCPP \
+                               -XPatternGuards \
+                               -XForeignFunctionInterface \
+                               -XUnboxedTuples \
+                               -XFlexibleInstances \
+                               -XMagicHash
+ghc_stage1_HC_OPTS += $(ghc_language_extension_flags)
+ghc_stage2_HC_OPTS += $(ghc_language_extension_flags)
+ghc_stage3_HC_OPTS += $(ghc_language_extension_flags)
 
 # In stage1 we might not benefit from cross-package dependencies and
 # recompilation checking.  We must force recompilation here, otherwise