[project @ 2003-12-10 14:15:16 by simonmar]

[ghc-hetmet.git] / ghc / compiler / ghci / InteractiveUI.hs

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 686e17b..a1ec764 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
-{-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
+{-# OPTIONS -#include "Linker.h" #-}

 -----------------------------------------------------------------------------
 -----------------------------------------------------------------------------

--- $Id: InteractiveUI.hs,v 1.135 2002/10/14 14:54:16 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.162 2003/12/10 14:15:21 simonmar Exp $

 --
 -- GHC Interactive User Interface
 --
 --
 -- GHC Interactive User Interface
 --

@@ -8,7 +8,7 @@
 --
 -----------------------------------------------------------------------------
 module InteractiveUI ( 
 --
 -----------------------------------------------------------------------------
 module InteractiveUI ( 

-       interactiveUI,  -- :: CmState -> [FilePath] -> [LibrarySpec] -> IO ()
+       interactiveUI,  -- :: CmState -> [FilePath] -> IO ()

        ghciWelcomeMsg
    ) where
 
        ghciWelcomeMsg
    ) where
 

@@ -17,34 +17,31 @@ module InteractiveUI (
 
 import CompManager
 import HscTypes                ( TyThing(..), HomeModInfo(hm_linkable), HomePackageTable,
 
 import CompManager
 import HscTypes                ( TyThing(..), HomeModInfo(hm_linkable), HomePackageTable,

-                         isObjectLinkable )
-import HsSyn           ( TyClDecl(..), ConDecl(..), Sig(..) )
-import MkIface         ( ifaceTyThing )
+                         isObjectLinkable, GhciMode(..) )
+import IfaceSyn                ( IfaceDecl( ifName ) )

 import DriverFlags
 import DriverState
 import DriverFlags
 import DriverState

-import DriverUtil      ( remove_spaces, handle )
-import Linker          ( initLinker, showLinkerState, linkLibraries )
-import Finder          ( flushPackageCache )
+import DriverUtil      ( remove_spaces )
+import Linker          ( showLinkerState, linkPackages )

 import Util
 import Util

-import Id              ( isRecordSelector, recordSelectorFieldLabel, 
-                         isDataConWrapId, isDataConId, idName )
-import Class           ( className )
-import TyCon           ( tyConName, tyConClass_maybe, isPrimTyCon, DataConDetails(..) )
-import FieldLabel      ( fieldLabelTyCon )
-import SrcLoc          ( isGoodSrcLoc )

 import Module          ( showModMsg, lookupModuleEnv )
 import Name            ( Name, isHomePackageName, nameSrcLoc, nameOccName,
                          NamedThing(..) )
 import OccName         ( isSymOcc )
 import BasicTypes      ( defaultFixity, SuccessFlag(..) )
 import Module          ( showModMsg, lookupModuleEnv )
 import Name            ( Name, isHomePackageName, nameSrcLoc, nameOccName,
                          NamedThing(..) )
 import OccName         ( isSymOcc )
 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
+#ifndef mingw32_HOST_OS
+import DriverUtil( handle )

 import System.Posix
 import System.Posix

+#if __GLASGOW_HASKELL__ > 504
+       hiding (getEnv)
+#endif

 #endif
 
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
 #endif
 
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS

@@ -70,11 +67,9 @@ import Control.Monad as Monad
 
 import GHC.Exts                ( unsafeCoerce# )
 
 
 import GHC.Exts                ( unsafeCoerce# )
 

-import Foreign         ( nullPtr )
-import Foreign.C.String        ( CString, peekCString, withCString )

 import Data.IORef      ( IORef, newIORef, readIORef, writeIORef )
 
 import Data.IORef      ( IORef, newIORef, readIORef, writeIORef )
 

-import GHC.Posix       ( setNonBlockingFD )
+import System.Posix.Internals ( setNonBlockingFD )

 
 -----------------------------------------------------------------------------
 
 
 -----------------------------------------------------------------------------
 

@@ -89,14 +84,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),

@@ -110,6 +105,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.

@@ -149,38 +147,33 @@ helpText = "\
 \                         (eg. -v2, -fglasgow-exts, etc.)\n\ 
 \"
 
 \                         (eg. -v2, -fglasgow-exts, etc.)\n\ 
 \"
 

-interactiveUI :: CmState -> [FilePath] -> [FilePath] -> IO ()
-interactiveUI cmstate paths cmdline_objs = do
-   hFlush stdout
-   hSetBuffering stdout NoBuffering
-
+interactiveUI :: [FilePath] -> Maybe String -> IO ()
+interactiveUI srcs maybe_expr = do

    dflags <- getDynFlags
 
    dflags <- getDynFlags
 

-   -- Link in the available packages
-   initLinker
-       --      Now that demand-loading works, we don't really need to pre-load the packages
-       --   pkgs <- getPackages
-       --   linkPackages dflags  pkgs
-   linkLibraries dflags cmdline_objs
+   cmstate <- cmInit Interactive dflags;
+
+   hFlush stdout
+   hSetBuffering stdout NoBuffering

 
        -- Initialise buffering for the *interpreted* I/O system
 
        -- Initialise buffering for the *interpreted* I/O system

-   cmstate <- initInterpBuffering cmstate dflags
+   initInterpBuffering cmstate

 
        -- We don't want the cmd line to buffer any input that might be
        -- intended for the program, so unbuffer stdin.
    hSetBuffering stdin NoBuffering
 
        -- initial context is just the Prelude
 
        -- We don't want the cmd line to buffer any input that might be
        -- intended for the program, so unbuffer stdin.
    hSetBuffering stdin NoBuffering
 
        -- initial context is just the Prelude

-   cmstate <- cmSetContext cmstate dflags [] ["Prelude"]
+   cmstate <- cmSetContext cmstate [] ["Prelude"]

 
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
    Readline.initialize
 #endif
 
 
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
    Readline.initialize
 #endif
 

-   startGHCi (runGHCi paths dflags) 
+   startGHCi (runGHCi srcs dflags maybe_expr)

        GHCiState{ progname = "<interactive>",
                   args = [],
        GHCiState{ progname = "<interactive>",
                   args = [],

-                  targets = paths,
+                  targets = srcs,

                   cmstate = cmstate,
                   options = [] }
 
                   cmstate = cmstate,
                   options = [] }
 

@@ -190,8 +183,8 @@ interactiveUI cmstate paths cmdline_objs = do
 
    return ()
 
 
    return ()
 

-runGHCi :: [FilePath] -> DynFlags -> GHCi ()
-runGHCi paths dflags = do
+runGHCi :: [FilePath] -> DynFlags -> Maybe String -> GHCi ()
+runGHCi paths dflags maybe_expr = do

   read_dot_files <- io (readIORef v_Read_DotGHCi)
 
   when (read_dot_files) $ do
   read_dot_files <- io (readIORef v_Read_DotGHCi)
 
   when (read_dot_files) $ do

@@ -223,38 +216,42 @@ runGHCi paths dflags = do
                  Left e    -> return ()
                  Right hdl -> fileLoop hdl False
 
                  Left e    -> return ()
                  Right hdl -> fileLoop hdl False
 

-  -- perform a :load for files given on the GHCi command line
+  -- Perform a :load for files given on the GHCi command line

   when (not (null paths)) $
      ghciHandle showException $
   when (not (null paths)) $
      ghciHandle showException $

-       loadModule (unwords paths)
+       loadModule paths

 
 

-  -- enter the interactive loop
-#if defined(mingw32_TARGET_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
+  -- if verbosity is greater than 0, or we are connected to a
+  -- terminal, display the prompt in the interactive loop.

   is_tty <- io (hIsTerminalDevice stdin)
   is_tty <- io (hIsTerminalDevice stdin)

-  interactiveLoop is_tty
-#endif
+  let show_prompt = verbosity dflags > 0 || is_tty
+
+  case maybe_expr of
+       Nothing -> 
+           -- enter the interactive loop
+           interactiveLoop is_tty show_prompt
+       Just expr -> do
+           -- just evaluate the expression we were given
+           runCommand expr
+           return ()

 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
 
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
 

-interactiveLoop is_tty = do
-  -- ignore ^C exceptions caught here
+interactiveLoop is_tty show_prompt = do
+  -- Ignore ^C exceptions caught here

   ghciHandleDyn (\e -> case e of 
   ghciHandleDyn (\e -> case e of 

-                       Interrupted -> ghciUnblock (interactiveLoop is_tty)
+                       Interrupted -> ghciUnblock (interactiveLoop is_tty show_prompt)

                        _other      -> return ()) $ do
 
   -- read commands from stdin
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
   if (is_tty) 
        then readlineLoop
                        _other      -> return ()) $ do
 
   -- read commands from stdin
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
   if (is_tty) 
        then readlineLoop

-       else fileLoop stdin False  -- turn off prompt for non-TTY input
+       else fileLoop stdin show_prompt

 #else
 #else

-  fileLoop stdin is_tty
+  fileLoop stdin show_prompt

 #endif
 
 
 #endif
 
 

@@ -269,7 +266,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

@@ -297,7 +294,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

@@ -336,16 +333,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
-               flushInterpBuffers
-               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

@@ -369,10 +373,11 @@ runStmt stmt
  | otherwise
  = do st <- getGHCiState
       dflags <- io getDynFlags
  | otherwise
  = do st <- getGHCiState
       dflags <- io getDynFlags

-      let dflags' = dopt_unset dflags Opt_WarnUnusedBinds
+      let cm_state' = cmSetDFlags (cmstate st)
+                                 (dopt_unset dflags Opt_WarnUnusedBinds)

       (new_cmstate, result) <- 
        io $ withProgName (progname st) $ withArgs (args st) $
       (new_cmstate, result) <- 
        io $ withProgName (progname st) $ withArgs (args st) $

-       cmRunStmt (cmstate st) dflags' stmt
+            cmRunStmt cm_state' stmt

       setGHCiState st{cmstate = new_cmstate}
       case result of
        CmRunFailed      -> return []
       setGHCiState st{cmstate = new_cmstate}
       case result of
        CmRunFailed      -> return []

@@ -386,6 +391,7 @@ finishEvalExpr names
       when b (mapM_ (showTypeOfName cmstate) names)
 
       flushInterpBuffers
       when b (mapM_ (showTypeOfName cmstate) names)
 
       flushInterpBuffers

+      io installSignalHandlers

       b <- isOptionSet RevertCAFs
       io (when b revertCAFs)
       return True
       b <- isOptionSet RevertCAFs
       io (when b revertCAFs)
       return True

@@ -425,22 +431,22 @@ 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"
 
             " 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
+initInterpBuffering :: CmState -> IO ()
+initInterpBuffering cmstate
+ = do maybe_hval <- cmCompileExpr cmstate no_buf_cmd

        
       case maybe_hval of
        Just hval -> writeIORef turn_off_buffering (unsafeCoerce# hval :: IO ())
        other     -> panic "interactiveUI:setBuffering"
        
        
       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
+      maybe_hval <- cmCompileExpr cmstate flush_cmd

       case maybe_hval of
        Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ())
        _         -> panic "interactiveUI:flush"
 
       turnOffBuffering -- Turn it off right now
 
       case maybe_hval of
        Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ())
        _         -> panic "interactiveUI:flush"
 
       turnOffBuffering -- Turn it off right now
 

-      return cmstate
+      return ()

 
 
 flushInterpBuffers :: GHCi ()
 
 
 flushInterpBuffers :: GHCi ()

@@ -464,11 +470,10 @@ info "" = throwDyn (CmdLineError "syntax: `:i <thing-you-want-info-about>'")
 info s = do
   let names = words s
   init_cms <- getCmState
 info s = do
   let names = words s
   init_cms <- getCmState

-  dflags <- io getDynFlags

   let 
     infoThings cms [] = return cms
     infoThings cms (name:names) = do
   let 
     infoThings cms [] = return cms
     infoThings cms (name:names) = do

-      (cms, stuff) <- io (cmInfoThing cms dflags name)
+      stuff <- io (cmInfoThing cms name)

       io (putStrLn (showSDocForUser unqual (
            vcat (intersperse (text "") (map showThing stuff))))
          )
       io (putStrLn (showSDocForUser unqual (
            vcat (intersperse (text "") (map showThing stuff))))
          )

@@ -476,20 +481,25 @@ info s = do
 
     unqual = cmGetPrintUnqual init_cms
 
 
     unqual = cmGetPrintUnqual init_cms
 

-    showThing (ty_thing, fixity) 
-       = vcat [ text "-- " <> showTyThing ty_thing, 
-                showFixity fixity (getName ty_thing),
-                ppr (ifaceTyThing ty_thing) ]
+    showThing (decl, fixity) 
+       = vcat [ text "-- " <> showTyThing decl, 
+                showFixity fixity (ifName decl),
+                showTyThing decl ]

 
     showFixity fix name
        | fix == defaultFixity = empty
        | otherwise            = ppr fix <+> 
 
     showFixity fix name
        | fix == defaultFixity = empty
        | otherwise            = ppr fix <+> 

-                                (if isSymOcc (nameOccName name)
-                                       then ppr name
-                                       else char '`' <> ppr name <> char '`')
+                                (if isSymOcc name
+                                 then ppr name
+                                 else char '`' <> ppr name <> char '`')
+
+    showTyThing decl = ppr decl

 
 

+{-

     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"]

@@ -499,13 +509,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

@@ -514,29 +521,35 @@ info s = do
        | otherwise
        = empty
        where loc = nameSrcLoc name
        | otherwise
        = empty
        where loc = nameSrcLoc name

+-}

 
 

-  cms <- infoThings init_cms names
-  setCmState cms
+  infoThings init_cms names

   return ()
 
   return ()
 

-addModule :: String -> GHCi ()
-addModule str = do
-  let files = words str
+addModule :: [FilePath] -> GHCi ()
+addModule files = do

   state <- getGHCiState
   state <- getGHCiState

-  dflags <- io (getDynFlags)

   io (revertCAFs)                      -- always revert CAFs on load/add.
   io (revertCAFs)                      -- always revert CAFs on load/add.

+  files <- mapM expandPath files

   let new_targets = files ++ targets state 
   let new_targets = files ++ targets state 

-  graph <- io (cmDepAnal (cmstate state) dflags new_targets)
-  (cmstate1, ok, mods) <- io (cmLoadModules (cmstate state) dflags graph)
+  graph <- io (cmDepAnal (cmstate state) new_targets)
+  (cmstate1, ok, mods) <- io (cmLoadModules (cmstate state) graph)

   setGHCiState state{ cmstate = cmstate1, targets = new_targets }
   setContextAfterLoad mods
   setGHCiState state{ cmstate = cmstate1, targets = new_targets }
   setContextAfterLoad mods

+  dflags <- io getDynFlags

   modulesLoadedMsg ok mods dflags
 
 changeDirectory :: String -> GHCi ()
   modulesLoadedMsg ok mods dflags
 
 changeDirectory :: String -> GHCi ()

-changeDirectory ('~':d) = do
-   tilde <- io (getEnv "HOME") -- will fail if HOME not defined
-   io (setCurrentDirectory (tilde ++ '/':d))
-changeDirectory d = io (setCurrentDirectory d)
+changeDirectory dir = do
+  state    <- getGHCiState
+  when (targets state /= []) $
+       io $ putStr "Warning: changing directory causes all loaded modules to be unloaded, \n\ 
+       \because the search path has changed.\n"
+  cmstate1 <- io (cmUnload (cmstate state))
+  setGHCiState state{ cmstate = cmstate1, targets = [] }
+  setContextAfterLoad []
+  dir <- expandPath dir
+  io (setCurrentDirectory dir)

 
 defineMacro :: String -> GHCi ()
 defineMacro s = do
 
 defineMacro :: String -> GHCi ()
 defineMacro s = do

@@ -556,9 +569,7 @@ defineMacro s = do
 
   -- compile the expression
   cms <- getCmState
 
   -- compile the expression
   cms <- getCmState

-  dflags <- io getDynFlags
-  (new_cmstate, maybe_hv) <- io (cmCompileExpr cms dflags new_expr)
-  setCmState new_cmstate
+  maybe_hv <- io (cmCompileExpr cms new_expr)

   case maybe_hv of
      Nothing -> return ()
      Just hv -> io (writeIORef commands --
   case maybe_hv of
      Nothing -> return ()
      Just hv -> io (writeIORef commands --

@@ -583,46 +594,49 @@ 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
   state <- getGHCiState

-  dflags <- io getDynFlags
+
+  -- expand tildes
+  files <- mapM expandPath files

 
   -- do the dependency anal first, so that if it fails we don't throw
   -- away the current set of modules.
 
   -- do the dependency anal first, so that if it fails we don't throw
   -- away the current set of modules.

-  graph <- io (cmDepAnal (cmstate state) dflags files)
+  graph <- io (cmDepAnal (cmstate state) files)

 
   -- Dependency anal ok, now unload everything
 
   -- Dependency anal ok, now unload everything

-  cmstate1 <- io (cmUnload (cmstate state) dflags)
+  cmstate1 <- io (cmUnload (cmstate state))

   setGHCiState state{ cmstate = cmstate1, targets = [] }
 
   io (revertCAFs)  -- always revert CAFs on load.
   setGHCiState state{ cmstate = cmstate1, targets = [] }
 
   io (revertCAFs)  -- always revert CAFs on load.

-  (cmstate2, ok, mods) <- io (cmLoadModules cmstate1 dflags graph)
+  (cmstate2, ok, mods) <- io (cmLoadModules cmstate1 graph)

   setGHCiState state{ cmstate = cmstate2, targets = files }
 
   setContextAfterLoad mods
   setGHCiState state{ cmstate = cmstate2, targets = files }
 
   setContextAfterLoad mods

+  dflags <- io (getDynFlags)

   modulesLoadedMsg ok mods dflags
 
 
 reloadModule :: String -> GHCi ()
 reloadModule "" = do
   state <- getGHCiState
   modulesLoadedMsg ok mods dflags
 
 
 reloadModule :: String -> GHCi ()
 reloadModule "" = do
   state <- getGHCiState

-  dflags <- io getDynFlags

   case targets state of
    [] -> io (putStr "no current target\n")
    paths -> do
        -- do the dependency anal first, so that if it fails we don't throw
        -- away the current set of modules.
   case targets state of
    [] -> io (putStr "no current target\n")
    paths -> do
        -- do the dependency anal first, so that if it fails we don't throw
        -- away the current set of modules.

-       graph <- io (cmDepAnal (cmstate state) dflags paths)
+       graph <- io (cmDepAnal (cmstate state) paths)

 
        io (revertCAFs)         -- always revert CAFs on reload.
        (cmstate1, ok, mods) 
 
        io (revertCAFs)         -- always revert CAFs on reload.
        (cmstate1, ok, mods) 

-               <- io (cmLoadModules (cmstate state) dflags graph)
+               <- io (cmLoadModules (cmstate state) graph)

         setGHCiState state{ cmstate=cmstate1 }
        setContextAfterLoad mods
         setGHCiState state{ cmstate=cmstate1 }
        setContextAfterLoad mods

+       dflags <- io getDynFlags

        modulesLoadedMsg ok mods dflags
 
 reloadModule _ = noArgs ":reload"
        modulesLoadedMsg ok mods dflags
 
 reloadModule _ = noArgs ":reload"

@@ -649,9 +663,7 @@ modulesLoadedMsg ok mods dflags =
 typeOfExpr :: String -> GHCi ()
 typeOfExpr str 
   = do cms <- getCmState
 typeOfExpr :: String -> GHCi ()
 typeOfExpr str 
   = do cms <- getCmState

-       dflags <- io getDynFlags
-       (new_cmstate, maybe_tystr) <- io (cmTypeOfExpr cms dflags str)
-       setCmState new_cmstate
+       maybe_tystr <- io (cmTypeOfExpr cms str)

        case maybe_tystr of
          Nothing    -> return ()
          Just tystr -> io (putStrLn tystr)
        case maybe_tystr of
          Nothing    -> return ()
          Just tystr -> io (putStrLn tystr)

@@ -674,57 +686,25 @@ browseCmd m =
 
 browseModule m exports_only = do
   cms <- getCmState
 
 browseModule m exports_only = do
   cms <- getCmState

-  dflags <- io getDynFlags

 
   is_interpreted <- io (cmModuleIsInterpreted cms m)
   when (not is_interpreted && not exports_only) $
        throwDyn (CmdLineError ("module `" ++ m ++ "' is not interpreted"))
 
 
   is_interpreted <- io (cmModuleIsInterpreted cms m)
   when (not is_interpreted && not exports_only) $
        throwDyn (CmdLineError ("module `" ++ m ++ "' is not interpreted"))
 

-  -- temporarily set the context to the module we're interested in,
+  -- Temporarily set the context to the module we're interested in,

   -- just so we can get an appropriate PrintUnqualified
   (as,bs) <- io (cmGetContext cms)
   -- just so we can get an appropriate PrintUnqualified
   (as,bs) <- io (cmGetContext cms)

-  cms1 <- io (if exports_only then cmSetContext cms dflags [] [prel,m]
-                             else cmSetContext cms dflags [m] [])
-  cms2 <- io (cmSetContext cms1 dflags as bs)
+  cms1 <- io (if exports_only then cmSetContext cms [] [prel,m]
+                             else cmSetContext cms [m] [])
+  cms2 <- io (cmSetContext cms1 as bs)

 
 

-  (cms3, things) <- io (cmBrowseModule cms2 dflags m exports_only)
-
-  setCmState cms3
+  things <- io (cmBrowseModule cms2 m exports_only)

 
   let unqual = cmGetPrintUnqual cms1 -- NOTE: cms1 with the new context
 
 
   let unqual = cmGetPrintUnqual cms1 -- NOTE: cms1 with the new context
 

-      things' = filter wantToSee things
-
-      wantToSee (AnId id) = not (isDataConId id || isDataConWrapId id)
-      wantToSee _ = True
-
-      thing_names = map getName things
-
-      thingDecl thing@(AnId id)  = ifaceTyThing thing
-
-      thingDecl thing@(AClass c) =
-        let rn_decl = ifaceTyThing thing in
-       case rn_decl of
-         ClassDecl { tcdSigs = cons } -> 
-               rn_decl{ tcdSigs = filter methodIsVisible cons }
-         other -> other
-        where
-           methodIsVisible (ClassOpSig n _ _ _) = n `elem` thing_names
-
-      thingDecl thing@(ATyCon t) =
-        let rn_decl = ifaceTyThing thing in
-       case rn_decl of
-         TyData { tcdCons = DataCons cons } -> 
-               rn_decl{ tcdCons = DataCons (filter conIsVisible cons) }
-         other -> other
-        where
-         conIsVisible (ConDecl n _ _ _ _) = n `elem` thing_names
-

   io (putStrLn (showSDocForUser unqual (
   io (putStrLn (showSDocForUser unqual (

-        vcat (map (ppr . thingDecl) things')))
-   )
-
-  where
+        vcat (map ppr things)
+      )))

 
 -----------------------------------------------------------------------------
 -- Setting the module context
 
 -----------------------------------------------------------------------------
 -- Setting the module context

@@ -743,10 +723,9 @@ setContext str
 
 newContext mods = do
   cms <- getCmState
 
 newContext mods = do
   cms <- getCmState

-  dflags <- io getDynFlags

   (as,bs) <- separate cms mods [] []
   let bs' = if null as && prel `notElem` bs then prel:bs else bs
   (as,bs) <- separate cms mods [] []
   let bs' = if null as && prel `notElem` bs then prel:bs else bs

-  cms' <- io (cmSetContext cms dflags as bs')
+  cms' <- io (cmSetContext cms as bs')

   setCmState cms'
 
 separate cmstate []           as bs = return (as,bs)
   setCmState cms'
 
 separate cmstate []           as bs = return (as,bs)

@@ -761,7 +740,6 @@ prel = "Prelude"
 
 addToContext mods = do
   cms <- getCmState
 
 addToContext mods = do
   cms <- getCmState

-  dflags <- io getDynFlags

   (as,bs) <- io (cmGetContext cms)
 
   (as',bs') <- separate cms mods [] []
   (as,bs) <- io (cmGetContext cms)
 
   (as',bs') <- separate cms mods [] []

@@ -769,14 +747,13 @@ addToContext mods = do
   let as_to_add = as' \\ (as ++ bs)
       bs_to_add = bs' \\ (as ++ bs)
 
   let as_to_add = as' \\ (as ++ bs)
       bs_to_add = bs' \\ (as ++ bs)
 

-  cms' <- io (cmSetContext cms dflags 
+  cms' <- io (cmSetContext cms

                        (as ++ as_to_add) (bs ++ bs_to_add))
   setCmState cms'
 
 
 removeFromContext mods = do
   cms <- getCmState
                        (as ++ as_to_add) (bs ++ bs_to_add))
   setCmState cms'
 
 
 removeFromContext mods = do
   cms <- getCmState

-  dflags <- io getDynFlags

   (as,bs) <- io (cmGetContext cms)
 
   (as_to_remove,bs_to_remove) <- separate cms mods [] []
   (as,bs) <- io (cmGetContext cms)
 
   (as_to_remove,bs_to_remove) <- separate cms mods [] []

@@ -784,7 +761,7 @@ removeFromContext mods = do
   let as' = as \\ (as_to_remove ++ bs_to_remove)
       bs' = bs \\ (as_to_remove ++ bs_to_remove)
 
   let as' = as \\ (as_to_remove ++ bs_to_remove)
       bs' = bs \\ (as_to_remove ++ bs_to_remove)
 

-  cms' <- io (cmSetContext cms dflags as' bs')
+  cms' <- io (cmSetContext cms as' bs')

   setCmState cms'
 
 ----------------------------------------------------------------------------
   setCmState cms'
 
 ----------------------------------------------------------------------------

@@ -829,18 +806,25 @@ setOptions wds =
       mapM_ setOpt plus_opts
 
       -- now, the GHC flags
       mapM_ setOpt plus_opts
 
       -- 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))

@@ -896,16 +880,13 @@ optToStr RevertCAFs = "r"
 
 newPackages new_pkgs = do      -- The new packages are already in v_Packages
   state    <- getGHCiState
 
 newPackages new_pkgs = do      -- The new packages are already in v_Packages
   state    <- getGHCiState

-  dflags   <- io getDynFlags
-  cmstate1 <- io (cmUnload (cmstate state) dflags)
+  cmstate1 <- io (cmUnload (cmstate state))

   setGHCiState state{ cmstate = cmstate1, targets = [] }
   setGHCiState state{ cmstate = cmstate1, targets = [] }

-
-  io $ do pkgs <- getPackageInfo
-         flushPackageCache pkgs
-
+  dflags   <- io getDynFlags
+  io (linkPackages dflags new_pkgs)

   setContextAfterLoad []
 
   setContextAfterLoad []
 

------------------------------------------------------------------------------
+-- ---------------------------------------------------------------------------

 -- code for `:show'
 
 showCmd str =
 -- code for `:show'
 
 showCmd str =

@@ -936,7 +917,8 @@ showBindings = do
   cms <- getCmState
   let
        unqual = cmGetPrintUnqual cms
   cms <- getCmState
   let
        unqual = cmGetPrintUnqual cms

-       showBinding b = putStrLn (showSDocForUser unqual (ppr (ifaceTyThing b)))
+--     showBinding b = putStrLn (showSDocForUser unqual (ppr (ifaceTyThing b)))
+       showBinding b = putStrLn (showSDocForUser unqual (ppr (getName b)))

 
   io (mapM_ showBinding (cmGetBindings cms))
   return ()
 
   io (mapM_ showBinding (cmGetBindings cms))
   return ()

@@ -1008,7 +990,7 @@ 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)

@@ -1040,14 +1022,6 @@ 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 == '.'
-
------------------------------------------------------------------------------

 -- reverting CAFs
        
 revertCAFs :: IO ()
 -- reverting CAFs
        
 revertCAFs :: IO ()

@@ -1059,3 +1033,15 @@ revertCAFs = do
 
 foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()  
        -- Make it "safe", just in case
 
 foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()  
        -- Make it "safe", just in case

+
+-- -----------------------------------------------------------------------------
+-- Utils
+
+expandPath :: String -> GHCi String
+expandPath path = 
+  case dropWhile isSpace path of
+   ('~':d) -> do
+       tilde <- io (getEnv "HOME")     -- will fail if HOME not defined
+       return (tilde ++ '/':d)
+   other -> 
+       return other