[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 3cfd5d2..a1ec764 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
 {-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------

--- $Id: InteractiveUI.hs,v 1.142 2002/12/27 12:20:06 panne 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,21 +17,13 @@ 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, 
-                         linkPackages )
+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 Module          ( showModMsg, lookupModuleEnv )
 import Name            ( Name, isHomePackageName, nameSrcLoc, nameOccName,
                          NamedThing(..) )

@@ -41,11 +33,15 @@ 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

@@ -73,7 +69,7 @@ import GHC.Exts               ( unsafeCoerce# )
 
 import Data.IORef      ( IORef, newIORef, readIORef, writeIORef )
 
 
 import Data.IORef      ( IORef, newIORef, readIORef, writeIORef )
 

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

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

@@ -88,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),

@@ -109,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.

@@ -148,40 +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
 

-   initLinker
+   cmstate <- cmInit Interactive dflags;

 
 

-       -- 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
+   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 = [] }
 

@@ -191,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

@@ -224,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
 
 

@@ -270,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

@@ -352,6 +348,7 @@ runCommand c = ghciHandle handler (doCommand c)
 handler :: Exception -> GHCi Bool
 handler exception = do
   flushInterpBuffers
 handler :: Exception -> GHCi Bool
 handler exception = do
   flushInterpBuffers

+  io installSignalHandlers

   ghciHandle handler (showException exception >> return False)
 
 showException (DynException dyn) =
   ghciHandle handler (showException exception >> return False)
 
 showException (DynException dyn) =

@@ -376,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 []

@@ -393,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

@@ -432,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 ()

@@ -471,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))))
          )

@@ -483,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"]

@@ -506,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

@@ -521,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

@@ -563,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 --

@@ -590,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"

@@ -656,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)

@@ -681,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

@@ -750,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)

@@ -768,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 [] []

@@ -776,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 [] []

@@ -791,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'
 
 ----------------------------------------------------------------------------

@@ -910,9 +880,9 @@ 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 = [] }

+  dflags   <- io getDynFlags

   io (linkPackages dflags new_pkgs)
   setContextAfterLoad []
 
   io (linkPackages dflags new_pkgs)
   setContextAfterLoad []
 

@@ -947,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 ()

@@ -1062,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