X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=4d7658ec93f82693a0744bec4eb06bc601b664e7;hb=af95321493a31cbaf34170fd9ab5e9c65a416506;hp=c09aab52744076d438007b4a12e3356d79851e26;hpb=4409628fbb7925eccf9fe0784809fa2eb8d790dc;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index c09aab5..4d7658e 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -3,7 +3,7 @@
 --
 -- GHC Interactive User Interface
 --
--- (c) The GHC Team 2005
+-- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------
 module InteractiveUI ( 
@@ -13,52 +13,32 @@ module InteractiveUI (
 
 #include "HsVersions.h"
 
-#if defined(GHCI) && defined(BREAKPOINT)
-import GHC.Exts         ( Int(..), Ptr(..), int2Addr# )
-import Foreign.StablePtr ( deRefStablePtr, castPtrToStablePtr )
-import System.IO.Unsafe ( unsafePerformIO )
-import Var              ( Id, globaliseId, idName, idType )
-import HscTypes         ( Session(..), InteractiveContext(..), HscEnv(..)
-                        , extendTypeEnvWithIds )
-import RdrName          ( extendLocalRdrEnv, mkRdrUnqual, lookupLocalRdrEnv )
-import NameEnv          ( delListFromNameEnv )
-import TcType           ( tidyTopType )
-import qualified Id     ( setIdType )
-import IdInfo           ( GlobalIdDetails(..) )
-import Linker           ( HValue, extendLinkEnv, withExtendedLinkEnv,initDynLinker  )
-import PrelNames        ( breakpointJumpName, breakpointCondJumpName )
-#endif
+import GhciMonad
+import GhciTags
+import Debugger
 
 -- The GHC interface
 import qualified GHC
-import GHC		( Session, verbosity, dopt, DynFlag(..), Target(..),
-			  TargetId(..), DynFlags(..),
-			  pprModule, Type, Module, SuccessFlag(..),
-			  TyThing(..), Name, LoadHowMuch(..), Phase,
-			  GhcException(..), showGhcException,
-			  CheckedModule(..), SrcLoc )
-import DynFlags         ( allFlags )
-import Packages		( PackageState(..) )
-import PackageConfig	( InstalledPackageInfo(..) )
-import UniqFM		( eltsUFM )
+import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
+                          Type, Module, ModuleName, TyThing(..), Phase,
+                          BreakIndex, Name, SrcSpan )
+import DynFlags
+import Packages
+import PackageConfig
+import UniqFM
 import PprTyThing
-import Outputable
-
--- for createtags (should these come via GHC?)
-import Module		( moduleString )
-import Name		( nameSrcLoc, nameModule, nameOccName )
-import OccName		( pprOccName )
-import SrcLoc		( isGoodSrcLoc, srcLocFile, srcLocLine, srcLocCol )
+import Outputable       hiding (printForUser)
+import Module           -- for ModuleEnv
 
 -- Other random utilities
-import Digraph		( flattenSCCs )
-import BasicTypes	( failed, successIf )
-import Panic 		( panic, installSignalHandlers )
+import Digraph
+import BasicTypes hiding (isTopLevel)
+import Panic      hiding (showException)
+import FastString       ( unpackFS )
 import Config
-import StaticFlags	( opt_IgnoreDotGhci )
-import Linker		( showLinkerState )
-import Util		( removeSpaces, handle, global, toArgs,
-			  looksLikeModuleName, prefixMatch, sortLe )
+import StaticFlags
+import Linker
+import Util
 
 #ifndef mingw32_HOST_OS
 import System.Posix
@@ -67,6 +47,8 @@ import System.Posix
 #endif
 #else
 import GHC.ConsoleHandler ( flushConsole )
+import System.Win32	  ( setConsoleCP, setConsoleOutputCP )
+import qualified System.Win32
 #endif
 
 #ifdef USE_READLINE
@@ -77,29 +59,27 @@ import System.Console.Readline as Readline
 --import SystemExts
 
 import Control.Exception as Exception
-import Data.Dynamic
 -- import Control.Concurrent
 
-import Numeric
+import qualified Data.ByteString.Char8 as BS
 import Data.List
-import Data.Int		( Int64 )
-import Data.Maybe	( isJust, fromMaybe, catMaybes )
+import Data.Maybe
 import System.Cmd
-import System.CPUTime
 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.Dynamic
+import Data.Array
 import Control.Monad as Monad
-import Foreign.StablePtr	( newStablePtr )
-import Text.Printf
 
+import Foreign.StablePtr	( newStablePtr )
 import GHC.Exts		( unsafeCoerce# )
 import GHC.IOBase	( IOErrorType(InvalidArgument) )
 
-import Data.IORef	( IORef, newIORef, readIORef, writeIORef )
+import Data.IORef	( IORef, readIORef, writeIORef )
 
 import System.Posix.Internals ( setNonBlockingFD )
 
@@ -119,27 +99,39 @@ GLOBAL_VAR(commands, builtin_commands, [Command])
 
 builtin_commands :: [Command]
 builtin_commands = [
+	-- Hugs users are accustomed to :e, so make sure it doesn't overlap
+  ("?",		keepGoing help,			False, completeNone),
   ("add",	keepGoingPaths addModule,	False, completeFilename),
+  ("abandon",   keepGoing abandonCmd,           False, completeNone),
+  ("break",     keepGoing breakCmd,             False, completeIdentifier),
   ("browse",    keepGoing browseCmd,		False, completeModule),
-  ("cd",    	keepGoing changeDirectory, 	False, completeFilename),
+  ("cd",    	keepGoing changeDirectory,	False, completeFilename),
+  ("check",	keepGoing checkModule,		False, completeHomeModule),
+  ("continue",  continueCmd,                    False, completeNone),
+  ("ctags",	keepGoing createCTagsFileCmd, 	False, completeFilename),
   ("def",	keepGoing defineMacro,		False, completeIdentifier),
+  ("delete",    keepGoing deleteCmd,            False, completeNone),
+  ("e", 	keepGoing editFile,		False, completeFilename),
+  ("edit",	keepGoing editFile,		False, completeFilename),
+  ("etags",	keepGoing createETagsFileCmd,	False, completeFilename),
+  ("force",     keepGoing forceCmd,             False, completeIdentifier),
   ("help",	keepGoing help,			False, completeNone),
-  ("?",		keepGoing help,			False, completeNone),
   ("info",      keepGoing info,			False, completeIdentifier),
-  ("load",	keepGoingPaths loadModule_,	False, completeHomeModuleOrFile),
+  ("kind",	keepGoing kindOfType,		False, completeIdentifier),
+  ("load",	keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),
+  ("list",	keepGoing listCmd,              False, completeNone),
   ("module",	keepGoing setContext,		False, completeModule),
   ("main",	keepGoing runMain,		False, completeIdentifier),
-  ("reload",	keepGoing reloadModule,		False, completeNone),
-  ("check",	keepGoing checkModule,		False, completeHomeModule),
+  ("print",     keepGoing printCmd,             False, completeIdentifier),
+  ("quit",	quit,				False, completeNone),
+  ("reload", 	keepGoing reloadModule,  	False, completeNone),
   ("set",	keepGoing setCmd,		True,  completeSetOptions),
   ("show",	keepGoing showCmd,		False, completeNone),
-  ("etags",	keepGoing createETagsFileCmd,	False, completeFilename),
-  ("ctags",	keepGoing createCTagsFileCmd, 	False, completeFilename),
+  ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
+  ("step",      stepCmd,                        False, completeIdentifier), 
   ("type",	keepGoing typeOfExpr,		False, completeIdentifier),
-  ("kind",	keepGoing kindOfType,		False, completeIdentifier),
-  ("unset",	keepGoing unsetOptions,		True,  completeSetOptions),
   ("undef",     keepGoing undefineMacro,	False, completeMacro),
-  ("quit",	quit,				False, completeNone)
+  ("unset",	keepGoing unsetOptions,		True,  completeSetOptions)
   ]
 
 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
@@ -150,37 +142,53 @@ keepGoingPaths a str = a (toArgs str) >> return False
 
 shortHelpText = "use :? for help.\n"
 
--- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
 helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
  "   <stmt>                      evaluate/run <stmt>\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
+ "   :abandon                    at a breakpoint, abandon current computation\n" ++
+ "   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" ++
+ "   :break <name>               set a breakpoint on the specified function\n" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
+ "   :continue                   resume after a breakpoint\n" ++
+ "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
+ "   :delete <number>            delete the specified breakpoint\n" ++
+ "   :delete *                   delete all breakpoints\n" ++
+ "   :edit <file>                edit file\n" ++
+ "   :edit                       edit last module\n" ++
+ "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
+-- "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
+ "   :kind <type>                show the kind of <type>\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
+ "   :print [<name> ...]         prints a value without forcing its computation\n" ++
+ "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\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 <cmd>             set the command to run when a breakpoint is hit\n" ++
  "\n" ++
+ "   :show breaks                show active breakpoints\n" ++
+ "   :show context               show the breakpoint context\n" ++
  "   :show modules               show the currently loaded modules\n" ++
  "   :show bindings              show the current bindings made at the prompt\n" ++
  "\n" ++
- "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
- "   :etags [<file>]           	 create tags file for Emacs (defauilt: \"TAGS\")\n" ++
+ "   :sprint [<name> ...]        simplifed version of :print\n" ++
+ "   :step                       single-step after stopping at a breakpoint\n"++
+ "   :step <expr>                single-step into <expr>\n"++
  "   :type <expr>                show the type of <expr>\n" ++
- "   :kind <type>                show the kind of <type>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :unset <option> ...         unset options\n" ++
- "   :quit                       exit GHCi\n" ++
  "   :!<command>                 run the shell command <command>\n" ++
  "\n" ++
  " Options for ':set' and ':unset':\n" ++
@@ -189,77 +197,22 @@ helpText =
  "    +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"
-
-
-#if defined(GHCI) && defined(BREAKPOINT)
-globaliseAndTidy :: Id -> Id
-globaliseAndTidy id
--- Give the Id a Global Name, and tidy its type
-  = Id.setIdType (globaliseId VanillaGlobal id) tidy_type
-  where
-    tidy_type = tidyTopType (idType id)
-
-
-printScopeMsg :: Session -> String -> [Id] -> IO ()
-printScopeMsg session location ids
-    = GHC.getPrintUnqual session >>= \unqual ->
-      printForUser stdout unqual $
-        text "Local bindings in scope:" $$
-        nest 2 (pprWithCommas showId ids)
-    where showId id = ppr (idName id) <+> dcolon <+> ppr (idType id)
-
-jumpCondFunction :: Session -> Int -> [HValue] -> String -> Bool -> b -> b
-jumpCondFunction session ptr hValues location True b = b
-jumpCondFunction session ptr hValues location False b
-    = jumpFunction session ptr hValues location b
-
-jumpFunction :: Session -> Int -> [HValue] -> String -> b -> b
-jumpFunction session@(Session ref) (I# idsPtr) hValues location b
-    = unsafePerformIO $
-      do ids <- deRefStablePtr (castPtrToStablePtr (Ptr (int2Addr# idsPtr)))
-         let names = map idName ids
-         ASSERT (length names == length hValues) return ()
-         printScopeMsg session location ids
-         hsc_env <- readIORef ref
-
-         let ictxt = hsc_IC hsc_env
-             global_ids = map globaliseAndTidy ids
-             rn_env   = ic_rn_local_env ictxt
-             type_env = ic_type_env ictxt
-             bound_names = map idName global_ids
-             new_rn_env  = extendLocalRdrEnv rn_env bound_names
-		-- Remove any shadowed bindings from the type_env;
-		-- they are inaccessible but might, I suppose, cause 
-		-- a space leak if we leave them there
-             shadowed = [ n | name <- bound_names,
-                          let rdr_name = mkRdrUnqual (nameOccName name),
-                          Just n <- [lookupLocalRdrEnv rn_env rdr_name] ]
-             filtered_type_env = delListFromNameEnv type_env shadowed
-             new_type_env = extendTypeEnvWithIds filtered_type_env global_ids
-             new_ic = ictxt { ic_rn_local_env = new_rn_env, 
-		  	      ic_type_env     = new_type_env }
-         writeIORef ref (hsc_env { hsc_IC = new_ic })
-         is_tty <- hIsTerminalDevice stdin
-         withExtendedLinkEnv (zip names hValues) $
-           startGHCi (interactiveLoop is_tty True)
-                     GHCiState{ progname = "<interactive>",
-                                args = [],
-                                prompt = location++"> ",
-                                session = session,
-                                options = [] }
-         writeIORef ref hsc_env
-         putStrLn $ "Returning to normal execution..."
-         return b
+ "                         (eg. -v2, -fglasgow-exts, etc.)\n" ++
+ "\n" 
+-- Todo: add help for breakpoint commands here
+
+findEditor = do
+  getEnv "EDITOR" 
+    `IO.catch` \_ -> do
+#if mingw32_HOST_OS
+	win <- System.Win32.getWindowsDirectory
+	return (win `joinFileName` "notepad.exe")
+#else
+	return ""
 #endif
 
 interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
 interactiveUI session srcs maybe_expr = do
-#if defined(GHCI) && defined(BREAKPOINT)
-   initDynLinker =<< GHC.getSessionDynFlags session
-   extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session))
-                 ,(breakpointCondJumpName,unsafeCoerce# (jumpCondFunction session))]
-#endif
    -- 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
@@ -272,18 +225,23 @@ interactiveUI session srcs maybe_expr = do
    newStablePtr stdout
    newStablePtr stderr
 
-   hFlush stdout
-   hSetBuffering stdout NoBuffering
-
 	-- Initialise buffering for the *interpreted* I/O system
    initInterpBuffering session
 
+   when (isNothing maybe_expr) $ 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
+	hSetBuffering stdin NoBuffering
 
 	-- initial context is just the Prelude
-   GHC.setContext session [] [prelude_mod]
+   prel_mod <- GHC.findModule session prel_name (Just basePackageId)
+   GHC.setContext session [] [prel_mod]
 
 #ifdef USE_READLINE
    Readline.initialize
@@ -299,12 +257,21 @@ interactiveUI session srcs maybe_expr = do
    Readline.setCompleterWordBreakCharacters word_break_chars
 #endif
 
+   default_editor <- findEditor
+
    startGHCi (runGHCi srcs maybe_expr)
 	GHCiState{ progname = "<interactive>",
 		   args = [],
                    prompt = "%s> ",
+                   stop = "",
+		   editor = default_editor,
 		   session = session,
-		   options = [] }
+		   options = [],
+                   prelude = prel_mod,
+                   resume = [],
+                   breaks = emptyActiveBreakPoints,
+                   tickarrays = emptyModuleEnv
+                 }
 
 #ifdef USE_READLINE
    Readline.resetTerminal Nothing
@@ -312,6 +279,8 @@ interactiveUI session srcs maybe_expr = do
 
    return ()
 
+prel_name = GHC.mkModuleName "Prelude"
+
 runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi ()
 runGHCi paths maybe_expr = do
   let read_dot_files = not opt_IgnoreDotGhci
@@ -362,8 +331,8 @@ runGHCi paths maybe_expr = do
 
   case maybe_expr of
 	Nothing -> 
-#if defined(mingw32_HOST_OS)
           do
+#if defined(mingw32_HOST_OS)
             -- The win32 Console API mutates the first character of 
             -- type-ahead when reading from it in a non-buffered manner. Work
             -- around this by flushing the input buffer of type-ahead characters,
@@ -374,6 +343,9 @@ runGHCi paths maybe_expr = do
    		      | otherwise -> io (ioError err)
    	     Right () -> return ()
 #endif
+	    -- initialise the console if necessary
+	    io setUpConsole
+
 	    -- enter the interactive loop
 	    interactiveLoop is_tty show_prompt
 	Just expr -> do
@@ -444,7 +416,7 @@ fileLoop hdl show_prompt = do
    session <- getSession
    (mod,imports) <- io (GHC.getContext session)
    st <- getGHCiState
-   when show_prompt (io (putStr (mkPrompt mod imports (prompt st))))
+   when show_prompt (io (putStr (mkPrompt mod imports (resume st) (prompt st))))
    l <- io (IO.try (hGetLine hdl))
    case l of
 	Left e | isEOFError e		   -> return ()
@@ -469,7 +441,7 @@ stringLoop (s:ss) = do
 	l  -> do quit <- runCommand l
                  if quit then return True else stringLoop ss
 
-mkPrompt toplevs exports prompt
+mkPrompt toplevs exports resumes prompt
   = showSDoc $ f prompt
     where
         f ('%':'s':xs) = perc_s <> f xs
@@ -477,9 +449,18 @@ mkPrompt toplevs exports prompt
         f (x:xs) = char x <> f xs
         f [] = empty
     
-        perc_s = hsep (map (\m -> char '*' <> pprModule m) toplevs) <+>
-                 hsep (map pprModule exports)
-             
+        perc_s
+          | (span,_,_):rest <- resumes 
+          = (if not (null rest) then text "... " else empty)
+            <> brackets (ppr span) <+> modules_prompt
+          | otherwise
+          = modules_prompt
+
+        modules_prompt = 
+             hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
+             hsep (map (ppr . GHC.moduleName) exports)
+
+
 
 #ifdef USE_READLINE
 readlineLoop :: GHCi ()
@@ -489,7 +470,7 @@ readlineLoop = do
    io yield
    saveSession -- for use by completion
    st <- getGHCiState
-   l <- io (readline (mkPrompt mod imports (prompt st))
+   l <- io (readline (mkPrompt mod imports (resume st) (prompt st))
 	  	`finally` setNonBlockingFD 0)
 		-- readline sometimes puts stdin into blocking mode,
 		-- so we need to put it back for the IO library
@@ -519,7 +500,7 @@ runCommand c = ghciHandle handler (doCommand c)
 runCommandEval c = ghciHandle handleEval (doCommand c)
   where 
     handleEval (ExitException code) = io (exitWith code)
-    handleEval e                    = do showException e
+    handleEval e                    = do handler e
 				         io (exitWith (ExitFailure 1))
 
     doCommand (':' : command) = specialCommand command
@@ -528,60 +509,55 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
 	    case nms of 
 		Nothing -> io (exitWith (ExitFailure 1))
 		  -- failure to run the command causes exit(1) for ghc -e.
-		_       -> finishEvalExpr nms
-
--- This is the exception handler for exceptions generated by the
--- user's code; 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 :: Exception -> GHCi Bool
-handler exception = do
-  flushInterpBuffers
-  io installSignalHandlers
-  ghciHandle handler (showException exception >> return False)
-
-showException (DynException dyn) =
-  case fromDynamic dyn of
-    Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
-    Just Interrupted      -> io (putStrLn "Interrupted.")
-    Just (CmdLineError s) -> io (putStrLn s)	 -- omit the location for CmdLineError
-    Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
-    Just other_ghc_ex     -> io (print other_ghc_ex)
-
-showException other_exception
-  = io (putStrLn ("*** Exception: " ++ show other_exception))
+		_       -> do finishEvalExpr nms
+                              return True
 
-runStmt :: String -> GHCi (Maybe [Name])
+runStmt :: String -> GHCi (Maybe (Bool,[Name]))
 runStmt stmt
- | null (filter (not.isSpace) stmt) = return (Just [])
+ | null (filter (not.isSpace) stmt) = return (Just (False,[]))
  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
 	     	     GHC.runStmt session stmt
-      case result of
-	GHC.RunFailed      -> return Nothing
-	GHC.RunException e -> throw e  -- this is caught by runCommand(Eval)
-	GHC.RunOk names    -> return (Just names)
+      switchOnRunResult result
+
+switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
+switchOnRunResult GHC.RunFailed = return Nothing
+switchOnRunResult (GHC.RunException e) = throw e
+switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
+switchOnRunResult (GHC.RunBreak threadId names info resume) = do
+   session <- getSession
+   Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info) 
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let ticks      = GHC.modBreaks_locs modBreaks
+
+   -- display information about the breakpoint
+   let location = ticks ! GHC.breakInfo_number info
+   printForUser $ ptext SLIT("Stopped at") <+> ppr location
+
+   pushResume location threadId resume
+
+   -- run the command set with ":set stop <cmd>"
+   st <- getGHCiState
+   runCommand (stop st)
+
+   return (Just (True,names))
 
 -- possibly print the type and revert CAFs after evaluating an expression
 finishEvalExpr mb_names
- = do b <- isOptionSet ShowType
+ = do show_types <- isOptionSet ShowType
       session <- getSession
       case mb_names of
 	Nothing    -> return ()      
-	Just names -> when b (mapM_ (showTypeOfName session) names)
+	Just (is_break,names) -> 
+                when (is_break || show_types) $
+                      mapM_ (showTypeOfName session) names
 
       flushInterpBuffers
       io installSignalHandlers
       b <- isOptionSet RevertCAFs
       io (when b revertCAFs)
-      return True
 
 showTypeOfName :: Session -> Name -> GHCi ()
 showTypeOfName session n
@@ -590,12 +566,6 @@ showTypeOfName session n
 	  Nothing    -> return ()
 	  Just thing -> showTyThing thing
 
-showForUser :: SDoc -> GHCi String
-showForUser doc = do
-  session <- getSession
-  unqual <- io (GHC.getPrintUnqual session)
-  return $! showSDocForUser unqual doc
-
 specialCommand :: String -> GHCi Bool
 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
 specialCommand str = do
@@ -617,45 +587,6 @@ lookupCommand str = do
      		c:_ -> return (Just c)
 
 -----------------------------------------------------------------------------
--- To flush buffers for the *interpreted* computation we need
--- to refer to *its* stdout/stderr handles
-
-GLOBAL_VAR(flush_interp,       error "no flush_interp", IO ())
-GLOBAL_VAR(turn_off_buffering, error "no flush_stdout", IO ())
-
-no_buf_cmd = "System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering" ++
-	     " Prelude.>> System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering"
-flush_cmd  = "System.IO.hFlush System.IO.stdout Prelude.>> System.IO.hFlush IO.stderr"
-
-initInterpBuffering :: Session -> IO ()
-initInterpBuffering session
- = do maybe_hval <- GHC.compileExpr session no_buf_cmd
-	
-      case maybe_hval of
-	Just hval -> writeIORef turn_off_buffering (unsafeCoerce# hval :: IO ())
-	other	  -> panic "interactiveUI:setBuffering"
-	
-      maybe_hval <- GHC.compileExpr session flush_cmd
-      case maybe_hval of
-	Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ())
-	_         -> panic "interactiveUI:flush"
-
-      turnOffBuffering	-- Turn it off right now
-
-      return ()
-
-
-flushInterpBuffers :: GHCi ()
-flushInterpBuffers
- = io $ do Monad.join (readIORef flush_interp)
-           return ()
-
-turnOffBuffering :: IO ()
-turnOffBuffering
- = do Monad.join (readIORef turn_off_buffering)
-      return ()
-
------------------------------------------------------------------------------
 -- Commands
 
 help :: String -> GHCi ()
@@ -684,7 +615,8 @@ info s  = do { let names = words s
 filterOutChildren :: [Name] -> [Name]
 filterOutChildren names = filter (not . parent_is_there) names
  where parent_is_there n 
-	 | Just p <- GHC.nameParent_maybe n = p `elem` names
+--	 | Just p <- GHC.nameParent_maybe n = p `elem` names
+-- ToDo!!
 	 | otherwise		           = False
 
 pprInfo exts (thing, fixity, insts)
@@ -696,9 +628,6 @@ pprInfo exts (thing, fixity, insts)
 	| fix == GHC.defaultFixity = empty
 	| otherwise		   = ppr fix <+> ppr (GHC.getName thing)
 
------------------------------------------------------------------------------
--- Commands
-
 runMain :: String -> GHCi ()
 runMain args = do
   let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))
@@ -728,6 +657,27 @@ changeDirectory dir = do
   dir <- expandPath dir
   io (setCurrentDirectory dir)
 
+editFile :: String -> GHCi ()
+editFile str
+  | null str  = do
+	-- find the name of the "topmost" file loaded
+     session <- getSession
+     graph0 <- io (GHC.getModuleGraph session)
+     graph1 <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph0
+     let graph2 = flattenSCCs (GHC.topSortModuleGraph True graph1 Nothing)
+     case GHC.ml_hs_file (GHC.ms_location (last graph2)) of
+	Just file -> do_edit file
+	Nothing   -> throwDyn (CmdLineError "unknown file name")
+  | otherwise = do_edit str
+  where
+	do_edit file = do
+	   st <- getGHCiState
+	   let cmd = editor st
+	   when (null cmd) $ 
+		throwDyn (CmdLineError "editor not set, use :set editor")
+	   io $ system (cmd ++ ' ':file)
+           return ()
+
 defineMacro :: String -> GHCi ()
 defineMacro s = do
   let (macro_name, definition) = break isSpace s
@@ -803,16 +753,16 @@ loadModule' files = do
 
 checkModule :: String -> GHCi ()
 checkModule m = do
-  let modl = GHC.mkModule m
+  let modl = GHC.mkModuleName m
   session <- getSession
   result <- io (GHC.checkModule session modl)
   case result of
     Nothing -> io $ putStrLn "Nothing"
     Just r  -> io $ putStrLn (showSDoc (
-	case checkedModuleInfo r of
+	case GHC.checkedModuleInfo r of
 	   Just cm | Just scope <- GHC.modInfoTopLevelScope cm -> 
 		let
-		    (local,global) = partition ((== modl) . GHC.nameModule) scope
+		    (local,global) = partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
 		in
 			(text "global names: " <+> ppr global) $$
 		        (text "local  names: " <+> ppr local)
@@ -828,22 +778,22 @@ reloadModule "" = do
 reloadModule m = do
   io (revertCAFs)		-- always revert CAFs on reload.
   session <- getSession
-  ok <- io (GHC.load session (LoadUpTo (GHC.mkModule m)))
+  ok <- io (GHC.load session (LoadUpTo (GHC.mkModuleName m)))
   afterLoad ok session
 
 afterLoad ok session = do
   io (revertCAFs)  -- always revert CAFs on load.
+  discardResumeContext
+  discardTickArrays
+  discardActiveBreakPoints
   graph <- io (GHC.getModuleGraph session)
-  graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod) graph
+  graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
   setContextAfterLoad session graph'
-  modulesLoadedMsg ok (map GHC.ms_mod graph')
-#if defined(GHCI) && defined(BREAKPOINT)
-  io (extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session))
-                    ,(breakpointCondJumpName,unsafeCoerce# (jumpCondFunction session))])
-#endif
+  modulesLoadedMsg ok (map GHC.ms_mod_name graph')
 
 setContextAfterLoad session [] = do
-  io (GHC.setContext session [] [prelude_mod])
+  prel_mod <- getPrelude
+  io (GHC.setContext session [] [prel_mod])
 setContextAfterLoad session ms = do
   -- load a target if one is available, otherwise load the topmost module.
   targets <- io (GHC.getTargets session)
@@ -860,7 +810,7 @@ setContextAfterLoad session ms = do
 	(m:_) -> Just m
 
    summary `matches` Target (TargetModule m) _
-	= GHC.ms_mod summary == m
+	= GHC.ms_mod_name summary == m
    summary `matches` Target (TargetFile f _) _ 
 	| Just f' <- GHC.ml_hs_file (GHC.ms_location summary)	= f == f'
    summary `matches` target
@@ -869,17 +819,19 @@ setContextAfterLoad session ms = do
    load_this summary | m <- GHC.ms_mod summary = do
 	b <- io (GHC.moduleIsInterpreted session m)
 	if b then io (GHC.setContext session [m] []) 
-       	     else io (GHC.setContext session []  [prelude_mod,m])
+       	     else do
+                   prel_mod <- getPrelude
+                   io (GHC.setContext session []  [prel_mod,m])
 
 
-modulesLoadedMsg :: SuccessFlag -> [Module] -> GHCi ()
+modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> GHCi ()
 modulesLoadedMsg ok mods = do
   dflags <- getDynFlags
   when (verbosity dflags > 0) $ do
    let mod_commas 
 	| null mods = text "none."
 	| otherwise = hsep (
-	    punctuate comma (map pprModule mods)) <> text "."
+	    punctuate comma (map ppr mods)) <> text "."
    case ok of
     Failed ->
        io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
@@ -894,8 +846,7 @@ typeOfExpr str
        case maybe_ty of
 	  Nothing -> return ()
 	  Just ty -> do ty' <- cleanType ty
-			tystr <- showForUser (ppr ty')
-		        io (putStrLn (str ++ " :: " ++ tystr))
+                        printForUser $ text str <> text " :: " <> ppr ty'
 
 kindOfType :: String -> GHCi ()
 kindOfType str 
@@ -903,9 +854,8 @@ kindOfType str
        maybe_ty <- io (GHC.typeKind cms str)
        case maybe_ty of
 	  Nothing    -> return ()
-	  Just ty    -> do tystr <- showForUser (ppr ty)
-		           io (putStrLn (str ++ " :: " ++ tystr))
-
+	  Just ty    -> printForUser $ text str <> text " :: " <> ppr ty
+          
 quit :: String -> GHCi Bool
 quit _ = return True
 
@@ -913,117 +863,6 @@ shellEscape :: String -> GHCi Bool
 shellEscape str = io (system str >> return False)
 
 -----------------------------------------------------------------------------
--- 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
-  session <- getSession
-  io $ createTagsFile session 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 :: Session -> TagsKind -> FilePath -> IO ()
-createTagsFile session tagskind tagFile = do
-  graph <- GHC.getModuleGraph session
-  let ms = map GHC.ms_mod graph
-      tagModule m = do 
-        is_interpreted <- GHC.moduleIsInterpreted session m
-        -- should we just skip these?
-        when (not is_interpreted) $
-          throwDyn (CmdLineError ("module '" ++ moduleString m ++ "' is not interpreted"))
-
-        mbModInfo <- GHC.getModuleInfo session m
-        let unqual 
-	      | Just modinfo <- mbModInfo,
-		Just unqual <- GHC.modInfoPrintUnqualified modinfo = unqual
-	      | otherwise = GHC.alwaysQualify
-
-        case mbModInfo of 
-          Just modInfo -> return $! listTags unqual modInfo 
-          _            -> return []
-
-  mtags <- mapM tagModule ms
-  either_res <- collateAndWriteTags tagskind tagFile $ concat mtags
-  case either_res of
-    Left e  -> hPutStrLn stderr $ ioeGetErrorString e
-    Right _ -> return ()
-
-listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
-listTags unqual modInfo =
-	   [ tagInfo unqual name loc 
-           | name <- GHC.modInfoExports modInfo
-           , let loc = nameSrcLoc 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 group@[] = throwDyn (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 (line:lines) | lNo>count =
-      perFile (tagInfo:tags) (count+1) (pos+length line) lines
-    perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count =
-      showETag tagInfo line pos : perFile tags count pos lines
-    perFile tags count pos lines = []
-
--- 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
-
------------------------------------------------------------------------------
 -- Browsing a module's contents
 
 browseCmd :: String -> GHCi ()
@@ -1035,16 +874,14 @@ browseCmd m =
 
 browseModule m exports_only = do
   s <- getSession
-
-  let modl = GHC.mkModule m
-  is_interpreted <- io (GHC.moduleIsInterpreted s modl)
-  when (not is_interpreted && not exports_only) $
-	throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted"))
+  modl <- if exports_only then lookupModule s m
+                          else wantInterpretedModule s m
 
   -- Temporarily set the context to the module we're interested in,
   -- just so we can get an appropriate PrintUnqualified
   (as,bs) <- io (GHC.getContext s)
-  io (if exports_only then GHC.setContext s [] [prelude_mod,modl]
+  prel_mod <- getPrelude
+  io (if exports_only then GHC.setContext s [] [prel_mod,modl]
 		      else GHC.setContext s [modl] [])
   unqual <- io (GHC.getPrintUnqual s)
   io (GHC.setContext s as bs)
@@ -1085,47 +922,53 @@ setContext str
     sensible ('*':m) = looksLikeModuleName m
     sensible m       = looksLikeModuleName m
 
-newContext mods = do
-  session <- getSession
-  (as,bs) <- separate session mods [] []
-  let bs' = if null as && prelude_mod `notElem` bs then prelude_mod:bs else bs
-  io (GHC.setContext session as bs')
-
-separate :: Session -> [String] -> [Module] -> [Module]
-  -> GHCi ([Module],[Module])
+separate :: Session -> [String] -> [Module] -> [Module] 
+        -> GHCi ([Module],[Module])
 separate session []           as bs = return (as,bs)
-separate session (('*':m):ms) as bs = do
-   let modl = GHC.mkModule m
-   b <- io (GHC.moduleIsInterpreted session modl)
-   if b then separate session ms (modl:as) bs
-   	else throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted"))
-separate session (m:ms)       as bs = separate session ms as (GHC.mkModule m:bs)
-
-prelude_mod = GHC.mkModule "Prelude"
+separate session (('*':str):ms) as bs = do
+   m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
+   b <- io $ GHC.moduleIsInterpreted session m
+   if b then separate session ms (m:as) bs
+   	else throwDyn (CmdLineError ("module '"
+                        ++ GHC.moduleNameString (GHC.moduleName m)
+                        ++ "' is not interpreted"))
+separate session (str:ms) as bs = do
+  m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
+  separate session ms as (m:bs)
+
+newContext :: [String] -> GHCi ()
+newContext strs = do
+  s <- getSession
+  (as,bs) <- separate s strs [] []
+  prel_mod <- getPrelude
+  let bs' = if null as && prel_mod `notElem` bs then prel_mod:bs else bs
+  io $ GHC.setContext s as bs'
 
 
-addToContext mods = do
-  cms <- getSession
-  (as,bs) <- io (GHC.getContext cms)
+addToContext :: [String] -> GHCi ()
+addToContext strs = do
+  s <- getSession
+  (as,bs) <- io $ GHC.getContext s
 
-  (as',bs') <- separate cms mods [] []
+  (new_as,new_bs) <- separate s strs [] []
 
-  let as_to_add = as' \\ (as ++ bs)
-      bs_to_add = bs' \\ (as ++ bs)
+  let as_to_add = new_as \\ (as ++ bs)
+      bs_to_add = new_bs \\ (as ++ bs)
 
-  io (GHC.setContext cms (as ++ as_to_add) (bs ++ bs_to_add))
+  io $ GHC.setContext s (as ++ as_to_add) (bs ++ bs_to_add)
 
 
-removeFromContext mods = do
-  cms <- getSession
-  (as,bs) <- io (GHC.getContext cms)
+removeFromContext :: [String] -> GHCi ()
+removeFromContext strs = do
+  s <- getSession
+  (as,bs) <- io $ GHC.getContext s
 
-  (as_to_remove,bs_to_remove) <- separate cms mods [] []
+  (as_to_remove,bs_to_remove) <- separate s strs [] []
 
   let as' = as \\ (as_to_remove ++ bs_to_remove)
       bs' = bs \\ (as_to_remove ++ bs_to_remove)
 
-  io (GHC.setContext cms as' bs')
+  io $ GHC.setContext s as' bs'
 
 ----------------------------------------------------------------------------
 -- Code for `:set'
@@ -1148,11 +991,14 @@ setCmd ""
    		   else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
    	   ))
 setCmd str
-  = case words str of
+  = case toArgs str of
 	("args":args) -> setArgs args
 	("prog":prog) -> setProg prog
-        ("prompt":prompt) -> setPrompt (dropWhile isSpace $ drop 6 $ dropWhile isSpace str)
+        ("prompt":prompt) -> setPrompt (after 6)
+        ("editor":cmd) -> setEditor (after 6)
+        ("stop":cmd) -> setStop (after 4)
 	wds -> setOptions wds
+   where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str
 
 setArgs args = do
   st <- getGHCiState
@@ -1164,6 +1010,14 @@ setProg [prog] = do
 setProg _ = do
   io (hPutStrLn stderr "syntax: :set prog <progname>")
 
+setEditor cmd = do
+  st <- getGHCiState
+  setGHCiState st{ editor = cmd }
+
+setStop cmd = do
+  st <- getGHCiState
+  setGHCiState st{ stop = cmd }
+
 setPrompt value = do
   st <- getGHCiState
   if null value
@@ -1180,21 +1034,28 @@ setOptions wds =
 
       -- then, dynamic flags
       dflags <- getDynFlags
+      let pkg_flags = packageFlags dflags
       (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
-      setDynFlags dflags'
-
-        -- update things if the users wants more packages
-{- TODO:
-        let new_packages = pkgs_after \\ pkgs_before
-        when (not (null new_packages)) $
-  	   newPackages new_packages
--}
 
       if (not (null leftovers))
 		then throwDyn (CmdLineError ("unrecognised flags: " ++ 
 						unwords 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, ressetting and loading new packages..."
+        session <- getSession
+        io (GHC.setTargets session [])
+        io (GHC.load session LoadAllTargets)
+        io (linkPackages dflags new_pkgs)
+        setContextAfterLoad session []
+      return ()
+
 
 unsetOptions :: String -> GHCi ()
 unsetOptions str
@@ -1241,16 +1102,6 @@ optToStr ShowTiming = "s"
 optToStr ShowType   = "t"
 optToStr RevertCAFs = "r"
 
-{- ToDo
-newPackages new_pkgs = do	-- The new packages are already in v_Packages
-  session <- getSession
-  io (GHC.setTargets session [])
-  io (GHC.load session Nothing)
-  dflags   <- getDynFlags
-  io (linkPackages dflags new_pkgs)
-  setContextAfterLoad []
--}
-
 -- ---------------------------------------------------------------------------
 -- code for `:show'
 
@@ -1259,7 +1110,9 @@ showCmd str =
 	["modules" ] -> showModules
 	["bindings"] -> showBindings
 	["linker"]   -> io showLinkerState
-	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
+        ["breaks"] -> showBkptTable
+        ["context"] -> showContext
+	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings|breaks]")
 
 showModules = do
   session <- getSession
@@ -1277,8 +1130,7 @@ showBindings = do
 
 showTyThing (AnId id) = do 
   ty' <- cleanType (GHC.idType id)
-  str <- showForUser (ppr id <> text " :: " <> ppr ty')
-  io (putStrLn str)
+  printForUser $ ppr id <> text " :: " <> ppr ty'
 showTyThing _  = return ()
 
 -- if -fglasgow-exts is on we show the foralls, otherwise we don't.
@@ -1289,6 +1141,18 @@ cleanType ty = do
 	then return ty
 	else return $! GHC.dropForAlls ty
 
+showBkptTable :: GHCi ()
+showBkptTable = do
+   activeBreaks <- getActiveBreakPoints 
+   printForUser $ ppr activeBreaks 
+
+showContext :: GHCi ()
+showContext = do
+   st <- getGHCiState
+   printForUser $ vcat (map pp_resume (resume st))
+  where
+   pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span
+
 -- -----------------------------------------------------------------------------
 -- Completion
 
@@ -1353,7 +1217,7 @@ completeModule w = do
 completeHomeModule w = do
   s <- restoreSession
   g <- GHC.getModuleGraph s
-  let home_mods = map GHC.ms_mod g
+  let home_mods = map GHC.ms_mod_name g
   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods))
 
 completeSetOptions w = do
@@ -1383,15 +1247,15 @@ wrapCompleter fun w =  do
 getCommonPrefix :: [String] -> String
 getCommonPrefix [] = ""
 getCommonPrefix (s:ss) = foldl common s ss
-  where common s "" = s
+  where common s "" = ""
 	common "" s = ""
 	common (c:cs) (d:ds)
 	   | c == d = c : common cs ds
 	   | otherwise = ""
 
-allExposedModules :: DynFlags -> [Module]
+allExposedModules :: DynFlags -> [ModuleName]
 allExposedModules dflags 
- = map GHC.mkModule (concat (map exposedModules (filter exposed (eltsUFM pkg_db))))
+ = map GHC.mkModuleName (concat (map exposedModules (filter exposed (eltsUFM pkg_db))))
  where
   pkg_db = pkgIdMap (pkgState dflags)
 #else
@@ -1403,75 +1267,39 @@ completeHomeModule = completeNone
 completeSetOptions = completeNone
 completeFilename   = completeNone
 completeHomeModuleOrFile=completeNone
+completeBkpt       = completeNone
 #endif
 
------------------------------------------------------------------------------
--- GHCi monad
-
-data GHCiState = GHCiState
-     { 
-	progname       :: String,
-	args	       :: [String],
-        prompt         :: String,
-	session        :: GHC.Session,
-	options        :: [GHCiOption]
-     }
-
-data GHCiOption 
-	= ShowTiming		-- show time/allocs after evaluation
-	| ShowType		-- show the type of expressions
-	| RevertCAFs		-- revert CAFs after every evaluation
-	deriving Eq
-
-newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a }
-
-startGHCi :: GHCi a -> GHCiState -> IO a
-startGHCi g state = do ref <- newIORef state; unGHCi g ref
-
-instance Monad GHCi where
-  (GHCi m) >>= k  =  GHCi $ \s -> m s >>= \a -> unGHCi (k a) s
-  return a  = GHCi $ \s -> return a
-
-ghciHandleDyn :: Typeable t => (t -> GHCi a) -> GHCi a -> GHCi a
-ghciHandleDyn h (GHCi m) = GHCi $ \s -> 
-   Exception.catchDyn (m s) (\e -> unGHCi (h e) s)
-
-getGHCiState   = GHCi $ \r -> readIORef r
-setGHCiState s = GHCi $ \r -> writeIORef r s
-
--- for convenience...
-getSession = getGHCiState >>= return . session
-
-GLOBAL_VAR(saved_sess, no_saved_sess, Session)
-no_saved_sess = error "no saved_ses"
-saveSession = getSession >>= io . writeIORef saved_sess
-splatSavedSession = io (writeIORef saved_sess no_saved_sess)
-restoreSession = readIORef saved_sess
-
-getDynFlags = do
-  s <- getSession
-  io (GHC.getSessionDynFlags s)
-setDynFlags dflags = do 
-  s <- getSession 
-  io (GHC.setSessionDynFlags s dflags)
+-- ---------------------------------------------------------------------------
+-- User code exception handling
 
-isOptionSet :: GHCiOption -> GHCi Bool
-isOptionSet opt
- = do st <- getGHCiState
-      return (opt `elem` options st)
+-- 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 :: Exception -> GHCi Bool
 
-setOption :: GHCiOption -> GHCi ()
-setOption opt
- = do st <- getGHCiState
-      setGHCiState (st{ options = opt : filter (/= opt) (options st) })
+handler exception = do
+  flushInterpBuffers
+  io installSignalHandlers
+  ghciHandle handler (showException exception >> return False)
 
-unsetOption :: GHCiOption -> GHCi ()
-unsetOption opt
- = do st <- getGHCiState
-      setGHCiState (st{ options = filter (/= opt) (options st) })
+showException (DynException dyn) =
+  case fromDynamic dyn of
+    Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
+    Just Interrupted      -> io (putStrLn "Interrupted.")
+    Just (CmdLineError s) -> io (putStrLn s)	 -- omit the location for CmdLineError
+    Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
+    Just other_ghc_ex     -> io (print other_ghc_ex)
 
-io :: IO a -> GHCi a
-io m = GHCi { unGHCi = \s -> m >>= return }
+showException other_exception
+  = io (putStrLn ("*** Exception: " ++ show other_exception))
 
 -----------------------------------------------------------------------------
 -- recursive exception handlers
@@ -1488,48 +1316,8 @@ ghciHandle h (GHCi m) = GHCi $ \s ->
 ghciUnblock :: GHCi a -> GHCi a
 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
 
------------------------------------------------------------------------------
--- timing & statistics
-
-timeIt :: GHCi a -> GHCi a
-timeIt action
-  = do b <- isOptionSet ShowTiming
-       if not b 
-	  then action 
-	  else do allocs1 <- io $ getAllocations
-		  time1   <- io $ getCPUTime
-		  a <- action
-		  allocs2 <- io $ getAllocations
-		  time2   <- io $ getCPUTime
-		  io $ 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)) :: Float
-	    secs_str = showFFloat (Just 2) secs
-	putStrLn (showSDoc (
-		 parens (text (secs_str "") <+> text "secs" <> comma <+> 
-			 text (show allocs) <+> text "bytes")))
-
------------------------------------------------------------------------------
--- reverting CAFs
-	
-revertCAFs :: IO ()
-revertCAFs = do
-  rts_revertCAFs
-  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
 
--- -----------------------------------------------------------------------------
+-- ----------------------------------------------------------------------------
 -- Utils
 
 expandPath :: String -> GHCi String
@@ -1540,3 +1328,346 @@ expandPath path =
 	return (tilde ++ '/':d)
    other -> 
 	return other
+
+-- ----------------------------------------------------------------------------
+-- Windows console setup
+
+setUpConsole :: IO ()
+setUpConsole = do
+#ifdef mingw32_HOST_OS
+	-- On Windows we need to set a known code page, otherwise the characters
+  	-- we read from the console will be be in some strange encoding, and
+	-- similarly for characters we write to the console.
+	--
+	-- At the moment, GHCi pretends all input is Latin-1.  In the
+	-- future we should support UTF-8, but for now we set the code pages
+	-- to Latin-1.
+	--
+	-- It seems you have to set the font in the console window to
+	-- a Unicode font in order for output to work properly,
+	-- otherwise non-ASCII characters are mapped wrongly.  sigh.
+	-- (see MSDN for SetConsoleOutputCP()).
+	--
+	setConsoleCP 28591       -- ISO Latin-1
+	setConsoleOutputCP 28591 -- ISO Latin-1
+#endif
+	return ()
+
+-- -----------------------------------------------------------------------------
+-- commands for debugger
+
+sprintCmd = pprintCommand False False
+printCmd  = pprintCommand True False
+forceCmd  = pprintCommand False True
+
+pprintCommand bind force str = do
+  session <- getSession
+  io $ pprintClosureCommand session bind force str
+
+foreign import ccall "rts_setStepFlag" setStepFlag :: IO () 
+
+stepCmd :: String -> GHCi Bool
+stepCmd [] = doContinue setStepFlag 
+stepCmd expression = do
+   io $ setStepFlag
+   runCommand expression
+
+continueCmd :: String -> GHCi Bool
+continueCmd [] = doContinue $ return () 
+continueCmd other = do
+   io $ putStrLn "The continue command accepts no arguments."
+   return False
+
+doContinue :: IO () -> GHCi Bool
+doContinue actionBeforeCont = do 
+   resumeAction <- popResume
+   case resumeAction of
+      Nothing -> do 
+         io $ putStrLn "There is no computation running."
+         return False
+      Just (_,_,handle) -> do
+         io $ actionBeforeCont
+         session <- getSession
+         runResult <- io $ GHC.resume session handle
+         names <- switchOnRunResult runResult
+         finishEvalExpr names
+         return False
+
+abandonCmd :: String -> GHCi ()
+abandonCmd "" = do
+   mb_res <- popResume
+   case mb_res of
+      Nothing -> do 
+         io $ putStrLn "There is no computation running."
+      Just (span,_,_) ->
+         return ()
+         -- the prompt will change to indicate the new context
+
+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 ()
+
+-- handle the "break" command
+breakCmd :: String -> GHCi ()
+breakCmd argLine = do
+   session <- getSession
+   breakSwitch session $ words argLine
+
+breakSwitch :: Session -> [String] -> GHCi ()
+breakSwitch _session [] = do
+   io $ putStrLn "The break command requires at least one argument."
+breakSwitch session args@(arg1:rest) 
+   | looksLikeModuleName arg1 = do
+        mod <- wantInterpretedModule session arg1
+        breakByModule session mod rest
+   | all isDigit arg1 = do
+        (toplevel, _) <- io $ GHC.getContext session 
+        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 -- assume it's a name
+        names <- io $ GHC.parseName session arg1
+        case names of
+          []    -> return ()
+          (n:_) -> do
+            let loc  = GHC.nameSrcLoc n
+                modl = GHC.nameModule n
+            is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+            if not is_interpreted
+               then noCanDo $ text "module " <> ppr modl <>
+                              text " is not interpreted"
+               else do
+            if GHC.isGoodSrcLoc loc
+               then findBreakAndSet (GHC.nameModule n) $ 
+                         findBreakByCoord (GHC.srcLocLine loc, 
+                                           GHC.srcLocCol loc)
+               else noCanDo $ text "can't find its location: " <>
+                              ppr loc
+           where
+             noCanDo why = printForUser $
+                text "cannot set breakpoint on " <> ppr n <> text ": " <> why
+
+
+wantInterpretedModule :: Session -> String -> GHCi Module
+wantInterpretedModule session str = do
+   modl <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
+   is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+   when (not is_interpreted) $
+       throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
+   return modl
+
+breakByModule :: Session -> Module -> [String] -> GHCi () 
+breakByModule session mod args@(arg1:rest)
+   | all isDigit arg1 = do  -- looks like a line number
+        breakByModuleLine mod (read arg1) rest
+   | otherwise = io $ putStrLn "Invalid arguments to :break"
+
+breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
+breakByModuleLine mod line args
+   | [] <- args = findBreakAndSet mod $ findBreakByLine line
+   | [col] <- args, all isDigit col =
+        findBreakAndSet mod $ findBreakByCoord (line, read col)
+   | otherwise = io $ putStrLn "Invalid arguments to :break"
+
+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 
+         session <- getSession
+         if success 
+            then do
+               (alreadySet, nm) <- 
+                     recordBreak $ BreakLocation
+                             { breakModule = mod
+                             , breakLoc = span
+                             , breakTick = tick
+                             }
+               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  complete)   `mplus`
+    listToMaybe (sortBy leftmost_smallest incomplete) `mplus`
+    listToMaybe (sortBy rightmost ticks)
+  where 
+        ticks = arr ! line
+
+        starts_here = [ tick | tick@(nm,span) <- ticks,
+                               GHC.srcSpanStartLine span == line ]
+
+        (complete,incomplete) = partition ends_here starts_here
+            where ends_here (nm,span) = GHC.srcSpanEndLine span == line
+
+findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan)
+findBreakByCoord (line, col) arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    listToMaybe (sortBy rightmost contains)
+  where 
+        ticks = arr ! line
+
+        -- the ticks that span this coordinate
+        contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col) ]
+
+leftmost_smallest  (_,a) (_,b) = a `compare` b
+leftmost_largest   (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)
+                                `thenCmp`
+                                 (GHC.srcSpanEnd b `compare` GHC.srcSpanEnd a)
+rightmost (_,a) (_,b) = b `compare` a
+
+spans :: SrcSpan -> (Int,Int) -> Bool
+spans span (l,c) = GHC.srcSpanStart span <= loc && loc <= GHC.srcSpanEnd span
+   where loc = GHC.mkSrcLoc (GHC.srcSpanFile span) l c
+
+start_bold = BS.pack "\ESC[1m"
+end_bold   = BS.pack "\ESC[0m"
+
+listCmd :: String -> GHCi ()
+listCmd str = do
+   st <- getGHCiState
+   case resume st of
+      []  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
+      (span,_,_):_ -> io $ listAround span True
+
+-- | 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.
+listAround span do_highlight = do
+      contents <- 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   = these_lines
+
+          bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
+          prefixed = zipWith BS.append bs_line_nos highlighted
+      --
+      BS.putStrLn (BS.join (BS.pack "\n") prefixed)
+  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 no line
+          | no == line1 && no == line2
+          = let (a,r) = BS.splitAt col1 line
+                (b,c) = BS.splitAt (col2-col1) r
+            in
+            BS.concat [a,start_bold,b,end_bold,c]
+          | no == line1
+          = let (a,b) = BS.splitAt col1 line in
+            BS.concat [a, start_bold, b]
+          | no == line2
+          = let (a,b) = BS.splitAt col2 line in
+            BS.concat [a, end_bold, b]
+          | otherwise   = line
+
+-- --------------------------------------------------------------------------
+-- 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 = maximum (map GHC.srcSpanEndLine (map snd ticks))
+        srcSpanLines span = [ GHC.srcSpanStartLine span .. 
+                              GHC.srcSpanEndLine span ]
+
+getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
+getModBreak mod = do
+   session <- getSession
+   Just mod_info <- io $ GHC.getModuleInfo session mod
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let array      = GHC.modBreaks_flags modBreaks
+   let ticks      = GHC.modBreaks_locs  modBreaks
+   return (array, ticks)
+
+lookupModule :: Session -> String -> GHCi Module
+lookupModule session modName
+   = io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
+
+setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool 
+setBreakFlag toggle array index
+   | toggle    = GHC.setBreakOn array index 
+   | otherwise = GHC.setBreakOff array index
+
+
+{- these should probably go to the GHC API at some point -}
+enableBreakPoint  :: Session -> Module -> Int -> IO ()
+enableBreakPoint session mod index = return ()
+
+disableBreakPoint :: Session -> Module -> Int -> IO ()
+disableBreakPoint session mod index = return ()
+
+activeBreakPoints :: Session -> IO [(Module,Int)]
+activeBreakPoints session = return []
+
+enableSingleStep  :: Session -> IO ()
+enableSingleStep session = return ()
+
+disableSingleStep :: Session -> IO ()
+disableSingleStep session = return ()