[project @ 2003-02-24 12:39:24 by simonpj]
[ghc-hetmet.git] / ghc / compiler / ghci / InteractiveUI.hs
index 87b19ea..b8f75de 100644 (file)
@@ -1,76 +1,80 @@
-{-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
+{-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.120 2002/04/18 11:27:59 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.148 2003/02/24 12:39:26 simonpj Exp $
 --
 -- GHC Interactive User Interface
 --
 -- (c) The GHC Team 2000
 --
 -----------------------------------------------------------------------------
 --
 -- GHC Interactive User Interface
 --
 -- (c) The GHC Team 2000
 --
 -----------------------------------------------------------------------------
-module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
+module InteractiveUI ( 
+       interactiveUI,  -- :: CmState -> [FilePath] -> [LibrarySpec] -> IO ()
+       ghciWelcomeMsg
+   ) where
 
 #include "../includes/config.h"
 #include "HsVersions.h"
 
 
 #include "../includes/config.h"
 #include "HsVersions.h"
 
-import Packages
-
 import CompManager
 import CompManager
-import CmTypes         ( Linkable, isObjectLinkable, ModSummary(..) )
-import CmLink          ( findModuleLinkable_maybe )
-
-import HscTypes                ( TyThing(..), showModMsg, InteractiveContext(..) )
+import HscTypes                ( TyThing(..), HomeModInfo(hm_linkable), HomePackageTable,
+                         isObjectLinkable )
 import HsSyn           ( TyClDecl(..), ConDecl(..), Sig(..) )
 import MkIface         ( ifaceTyThing )
 import DriverFlags
 import DriverState
 import HsSyn           ( TyClDecl(..), ConDecl(..), Sig(..) )
 import MkIface         ( ifaceTyThing )
 import DriverFlags
 import DriverState
-import DriverUtil      ( handle, remove_spaces )
-import Linker
-import Finder          ( flushPackageCache )
+import DriverUtil      ( remove_spaces, handle )
+import Linker          ( initLinker, showLinkerState, linkLibraries, 
+                         linkPackages )
 import Util
 import Util
-import Id              ( isRecordSelector, recordSelectorFieldLabel, 
-                         isDataConWrapId, isDataConId, idName )
+import IdInfo          ( GlobalIdDetails(..) )
+import Id              ( isImplicitId, idName, globalIdDetails )
 import Class           ( className )
 import TyCon           ( tyConName, tyConClass_maybe, isPrimTyCon, DataConDetails(..) )
 import Class           ( className )
 import TyCon           ( tyConName, tyConClass_maybe, isPrimTyCon, DataConDetails(..) )
+import DataCon         ( dataConName )
 import FieldLabel      ( fieldLabelTyCon )
 import SrcLoc          ( isGoodSrcLoc )
 import FieldLabel      ( fieldLabelTyCon )
 import SrcLoc          ( isGoodSrcLoc )
-import Module          ( moduleName )
-import NameEnv         ( nameEnvElts )
+import Module          ( showModMsg, lookupModuleEnv )
 import Name            ( Name, isHomePackageName, nameSrcLoc, nameOccName,
                          NamedThing(..) )
 import OccName         ( isSymOcc )
 import Name            ( Name, isHomePackageName, nameSrcLoc, nameOccName,
                          NamedThing(..) )
 import OccName         ( isSymOcc )
-import BasicTypes      ( defaultFixity )
+import BasicTypes      ( defaultFixity, SuccessFlag(..) )
+import Packages
 import Outputable
 import CmdLineOpts     ( DynFlag(..), DynFlags(..), getDynFlags, saveDynFlags,
                          restoreDynFlags, dopt_unset )
 import Outputable
 import CmdLineOpts     ( DynFlag(..), DynFlags(..), getDynFlags, saveDynFlags,
                          restoreDynFlags, dopt_unset )
-import Panic           ( GhcException(..), showGhcException )
+import Panic           hiding ( showException )
 import Config
 
 import Config
 
-#ifndef mingw32_TARGET_OS
-import Posix
+#ifndef mingw32_HOST_OS
+import System.Posix
 #endif
 
 #endif
 
-import Exception
-import Dynamic
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
-import Readline 
+import Control.Concurrent      ( yield )       -- Used in readline loop
+import System.Console.Readline as Readline
 #endif
 #endif
-import Concurrent
-import IOExts
-import SystemExts
+
+--import SystemExts
+
+import Control.Exception as Exception
+import Data.Dynamic
+import Control.Concurrent
 
 import Numeric
 
 import Numeric
-import List
-import System
-import CPUTime
-import Directory
-import IO
-import Char
-import Monad
+import Data.List
+import System.Cmd
+import System.CPUTime
+import System.Environment
+import System.Directory
+import System.IO as IO
+import Data.Char
+import Control.Monad as Monad
 
 
-import GlaExts         ( unsafeCoerce# )
+import GHC.Exts                ( unsafeCoerce# )
 
 
-import Foreign         ( nullPtr )
-import CString         ( peekCString )
+import Data.IORef      ( IORef, newIORef, readIORef, writeIORef )
+
+import GHC.Posix       ( setNonBlockingFD )
 
 -----------------------------------------------------------------------------
 
 
 -----------------------------------------------------------------------------
 
@@ -85,14 +89,14 @@ GLOBAL_VAR(commands, builtin_commands, [(String, String -> GHCi Bool)])
 
 builtin_commands :: [(String, String -> GHCi Bool)]
 builtin_commands = [
 
 builtin_commands :: [(String, String -> GHCi Bool)]
 builtin_commands = [
-  ("add",      keepGoing addModule),
+  ("add",      keepGoingPaths addModule),
   ("browse",    keepGoing browseCmd),
   ("cd",       keepGoing changeDirectory),
   ("def",      keepGoing defineMacro),
   ("help",     keepGoing help),
   ("?",                keepGoing help),
   ("info",      keepGoing info),
   ("browse",    keepGoing browseCmd),
   ("cd",       keepGoing changeDirectory),
   ("def",      keepGoing defineMacro),
   ("help",     keepGoing help),
   ("?",                keepGoing help),
   ("info",      keepGoing info),
-  ("load",     keepGoing loadModule),
+  ("load",     keepGoingPaths loadModule),
   ("module",   keepGoing setContext),
   ("reload",   keepGoing reloadModule),
   ("set",      keepGoing setCmd),
   ("module",   keepGoing setContext),
   ("reload",   keepGoing reloadModule),
   ("set",      keepGoing setCmd),
@@ -106,6 +110,9 @@ builtin_commands = [
 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
 keepGoing a str = a str >> return False
 
 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
 keepGoing a str = a str >> return False
 
+keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
+keepGoingPaths a str = a (toArgs str) >> return False
+
 shortHelpText = "use :? for help.\n"
 
 -- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
 shortHelpText = "use :? for help.\n"
 
 -- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
@@ -145,39 +152,28 @@ helpText = "\
 \                         (eg. -v2, -fglasgow-exts, etc.)\n\ 
 \"
 
 \                         (eg. -v2, -fglasgow-exts, etc.)\n\ 
 \"
 
-interactiveUI :: CmState -> [FilePath] -> [LibrarySpec] -> IO ()
-interactiveUI cmstate paths cmdline_libs = do
+interactiveUI :: CmState -> [FilePath] -> [FilePath] -> IO ()
+interactiveUI cmstate paths cmdline_objs = do
    hFlush stdout
    hSetBuffering stdout NoBuffering
 
    dflags <- getDynFlags
 
    hFlush stdout
    hSetBuffering stdout NoBuffering
 
    dflags <- getDynFlags
 
-   -- link in the available packages
-   pkgs <- getPackageInfo
    initLinker
    initLinker
-   linkPackages dflags cmdline_libs pkgs
-
-   (cmstate, maybe_hval) 
-       <- cmCompileExpr cmstate dflags "IO.hSetBuffering IO.stdout IO.NoBuffering Prelude.>> IO.hSetBuffering IO.stderr IO.NoBuffering"
-   case maybe_hval of
-       Just hval -> unsafeCoerce# hval :: IO ()
-       _ -> panic "interactiveUI:buffering"
-
-   (cmstate, maybe_hval)
-       <- cmCompileExpr cmstate dflags "IO.hFlush IO.stderr"
-   case maybe_hval of
-       Just hval -> writeIORef flush_stderr (unsafeCoerce# hval :: IO ())
-       _ -> panic "interactiveUI:stderr"
-
-   (cmstate, maybe_hval) 
-       <- cmCompileExpr cmstate dflags "IO.hFlush IO.stdout"
-   case maybe_hval of
-       Just hval -> writeIORef flush_stdout (unsafeCoerce# hval :: IO ())
-       _ -> panic "interactiveUI:stdout"
+
+       -- link packages requested explicitly on the command-line
+   expl <- readIORef v_ExplicitPackages
+   linkPackages dflags expl
+
+       -- link libraries from the command-line
+   linkLibraries dflags cmdline_objs
+
+       -- Initialise buffering for the *interpreted* I/O system
+   cmstate <- initInterpBuffering cmstate dflags
 
        -- We don't want the cmd line to buffer any input that might be
        -- intended for the program, so unbuffer stdin.
 
        -- 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
    cmstate <- cmSetContext cmstate dflags [] ["Prelude"]
 
        -- initial context is just the Prelude
    cmstate <- cmSetContext cmstate dflags [] ["Prelude"]
@@ -199,7 +195,6 @@ interactiveUI cmstate paths cmdline_libs = do
 
    return ()
 
 
    return ()
 
-
 runGHCi :: [FilePath] -> DynFlags -> GHCi ()
 runGHCi paths dflags = do
   read_dot_files <- io (readIORef v_Read_DotGHCi)
 runGHCi :: [FilePath] -> DynFlags -> GHCi ()
 runGHCi paths dflags = do
   read_dot_files <- io (readIORef v_Read_DotGHCi)
@@ -236,11 +231,17 @@ runGHCi paths dflags = do
   -- perform a :load for files given on the GHCi command line
   when (not (null paths)) $
      ghciHandle showException $
   -- perform a :load for files given on the GHCi command line
   when (not (null paths)) $
      ghciHandle showException $
-       loadModule (unwords paths)
+       loadModule paths
 
   -- enter the interactive loop
 
   -- enter the interactive loop
+#if defined(mingw32_HOST_OS)
+   -- always show prompt, since hIsTerminalDevice returns True for Consoles
+   -- only, which we may or may not be running under (cf. Emacs sub-shells.)
+  interactiveLoop True
+#else
   is_tty <- io (hIsTerminalDevice stdin)
   interactiveLoop is_tty
   is_tty <- io (hIsTerminalDevice stdin)
   interactiveLoop is_tty
+#endif
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
@@ -258,7 +259,7 @@ interactiveLoop is_tty = do
        then readlineLoop
        else fileLoop stdin False  -- turn off prompt for non-TTY input
 #else
        then readlineLoop
        else fileLoop stdin False  -- turn off prompt for non-TTY input
 #else
-  fileLoop stdin True
+  fileLoop stdin is_tty
 #endif
 
 
 #endif
 
 
@@ -273,7 +274,7 @@ interactiveLoop is_tty = do
 
 checkPerms :: String -> IO Bool
 checkPerms name =
 
 checkPerms :: String -> IO Bool
 checkPerms name =
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
   return True
 #else
   DriverUtil.handle (\_ -> return False) $ do
   return True
 #else
   DriverUtil.handle (\_ -> return False) $ do
@@ -301,7 +302,7 @@ fileLoop hdl prompt = do
    l <- io (IO.try (hGetLine hdl))
    case l of
        Left e | isEOFError e -> return ()
    l <- io (IO.try (hGetLine hdl))
    case l of
        Left e | isEOFError e -> return ()
-              | otherwise    -> throw e
+              | otherwise    -> io (ioError e)
        Right l -> 
          case remove_spaces l of
            "" -> fileLoop hdl prompt
        Right l -> 
          case remove_spaces l of
            "" -> fileLoop hdl prompt
@@ -325,7 +326,10 @@ readlineLoop = do
    cmstate <- getCmState
    (mod,imports) <- io (cmGetContext cmstate)
    io yield
    cmstate <- getCmState
    (mod,imports) <- io (cmGetContext cmstate)
    io yield
-   l <- io (readline (mkPrompt mod imports))
+   l <- io (readline (mkPrompt mod imports)
+               `finally` setNonBlockingFD 0)
+               -- readline sometimes puts stdin into blocking mode,
+               -- so we need to put it back for the IO library
    case l of
        Nothing -> return ()
        Just l  ->
    case l of
        Nothing -> return ()
        Just l  ->
@@ -337,16 +341,23 @@ readlineLoop = do
                  if quit then return () else readlineLoop
 #endif
 
                  if quit then return () else readlineLoop
 #endif
 
--- Top level exception handler, just prints out the exception 
--- and carries on.
 runCommand :: String -> GHCi Bool
 runCommand :: String -> GHCi Bool
-runCommand c = 
-  ghciHandle ( \exception -> do
-               flushEverything
-               showException exception
-               return False
-            ) $
-  doCommand c
+runCommand c = ghciHandle handler (doCommand c)
+
+-- 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
 
 showException (DynException dyn) =
   case fromDynamic dyn of
@@ -386,9 +397,10 @@ finishEvalExpr names
       cmstate <- getCmState
       when b (mapM_ (showTypeOfName cmstate) names)
 
       cmstate <- getCmState
       when b (mapM_ (showTypeOfName cmstate) names)
 
+      flushInterpBuffers
+      io installSignalHandlers
       b <- isOptionSet RevertCAFs
       io (when b revertCAFs)
       b <- isOptionSet RevertCAFs
       io (when b revertCAFs)
-      flushEverything
       return True
 
 showTypeOfName :: CmState -> Name -> GHCi ()
       return True
 
 showTypeOfName :: CmState -> Name -> GHCi ()
@@ -398,12 +410,6 @@ showTypeOfName cmstate n
          Nothing  -> return ()
          Just str -> io (putStrLn (showSDoc (ppr n) ++ " :: " ++ str))
 
          Nothing  -> return ()
          Just str -> io (putStrLn (showSDoc (ppr n) ++ " :: " ++ str))
 
-flushEverything :: GHCi ()
-flushEverything
-   = io $ do Monad.join (readIORef flush_stdout)
-            Monad.join (readIORef flush_stderr)
-             return ()
-
 specialCommand :: String -> GHCi Bool
 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
 specialCommand str = do
 specialCommand :: String -> GHCi Bool
 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
 specialCommand str = do
@@ -420,6 +426,46 @@ specialCommand str = do
 
 noArgs c = throwDyn (CmdLineError ("command `" ++ c ++ "' takes no arguments"))
 
 
 noArgs c = throwDyn (CmdLineError ("command `" ++ c ++ "' takes no arguments"))
 
+
+-----------------------------------------------------------------------------
+-- 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 = "IO.hSetBuffering IO.stdout IO.NoBuffering" ++
+            " Prelude.>> IO.hSetBuffering IO.stderr IO.NoBuffering"
+flush_cmd  = "IO.hFlush IO.stdout Prelude.>> IO.hFlush IO.stderr"
+
+initInterpBuffering :: CmState -> DynFlags -> IO CmState
+initInterpBuffering cmstate dflags
+ = do (cmstate, maybe_hval) <- cmCompileExpr cmstate dflags no_buf_cmd
+       
+      case maybe_hval of
+       Just hval -> writeIORef turn_off_buffering (unsafeCoerce# hval :: IO ())
+       other     -> panic "interactiveUI:setBuffering"
+       
+      (cmstate, maybe_hval) <- cmCompileExpr cmstate dflags flush_cmd
+      case maybe_hval of
+       Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ())
+       _         -> panic "interactiveUI:flush"
+
+      turnOffBuffering -- Turn it off right now
+
+      return cmstate
+
+
+flushInterpBuffers :: GHCi ()
+flushInterpBuffers
+ = io $ do Monad.join (readIORef flush_interp)
+           return ()
+
+turnOffBuffering :: IO ()
+turnOffBuffering
+ = do Monad.join (readIORef turn_off_buffering)
+      return ()
+
 -----------------------------------------------------------------------------
 -- Commands
 
 -----------------------------------------------------------------------------
 -- Commands
 
@@ -457,6 +503,8 @@ info s = do
 
     showTyThing (AClass cl)
        = hcat [ppr cl, text " is a class", showSrcLoc (className cl)]
 
     showTyThing (AClass cl)
        = hcat [ppr cl, text " is a class", showSrcLoc (className cl)]
+    showTyThing (ADataCon dc)
+       = hcat [ppr dc, text " is a data constructor", showSrcLoc (dataConName dc)]
     showTyThing (ATyCon ty)
        | isPrimTyCon ty
        = hcat [ppr ty, text " is a primitive type constructor"]
     showTyThing (ATyCon ty)
        | isPrimTyCon ty
        = hcat [ppr ty, text " is a primitive type constructor"]
@@ -466,13 +514,10 @@ info s = do
        = hcat [ppr id, text " is a ", idDescr id, showSrcLoc (idName id)]
 
     idDescr id
        = hcat [ppr id, text " is a ", idDescr id, showSrcLoc (idName id)]
 
     idDescr id
-       | isRecordSelector id = 
-               case tyConClass_maybe (fieldLabelTyCon (
-                               recordSelectorFieldLabel id)) of
-                       Nothing -> text "record selector"
-                       Just c  -> text "method in class " <> ppr c
-       | isDataConWrapId id  = text "data constructor"
-       | otherwise           = text "variable"
+       = case globalIdDetails id of
+           RecordSelId lbl -> text "record selector for type" <+> ppr (fieldLabelTyCon lbl)
+           ClassOpId cls   -> text "method in class" <+> ppr cls
+                   otherwise       -> text "variable"
 
        -- also print out the source location for home things
     showSrcLoc name
 
        -- also print out the source location for home things
     showSrcLoc name
@@ -486,9 +531,8 @@ info s = do
   setCmState cms
   return ()
 
   setCmState cms
   return ()
 
-addModule :: String -> GHCi ()
-addModule str = do
-  let files = words str
+addModule :: [FilePath] -> GHCi ()
+addModule files = do
   state <- getGHCiState
   dflags <- io (getDynFlags)
   io (revertCAFs)                      -- always revert CAFs on load/add.
   state <- getGHCiState
   dflags <- io (getDynFlags)
   io (revertCAFs)                      -- always revert CAFs on load/add.
@@ -550,11 +594,11 @@ undefineMacro macro_name = do
   io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
 
 
   io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
 
 
-loadModule :: String -> GHCi ()
-loadModule str = timeIt (loadModule' str)
+loadModule :: [FilePath] -> GHCi ()
+loadModule fs = timeIt (loadModule' fs)
 
 
-loadModule' str = do
-  let files = words str
+loadModule' :: [FilePath] -> GHCi ()
+loadModule' files = do
   state <- getGHCiState
   dflags <- io getDynFlags
 
   state <- getGHCiState
   dflags <- io getDynFlags
 
@@ -607,9 +651,9 @@ modulesLoadedMsg ok mods dflags =
        | otherwise = hsep (
            punctuate comma (map text mods)) <> text "."
    case ok of
        | otherwise = hsep (
            punctuate comma (map text mods)) <> text "."
    case ok of
-    False ->
+    Failed ->
        io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
        io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
-    True  ->
+    Succeeded  ->
        io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
 
 
        io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
 
 
@@ -662,8 +706,9 @@ browseModule m exports_only = do
 
       things' = filter wantToSee things
 
 
       things' = filter wantToSee things
 
-      wantToSee (AnId id) = not (isDataConId id || isDataConWrapId id)
-      wantToSee _ = True
+      wantToSee (AnId id)    = not (isImplicitId id)
+      wantToSee (ADataCon _) = False   -- They'll come via their TyCon
+      wantToSee _           = True
 
       thing_names = map getName things
 
 
       thing_names = map getName things
 
@@ -685,7 +730,7 @@ browseModule m exports_only = do
                rn_decl{ tcdCons = DataCons (filter conIsVisible cons) }
          other -> other
         where
                rn_decl{ tcdCons = DataCons (filter conIsVisible cons) }
          other -> other
         where
-         conIsVisible (ConDecl n _ _ _ _ _) = n `elem` thing_names
+         conIsVisible (ConDecl n _ _ _ _) = n `elem` thing_names
 
   io (putStrLn (showSDocForUser unqual (
         vcat (map (ppr . thingDecl) things')))
 
   io (putStrLn (showSDocForUser unqual (
         vcat (map (ppr . thingDecl) things')))
@@ -793,21 +838,28 @@ setProg _ = do
 setOptions wds =
    do -- first, deal with the GHCi opts (+s, +t, etc.)
       let (plus_opts, minus_opts)  = partition isPlus wds
 setOptions wds =
    do -- first, deal with the GHCi opts (+s, +t, etc.)
       let (plus_opts, minus_opts)  = partition isPlus wds
-      mapM setOpt plus_opts
+      mapM_ setOpt plus_opts
 
       -- now, the GHC flags
 
       -- now, the GHC flags
-      pkgs_before <- io (readIORef v_Packages)
+      pkgs_before <- io (readIORef v_ExplicitPackages)
       leftovers   <- io (processArgs static_flags minus_opts [])
       leftovers   <- io (processArgs static_flags minus_opts [])
-      pkgs_after  <- io (readIORef v_Packages)
+      pkgs_after  <- io (readIORef v_ExplicitPackages)
 
       -- update things if the users wants more packages
 
       -- update things if the users wants more packages
-      when (pkgs_before /= pkgs_after) $
-        newPackages (pkgs_after \\ pkgs_before)
+      let new_packages = pkgs_after \\ pkgs_before
+      when (not (null new_packages)) $
+        newPackages new_packages
+
+      -- don't forget about the extra command-line flags from the 
+      -- extra_ghc_opts fields in the new packages
+      new_package_details <- io (getPackageDetails new_packages)
+      let pkg_extra_opts = concatMap extra_ghc_opts new_package_details
+      pkg_extra_dyn <- io (processArgs static_flags pkg_extra_opts [])
 
       -- then, dynamic flags
       io $ do 
        restoreDynFlags
 
       -- then, dynamic flags
       io $ do 
        restoreDynFlags
-        leftovers <- processArgs dynamic_flags leftovers []
+        leftovers <- processArgs dynamic_flags (leftovers ++ pkg_extra_dyn) []
        saveDynFlags
 
         if (not (null leftovers))
        saveDynFlags
 
         if (not (null leftovers))
@@ -827,7 +879,7 @@ unsetOptions str
          then io (putStrLn ("unknown option: `" ++ head rest2 ++ "'"))
          else do
 
          then io (putStrLn ("unknown option: `" ++ head rest2 ++ "'"))
          else do
 
-       mapM unsetOpt plus_opts
+       mapM_ unsetOpt plus_opts
  
        -- can't do GHC flags for now
        if (not (null minus_opts))
  
        -- can't do GHC flags for now
        if (not (null minus_opts))
@@ -861,41 +913,40 @@ optToStr ShowTiming = "s"
 optToStr ShowType   = "t"
 optToStr RevertCAFs = "r"
 
 optToStr ShowType   = "t"
 optToStr RevertCAFs = "r"
 
-newPackages new_pkgs = do
-  state <- getGHCiState
-  dflags <- io getDynFlags
+newPackages new_pkgs = do      -- The new packages are already in v_Packages
+  state    <- getGHCiState
+  dflags   <- io getDynFlags
   cmstate1 <- io (cmUnload (cmstate state) dflags)
   setGHCiState state{ cmstate = cmstate1, targets = [] }
   cmstate1 <- io (cmUnload (cmstate state) dflags)
   setGHCiState state{ cmstate = cmstate1, targets = [] }
+  io (linkPackages dflags new_pkgs)
+  setContextAfterLoad []
 
 
-  io $ do
-    pkgs <- getPackageInfo
-    flushPackageCache pkgs
-   
-    new_pkg_info <- getPackageDetails new_pkgs
-    mapM_ (linkPackage dflags) (reverse new_pkg_info)
-
------------------------------------------------------------------------------
+-- ---------------------------------------------------------------------------
 -- code for `:show'
 
 showCmd str =
   case words str of
        ["modules" ] -> showModules
        ["bindings"] -> showBindings
 -- code for `:show'
 
 showCmd str =
   case words str of
        ["modules" ] -> showModules
        ["bindings"] -> showBindings
+       ["linker"]   -> io showLinkerState
        _ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
 
 showModules = do
   cms <- getCmState
        _ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
 
 showModules = do
   cms <- getCmState
-  let mg = cmGetModuleGraph cms
-      ls = cmGetLinkables   cms
-      maybe_linkables = map (findModuleLinkable_maybe ls) 
-                               (map (moduleName.ms_mod) mg)
-  zipWithM showModule mg maybe_linkables
-  return ()
+  let (mg, hpt) = cmGetModInfo cms
+  mapM_ (showModule hpt) mg
 
 
-showModule :: ModSummary -> Maybe Linkable -> GHCi ()
-showModule m (Just l) = do
-  io (putStrLn (showModMsg (isObjectLinkable l) (ms_mod m) (ms_location m)))
-showModule _ Nothing = panic "missing linkable"
+
+showModule :: HomePackageTable -> ModSummary -> GHCi ()
+showModule hpt mod_summary
+  = case lookupModuleEnv hpt mod of
+       Nothing       -> panic "missing linkable"
+       Just mod_info -> io (putStrLn (showModMsg obj_linkable mod locn))
+                     where
+                        obj_linkable = isObjectLinkable (hm_linkable mod_info)
+  where
+    mod = ms_mod mod_summary
+    locn = ms_location mod_summary
 
 showBindings = do
   cms <- getCmState
 
 showBindings = do
   cms <- getCmState
@@ -903,9 +954,10 @@ showBindings = do
        unqual = cmGetPrintUnqual cms
        showBinding b = putStrLn (showSDocForUser unqual (ppr (ifaceTyThing b)))
 
        unqual = cmGetPrintUnqual cms
        showBinding b = putStrLn (showSDocForUser unqual (ppr (ifaceTyThing b)))
 
-  io (mapM showBinding (cmGetBindings cms))
+  io (mapM_ showBinding (cmGetBindings cms))
   return ()
 
   return ()
 
+
 -----------------------------------------------------------------------------
 -- GHCi monad
 
 -----------------------------------------------------------------------------
 -- GHCi monad
 
@@ -924,9 +976,6 @@ data GHCiOption
        | RevertCAFs            -- revert CAFs after every evaluation
        deriving Eq
 
        | RevertCAFs            -- revert CAFs after every evaluation
        deriving Eq
 
-GLOBAL_VAR(flush_stdout, error "no flush_stdout", IO ())
-GLOBAL_VAR(flush_stderr, error "no flush_stdout", IO ())
-
 newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a }
 
 startGHCi :: GHCi a -> GHCiState -> IO a
 newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a }
 
 startGHCi :: GHCi a -> GHCiState -> IO a
@@ -975,153 +1024,12 @@ io m = GHCi { unGHCi = \s -> m >>= return }
 ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
 ghciHandle h (GHCi m) = GHCi $ \s -> 
    Exception.catch (m s) 
 ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
 ghciHandle h (GHCi m) = GHCi $ \s -> 
    Exception.catch (m s) 
-       (\e -> unGHCi (ghciHandle h (ghciUnblock (h e))) s)
+       (\e -> unGHCi (ghciUnblock (h e)) s)
 
 ghciUnblock :: GHCi a -> GHCi a
 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
 
 -----------------------------------------------------------------------------
 
 ghciUnblock :: GHCi a -> GHCi a
 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
 
 -----------------------------------------------------------------------------
--- package loader
-
--- Left: full path name of a .o file, including trailing .o
--- Right: "unadorned" name of a .DLL/.so
---        e.g.    On unix     "qt"  denotes "libqt.so"
---                On WinDoze  "burble"  denotes "burble.DLL"
---        addDLL is platform-specific and adds the lib/.so/.DLL
---        suffixes platform-dependently; we don't do that here.
--- 
--- For dynamic objects only, try to find the object file in all the 
--- directories specified in v_Library_Paths before giving up.
-
-type LibrarySpec
-   = Either FilePath String
-
-showLS (Left nm)  = "(static) " ++ nm
-showLS (Right nm) = "(dynamic) " ++ nm
-
-linkPackages :: DynFlags -> [LibrarySpec] -> [PackageConfig] -> IO ()
-linkPackages dflags cmdline_lib_specs pkgs
-   = do mapM_ (linkPackage dflags) (reverse pkgs)
-        lib_paths <- readIORef v_Library_paths
-        mapM_ (preloadLib dflags lib_paths) cmdline_lib_specs
-       if (null cmdline_lib_specs)
-          then return ()
-          else do maybePutStr dflags "final link ... "
-                  ok <- resolveObjs
-                  if ok then maybePutStrLn dflags "done."
-                        else throwDyn (InstallationError 
-                                          "linking extra libraries/objects failed")
-     where
-        preloadLib :: DynFlags -> [String] -> LibrarySpec -> IO ()
-        preloadLib dflags lib_paths lib_spec
-           = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
-                case lib_spec of
-                   Left static_ish
-                      -> do b <- preload_static lib_paths static_ish
-                            maybePutStrLn dflags (if b  then "done." 
-                                                       else "not found")
-                   Right dll_unadorned
-                      -> -- We add "" to the set of paths to try, so that
-                         -- if none of the real paths match, we force addDLL
-                         -- to look in the default dynamic-link search paths.
-                         do maybe_errstr <- preload_dynamic (lib_paths++[""]) 
-                                                            dll_unadorned
-                            case maybe_errstr of
-                               Nothing -> return ()
-                               Just mm -> preloadFailed mm lib_paths lib_spec
-                            maybePutStrLn dflags "done"
-
-        preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
-        preloadFailed sys_errmsg paths spec
-           = do maybePutStr dflags
-                      ("failed.\nDynamic linker error message was:\n   " 
-                        ++ sys_errmsg  ++ "\nWhilst trying to load:  " 
-                        ++ showLS spec ++ "\nDirectories to search are:\n"
-                        ++ unlines (map ("   "++) paths) )
-                give_up
-
-        -- not interested in the paths in the static case.
-        preload_static paths name
-           = do b <- doesFileExist name
-                if not b then return False
-                         else loadObj name >> return True
-
-        -- return Nothing == success, else Just error message from addDLL
-        preload_dynamic [] name
-           = return Nothing
-        preload_dynamic (path:paths) rootname
-           = do -- addDLL returns NULL on success
-                maybe_errmsg <- addDLL path rootname
-                if    maybe_errmsg == nullPtr
-                 then preload_dynamic paths rootname
-                 else do str <- peekCString maybe_errmsg
-                         return (Just str)
-
-        give_up 
-           = (throwDyn . CmdLineError)
-                "user specified .o/.so/.DLL could not be loaded."
-
--- Packages that don't need loading, because the compiler shares them with
--- the interpreted program.
-dont_load_these = [ "gmp", "rts" ]
-
--- Packages that are already linked into GHCi.  For mingw32, we only
--- skip gmp and rts, since std and after need to load the msvcrt.dll
--- library which std depends on.
-loaded_in_ghci
-#          ifndef mingw32_TARGET_OS
-           = [ "std", "concurrent", "posix", "text", "util" ]
-#          else
-          = [ ]
-#          endif
-
-linkPackage :: DynFlags -> PackageConfig -> IO ()
-linkPackage dflags pkg
-   | name pkg `elem` dont_load_these = return ()
-   | otherwise
-   = do 
-        -- For each obj, try obj.o and if that fails, obj.so.
-        -- Complication: all the .so's must be loaded before any of the .o's.  
-        let dirs      =  library_dirs pkg
-        let objs      =  hs_libraries pkg ++ extra_libraries pkg
-        classifieds   <- mapM (locateOneObj dirs) objs
-
-       -- Don't load the .so libs if this is a package GHCi is already
-       -- linked against, because we'll already have the .so linked in.
-       let (so_libs, obj_libs) = partition isRight classifieds
-        let sos_first | name pkg `elem` loaded_in_ghci = obj_libs
-                     | otherwise                      = so_libs ++ obj_libs
-
-       maybePutStr dflags ("Loading package " ++ name pkg ++ " ... ")
-        mapM loadClassified sos_first
-        maybePutStr dflags "linking ... "
-        ok <- resolveObjs
-       if ok then maybePutStrLn dflags "done."
-             else panic ("can't load package `" ++ name pkg ++ "'")
-     where
-        isRight (Right _) = True
-        isRight (Left _)  = False
-
-loadClassified :: LibrarySpec -> IO ()
-loadClassified (Left obj_absolute_filename)
-   = do loadObj obj_absolute_filename
-loadClassified (Right dll_unadorned)
-   = do maybe_errmsg <- addDLL "" dll_unadorned -- doesn't seem right to me
-        if    maybe_errmsg == nullPtr
-         then return ()
-         else do str <- peekCString maybe_errmsg
-                 throwDyn (CmdLineError ("can't load .so/.DLL for: " 
-                                       ++ dll_unadorned ++ " (" ++ str ++ ")" ))
-
-locateOneObj :: [FilePath] -> String -> IO LibrarySpec
-locateOneObj []     obj 
-   = return (Right obj) -- we assume
-locateOneObj (d:ds) obj 
-   = do let path = d ++ '/':obj ++ ".o"
-        b <- doesFileExist path
-        if b then return (Left path) else locateOneObj ds obj
-
------------------------------------------------------------------------------
 -- timing & statistics
 
 timeIt :: GHCi a -> GHCi a
 -- timing & statistics
 
 timeIt :: GHCi a -> GHCi a
@@ -1137,7 +1045,7 @@ timeIt action
                  io $ printTimes (allocs2 - allocs1) (time2 - time1)
                  return a
 
                  io $ printTimes (allocs2 - allocs1) (time2 - time1)
                  return a
 
-foreign import "getAllocations" getAllocations :: IO Int
+foreign import ccall "getAllocations" getAllocations :: IO Int
 
 printTimes :: Int -> Integer -> IO ()
 printTimes allocs psecs
 
 printTimes :: Int -> Integer -> IO ()
 printTimes allocs psecs
@@ -1148,20 +1056,14 @@ printTimes allocs psecs
                         int allocs <+> text "bytes")))
 
 -----------------------------------------------------------------------------
                         int allocs <+> text "bytes")))
 
 -----------------------------------------------------------------------------
--- utils
-
-looksLikeModuleName [] = False
-looksLikeModuleName (c:cs) = isUpper c && all isAlphaNumEx cs
-
-isAlphaNumEx c = isAlphaNum c || c == '_' || c == '.'
-
-maybePutStr dflags s | verbosity dflags > 0 = putStr s
-                    | otherwise            = return ()
-
-maybePutStrLn dflags s | verbosity dflags > 0 = putStrLn s
-                      | otherwise            = return ()
-
------------------------------------------------------------------------------
 -- reverting CAFs
        
 -- reverting CAFs
        
-foreign import revertCAFs :: IO ()     -- make it "safe", just in case
+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