Tidy up the ic_exports field of the InteractiveContext. Previously

was [(Module, Maybe ImportDecl)], now it is just [ImportDecl].  So now
":m +A" and "import A" do exactly the same thing in GHCi, and use the
same code paths.

diff --git a/compiler/hsSyn/HsImpExp.lhs b/compiler/hsSyn/HsImpExp.lhs
index 5015999..176182e 100644 (file)
--- a/compiler/hsSyn/HsImpExp.lhs
+++ b/compiler/hsSyn/HsImpExp.lhs
@@ -15,7 +15,7 @@ import HsDoc          ( HsDocString )
 
 import Outputable
 import FastString
 
 import Outputable
 import FastString

-import SrcLoc          ( Located(..) )
+import SrcLoc           ( Located(..), noLoc )

 
 import Data.Data
 \end{code}
 
 import Data.Data
 \end{code}

@@ -40,6 +40,16 @@ data ImportDecl name
       ideclAs        :: Maybe ModuleName,   -- ^ as Module
       ideclHiding    :: Maybe (Bool, [LIE name]) -- ^ (True => hiding, names)
     } deriving (Data, Typeable)
       ideclAs        :: Maybe ModuleName,   -- ^ as Module
       ideclHiding    :: Maybe (Bool, [LIE name]) -- ^ (True => hiding, names)
     } deriving (Data, Typeable)

+
+simpleImportDecl :: ModuleName -> ImportDecl name
+simpleImportDecl mn = ImportDecl {
+      ideclName      = noLoc mn,
+      ideclPkgQual   = Nothing,
+      ideclSource    = False,
+      ideclQualified = False,
+      ideclAs        = Nothing,
+      ideclHiding    = Nothing
+    }

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 22aa3f4..77e69fd 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -863,37 +863,47 @@ emptyModIface mod
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

--- | Interactive context, recording information relevant to GHCi
+-- | Interactive context, recording information about the state of the
+-- context in which statements are executed in a GHC session.
+--

 data InteractiveContext 
   = InteractiveContext { 
 data InteractiveContext 
   = InteractiveContext { 

-          ic_toplev_scope :: [Module]   -- ^ The context includes the "top-level" scope of
-                                       -- these modules
-
-        , ic_exports :: [(Module, Maybe (ImportDecl RdrName))]    -- ^ The context includes just the exported parts of these
-                                       -- modules
-
-        , ic_rn_gbl_env :: GlobalRdrEnv -- ^ The contexts' cached 'GlobalRdrEnv', built from
-                                       -- 'ic_toplev_scope' and 'ic_exports'
-
-        , ic_tmp_ids :: [Id]   -- ^ Names bound during interaction with the user.
-                               -- Later Ids shadow earlier ones with the same OccName
-                               -- Expressions are typed with these Ids in the envt
-                               -- For runtime-debugging, these Ids may have free
-                               -- TcTyVars of RuntimUnkSkol flavour, but no free TyVars
-                               -- (because the typechecker doesn't expect that)
+         -- These two fields are only stored here so that the client
+         -- can retrieve them with GHC.getContext.  GHC itself doesn't
+         -- use them, but it does reset them to empty sometimes (such
+         -- as before a GHC.load).  The context is set with GHC.setContext.
+         ic_toplev_scope :: [Module],
+             -- ^ The context includes the "top-level" scope of
+             -- these modules
+         ic_imports :: [ImportDecl RdrName],
+             -- ^ The context is extended with these import declarations
+
+         ic_rn_gbl_env :: GlobalRdrEnv,
+             -- ^ The contexts' cached 'GlobalRdrEnv', built by
+             -- 'InteractiveEval.setContext'
+
+         ic_tmp_ids :: [Id],
+             -- ^ Names bound during interaction with the user.  Later
+             -- Ids shadow earlier ones with the same OccName
+             -- Expressions are typed with these Ids in the envt For
+             -- runtime-debugging, these Ids may have free TcTyVars of
+             -- RuntimUnkSkol flavour, but no free TyVars (because the
+             -- typechecker doesn't expect that)

 
 #ifdef GHCI
 
 #ifdef GHCI

-        , ic_resume :: [Resume]         -- ^ The stack of breakpoint contexts
+         ic_resume :: [Resume],
+             -- ^ The stack of breakpoint contexts

 #endif
 
 #endif
 

-        , ic_cwd :: Maybe FilePath      -- virtual CWD of the program
+         ic_cwd :: Maybe FilePath
+             -- virtual CWD of the program

     }
 
 
 emptyInteractiveContext :: InteractiveContext
 emptyInteractiveContext
   = InteractiveContext { ic_toplev_scope = [],
     }
 
 
 emptyInteractiveContext :: InteractiveContext
 emptyInteractiveContext
   = InteractiveContext { ic_toplev_scope = [],

-                        ic_exports = [],
+                         ic_imports = [],

                         ic_rn_gbl_env = emptyGlobalRdrEnv,
                         ic_tmp_ids = []
 #ifdef GHCI
                         ic_rn_gbl_env = emptyGlobalRdrEnv,
                         ic_tmp_ids = []
 #ifdef GHCI

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index e0a30b4..bb5fab6 100644 (file)
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -40,10 +40,9 @@ module InteractiveEval (
 
 import GhcMonad
 import HscMain
 
 import GhcMonad
 import HscMain

-import HsSyn (ImportDecl)
+import HsSyn

 import HscTypes
 import HscTypes

-import TcRnDriver
-import RnNames         (gresFromAvails)
+import RnNames          (gresFromAvails)

 import InstEnv
 import Type
 import TcType          hiding( typeKind )
 import InstEnv
 import Type
 import TcType          hiding( typeKind )

@@ -68,14 +67,13 @@ import ErrUtils
 import SrcLoc
 import BreakArray
 import RtClosureInspect
 import SrcLoc
 import BreakArray
 import RtClosureInspect

-import BasicTypes

 import Outputable
 import FastString
 import MonadUtils
 
 import System.Directory
 import Data.Dynamic
 import Outputable
 import FastString
 import MonadUtils
 
 import System.Directory
 import Data.Dynamic

-import Data.List (find, partition)
+import Data.List (find)

 import Control.Monad
 import Foreign hiding (unsafePerformIO)
 import Foreign.C
 import Control.Monad
 import Foreign hiding (unsafePerformIO)
 import Foreign.C

@@ -779,37 +777,27 @@ fromListBL bound l = BL (length l) bound l []
 -- module.  They always shadow anything in scope in the current context.
 setContext :: GhcMonad m =>
         [Module]       -- ^ entire top level scope of these modules
 -- module.  They always shadow anything in scope in the current context.
 setContext :: GhcMonad m =>
         [Module]       -- ^ entire top level scope of these modules

-        -> [(Module, Maybe (ImportDecl RdrName))]      -- ^ exports of these modules
+        -> [ImportDecl RdrName]       -- ^ these import declarations

         -> m ()
         -> m ()

-setContext toplev_mods other_mods = do
+setContext toplev_mods import_decls = do

     hsc_env <- getSession
     let old_ic  = hsc_IC     hsc_env
         hpt     = hsc_HPT    hsc_env
     hsc_env <- getSession
     let old_ic  = hsc_IC     hsc_env
         hpt     = hsc_HPT    hsc_env

-        (decls,mods)   = partition (isJust . snd) other_mods -- time for tracing
-        export_mods = map fst mods
-        imprt_decls = map noLoc (catMaybes (map snd decls))
+        imprt_decls = map noLoc import_decls

     --
     --

-    export_env  <- liftIO $ mkExportEnv hsc_env export_mods

     import_env  <-
         if null imprt_decls then return emptyGlobalRdrEnv else do
             let this_mod | null toplev_mods = pRELUDE
                          | otherwise        = head toplev_mods
             liftIO $ hscRnImportDecls hsc_env this_mod imprt_decls
     import_env  <-
         if null imprt_decls then return emptyGlobalRdrEnv else do
             let this_mod | null toplev_mods = pRELUDE
                          | otherwise        = head toplev_mods
             liftIO $ hscRnImportDecls hsc_env this_mod imprt_decls

+

     toplev_envs <- liftIO $ mapM (mkTopLevEnv hpt) toplev_mods
     toplev_envs <- liftIO $ mapM (mkTopLevEnv hpt) toplev_mods

-    let all_env = foldr plusGlobalRdrEnv (plusGlobalRdrEnv export_env import_env) toplev_envs
+
+    let all_env = foldr plusGlobalRdrEnv import_env toplev_envs

     modifySession $ \_ ->
         hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplev_mods,
     modifySession $ \_ ->
         hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplev_mods,

-                        ic_exports      = other_mods,
-                        ic_rn_gbl_env   = all_env }}
-
--- Make a GlobalRdrEnv based on the exports of the modules only.
-mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
-mkExportEnv hsc_env mods
-  = do { stuff <- mapM (getModuleExports hsc_env) mods
-       ; let (_msgs, mb_name_sets) = unzip stuff
-            envs = [ availsToGlobalRdrEnv (moduleName mod) avails
-                    | (Just avails, mod) <- zip mb_name_sets mods ]
-       ; return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs }
+                                   ic_imports      = import_decls,
+                                   ic_rn_gbl_env   = all_env }}

 
 availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv
 availsToGlobalRdrEnv mod_name avails
 
 availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv
 availsToGlobalRdrEnv mod_name avails

@@ -837,9 +825,9 @@ mkTopLevEnv hpt modl
 -- | Get the interactive evaluation context, consisting of a pair of the
 -- set of modules from which we take the full top-level scope, and the set
 -- of modules from which we take just the exports respectively.
 -- | Get the interactive evaluation context, consisting of a pair of the
 -- set of modules from which we take the full top-level scope, and the set
 -- of modules from which we take just the exports respectively.

-getContext :: GhcMonad m => m ([Module],[(Module, Maybe (ImportDecl RdrName))])
+getContext :: GhcMonad m => m ([Module],[ImportDecl RdrName])

 getContext = withSession $ \HscEnv{ hsc_IC=ic } ->
 getContext = withSession $ \HscEnv{ hsc_IC=ic } ->

-              return (ic_toplev_scope ic, ic_exports ic)
+               return (ic_toplev_scope ic, ic_imports ic)

 
 -- | Returns @True@ if the specified module is interpreted, and hence has
 -- its full top-level scope available.
 
 -- | Returns @True@ if the specified module is interpreted, and hence has
 -- its full top-level scope available.

@@ -949,15 +937,9 @@ compileExpr expr = withSession $ \hsc_env -> do
 
 dynCompileExpr :: GhcMonad m => String -> m Dynamic
 dynCompileExpr expr = do
 
 dynCompileExpr :: GhcMonad m => String -> m Dynamic
 dynCompileExpr expr = do

-    (full,exports) <- getContext
-    setContext full $
-        (mkModule
-            (stringToPackageId "base") (mkModuleName "Data.Dynamic")
-        ,Nothing):exports

     let stmt = "let __dynCompileExpr = Data.Dynamic.toDyn (" ++ expr ++ ")"
     Just (ids, hvals) <- withSession $ \hsc_env -> 
                            liftIO $ hscStmt hsc_env stmt
     let stmt = "let __dynCompileExpr = Data.Dynamic.toDyn (" ++ expr ++ ")"
     Just (ids, hvals) <- withSession $ \hsc_env -> 
                            liftIO $ hscStmt hsc_env stmt

-    setContext full exports

     vals <- liftIO (unsafeCoerce# hvals :: IO [Dynamic])
     case (ids,vals) of
         (_:[], v:[])    -> return v
     vals <- liftIO (unsafeCoerce# hvals :: IO [Dynamic])
     case (ids,vals) of
         (_:[], v:[])    -> return v

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 5aa6959..7af30ba 100644 (file)
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -1366,18 +1366,14 @@ tcRnType hsc_env ictxt rdr_type
 -- could not be found.
 getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe [AvailInfo])
 getModuleExports hsc_env mod
 -- could not be found.
 getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe [AvailInfo])
 getModuleExports hsc_env mod

-  = let
-      ic        = hsc_IC hsc_env
-      checkMods = ic_toplev_scope ic ++ map fst (ic_exports ic)
-    in
-    initTc hsc_env HsSrcFile False iNTERACTIVE (tcGetModuleExports mod checkMods)
+  = initTc hsc_env HsSrcFile False iNTERACTIVE (tcGetModuleExports mod)

 
 -- Get the export avail info and also load all orphan and family-instance
 -- modules.  Finally, check that the family instances of all modules in the
 -- interactive context are consistent (these modules are in the second
 -- argument).
 
 -- Get the export avail info and also load all orphan and family-instance
 -- modules.  Finally, check that the family instances of all modules in the
 -- interactive context are consistent (these modules are in the second
 -- argument).

-tcGetModuleExports :: Module -> [Module] -> TcM [AvailInfo]
-tcGetModuleExports mod directlyImpMods
+tcGetModuleExports :: Module -> TcM [AvailInfo]
+tcGetModuleExports mod

   = do { let doc = ptext (sLit "context for compiling statements")
        ; iface <- initIfaceTcRn $ loadSysInterface doc mod
 
   = do { let doc = ptext (sLit "context for compiling statements")
        ; iface <- initIfaceTcRn $ loadSysInterface doc mod
 

@@ -1385,10 +1381,6 @@ tcGetModuleExports mod directlyImpMods
                -- interfaces, so their instances are visible.
        ; loadOrphanModules (dep_orphs (mi_deps iface)) False 
 
                -- interfaces, so their instances are visible.
        ; loadOrphanModules (dep_orphs (mi_deps iface)) False 
 

-                -- Check that the family instances of all directly loaded
-                -- modules are consistent.
-       ; checkFamInstConsistency (dep_finsts (mi_deps iface)) directlyImpMods
-

        ; ifaceExportNames (mi_exports iface)
        }
 
        ; ifaceExportNames (mi_exports iface)
        }
 

diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index 2aff483..52b28ef 100644 (file)
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -56,7 +56,7 @@ data GHCiState = GHCiState
        editor         :: String,
         stop           :: String,
        options        :: [GHCiOption],
        editor         :: String,
         stop           :: String,
        options        :: [GHCiOption],

-        prelude        :: GHC.Module,
+        prelude        :: GHC.ModuleName,

         line_number    :: !Int,         -- input line
         break_ctr      :: !Int,
         breaks         :: ![(Int, BreakLocation)],
         line_number    :: !Int,         -- input line
         break_ctr      :: !Int,
         breaks         :: ![(Int, BreakLocation)],

@@ -78,7 +78,7 @@ data GHCiState = GHCiState
         ghc_e :: Bool -- True if this is 'ghc -e' (or runghc)
      }
 
         ghc_e :: Bool -- True if this is 'ghc -e' (or runghc)
      }
 

-data CtxtCmd   -- In each case, the first [String] are the starred modules
+data CtxtCmd    -- In each case, the first [String] are the starred modules

                -- and the second are the unstarred ones
   = SetContext [String] [String]
   | AddModules [String] [String]
                -- and the second are the unstarred ones
   = SetContext [String] [String]
   | AddModules [String] [String]

@@ -210,7 +210,7 @@ instance ExceptionMonad (InputT GHCi) where
   gunblock = Haskeline.unblock
 
 -- for convenience...
   gunblock = Haskeline.unblock
 
 -- for convenience...

-getPrelude :: GHCi Module
+getPrelude :: GHCi ModuleName

 getPrelude = getGHCiState >>= return . prelude
 
 getDynFlags :: GhcMonad m => m DynFlags
 getPrelude = getGHCiState >>= return . prelude
 
 getDynFlags :: GhcMonad m => m DynFlags

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 0f68607..757b634 100644 (file)
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -137,7 +137,7 @@ builtin_commands = [
   ("kind",      keepGoing' kindOfType,          completeIdentifier),
   ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
   ("list",      keepGoing' listCmd,             noCompletion),
   ("kind",      keepGoing' kindOfType,          completeIdentifier),
   ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
   ("list",      keepGoing' listCmd,             noCompletion),

-  ("module",    keepGoing setContext,           completeSetModule),
+  ("module",    keepGoing moduleCmd,            completeSetModule),

   ("main",      keepGoing runMain,              completeFilename),
   ("print",     keepGoing printCmd,             completeExpression),
   ("quit",      quit,                           noCompletion),
   ("main",      keepGoing runMain,              completeFilename),
   ("print",     keepGoing printCmd,             completeExpression),
   ("quit",      quit,                           noCompletion),

@@ -346,8 +346,8 @@ interactiveUI srcs maybe_exprs = do
 #endif
 
    -- initial context is just the Prelude
 #endif
 
    -- initial context is just the Prelude

-   prel_mod <- GHC.lookupModule (GHC.mkModuleName "Prelude") Nothing
-   GHC.setContext [] [(prel_mod, Nothing)]
+   let prel_mn = GHC.mkModuleName "Prelude"
+   GHC.setContext [] [simpleImportDecl prel_mn]

 
    default_editor <- liftIO $ findEditor
 
 
    default_editor <- liftIO $ findEditor
 

@@ -359,7 +359,7 @@ interactiveUI srcs maybe_exprs = do
                    editor = default_editor,
 --                   session = session,
                    options = [],
                    editor = default_editor,
 --                   session = session,
                    options = [],

-                   prelude = prel_mod,
+                   prelude = prel_mn,

                    line_number = 1,
                    break_ctr = 0,
                    breaks = [],
                    line_number = 1,
                    break_ctr = 0,
                    breaks = [],

@@ -544,7 +544,7 @@ fileLoop hdl = do
 
 mkPrompt :: GHCi String
 mkPrompt = do
 
 mkPrompt :: GHCi String
 mkPrompt = do

-  (toplevs,exports) <- GHC.getContext
+  (toplevs,imports) <- GHC.getContext

   resumes <- GHC.getResumeContext
   -- st <- getGHCiState
 
   resumes <- GHC.getResumeContext
   -- st <- getGHCiState
 

@@ -570,7 +570,7 @@ mkPrompt = do
        --  hsep (map (\m -> text "!*" <> ppr (GHC.moduleName m)) btoplevs) <+>
        --  hsep (map (\m -> char '!'  <> ppr (GHC.moduleName m)) bexports) <+>
              hsep (map (\m -> char '*'  <> ppr (GHC.moduleName m)) toplevs) <+>
        --  hsep (map (\m -> text "!*" <> ppr (GHC.moduleName m)) btoplevs) <+>
        --  hsep (map (\m -> char '!'  <> ppr (GHC.moduleName m)) bexports) <+>
              hsep (map (\m -> char '*'  <> ppr (GHC.moduleName m)) toplevs) <+>

-             hsep (map (ppr . GHC.moduleName) (nub (map fst exports)))
+             hsep (map ppr (nub (map ideclName imports)))

 
         deflt_prompt = dots <> context_bit <> modules_bit
 
 
         deflt_prompt = dots <> context_bit <> modules_bit
 

@@ -1151,7 +1151,7 @@ reloadModule m = do
                   else LoadUpTo (GHC.mkModuleName m)
   return ()
 
                   else LoadUpTo (GHC.mkModuleName m)
   return ()
 

-doLoad :: Bool -> ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> LoadHowMuch -> InputT GHCi SuccessFlag
+doLoad :: Bool -> ([Module],[ImportDecl RdrName]) -> LoadHowMuch -> InputT GHCi SuccessFlag

 doLoad retain_context prev_context howmuch = do
   -- turn off breakpoints before we load: we can't turn them off later, because
   -- the ModBreaks will have gone away.
 doLoad retain_context prev_context howmuch = do
   -- turn off breakpoints before we load: we can't turn them off later, because
   -- the ModBreaks will have gone away.

@@ -1160,7 +1160,7 @@ doLoad retain_context prev_context howmuch = do
   afterLoad ok retain_context prev_context
   return ok
 
   afterLoad ok retain_context prev_context
   return ok
 

-afterLoad :: SuccessFlag -> Bool -> ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> InputT GHCi ()
+afterLoad :: SuccessFlag -> Bool -> ([Module],[ImportDecl RdrName]) -> InputT GHCi ()

 afterLoad ok retain_context prev_context = do
   lift revertCAFs  -- always revert CAFs on load.
   lift discardTickArrays
 afterLoad ok retain_context prev_context = do
   lift revertCAFs  -- always revert CAFs on load.
   lift discardTickArrays

@@ -1172,10 +1172,10 @@ afterLoad ok retain_context prev_context = do
   lift $ setContextAfterLoad prev_context retain_context loaded_mod_summaries
 
 
   lift $ setContextAfterLoad prev_context retain_context loaded_mod_summaries
 
 

-setContextAfterLoad :: ([Module],[(Module, Maybe (ImportDecl RdrName))]) -> Bool -> [GHC.ModSummary] -> GHCi ()
+setContextAfterLoad :: ([Module],[ImportDecl RdrName]) -> Bool -> [GHC.ModSummary] -> GHCi ()

 setContextAfterLoad prev keep_ctxt [] = do
   prel_mod <- getPrelude
 setContextAfterLoad prev keep_ctxt [] = do
   prel_mod <- getPrelude

-  setContextKeepingPackageModules prev keep_ctxt ([], [(prel_mod, Nothing)])
+  setContextKeepingPackageModules prev keep_ctxt ([], [simpleImportDecl prel_mod])

 setContextAfterLoad prev keep_ctxt ms = do
   -- load a target if one is available, otherwise load the topmost module.
   targets <- GHC.getTargets
 setContextAfterLoad prev keep_ctxt ms = do
   -- load a target if one is available, otherwise load the topmost module.
   targets <- GHC.getTargets

@@ -1203,25 +1203,40 @@ setContextAfterLoad prev keep_ctxt ms = do
        if b then setContextKeepingPackageModules prev keep_ctxt ([m], [])
                     else do
                 prel_mod <- getPrelude
        if b then setContextKeepingPackageModules prev keep_ctxt ([m], [])
                     else do
                 prel_mod <- getPrelude

-                setContextKeepingPackageModules prev keep_ctxt ([],[(prel_mod,Nothing),(m,Nothing)])
+                setContextKeepingPackageModules prev keep_ctxt
+                  ([], [simpleImportDecl prel_mod,
+                        simpleImportDecl (GHC.moduleName m)])

 
 -- | Keep any package modules (except Prelude) when changing the context.
 setContextKeepingPackageModules
 
 -- | Keep any package modules (except Prelude) when changing the context.
 setContextKeepingPackageModules

-        :: ([Module],[(Module, Maybe (ImportDecl RdrName))])          -- previous context
+        :: ([Module],[ImportDecl RdrName])          -- previous context

         -> Bool                         -- re-execute :module commands
         -> Bool                         -- re-execute :module commands

-        -> ([Module],[(Module, Maybe (ImportDecl RdrName))])          -- new context
+        -> ([Module],[ImportDecl RdrName])          -- new context

         -> GHCi ()
 setContextKeepingPackageModules prev_context keep_ctxt (as,bs) = do
         -> GHCi ()
 setContextKeepingPackageModules prev_context keep_ctxt (as,bs) = do

-  let (_,bs0) = prev_context
+  let (_,imports0) = prev_context

   prel_mod <- getPrelude
   -- filter everything, not just lefts
   prel_mod <- getPrelude
   -- filter everything, not just lefts

-  let pkg_modules = filter ((\p -> not (isHomeModule p) && p /= prel_mod) . fst) bs0
-  let bs1 = if null as then nubBy sameFst ((prel_mod,Nothing) : bs) else bs
-  GHC.setContext as (nubBy sameFst (bs1 ++ pkg_modules))
+
+  let is_pkg_mod i
+         | unLoc (ideclName i) == prel_mod = return False
+         | otherwise = do
+              e <- gtry $ GHC.findModule (unLoc (ideclName i)) (ideclPkgQual i)
+              case e :: Either SomeException Module of
+                Left _  -> return False
+                Right m -> return (not (isHomeModule m))
+
+  pkg_modules <- filterM is_pkg_mod imports0
+
+  let bs1 = if null as
+               then nubBy sameMod (simpleImportDecl prel_mod : bs)
+               else bs
+
+  GHC.setContext as (nubBy sameMod (bs1 ++ pkg_modules))

   if keep_ctxt
      then do
           st <- getGHCiState
   if keep_ctxt
      then do
           st <- getGHCiState

-          mapM_ (playCtxtCmd False) (remembered_ctx st)
+          playCtxtCmds False (remembered_ctx st)

      else do
           st <- getGHCiState
           setGHCiState st{ remembered_ctx = [] }
      else do
           st <- getGHCiState
           setGHCiState st{ remembered_ctx = [] }

@@ -1229,8 +1244,8 @@ setContextKeepingPackageModules prev_context keep_ctxt (as,bs) = do
 isHomeModule :: Module -> Bool
 isHomeModule mod = GHC.modulePackageId mod == mainPackageId
 
 isHomeModule :: Module -> Bool
 isHomeModule mod = GHC.modulePackageId mod == mainPackageId
 

-sameFst :: (Module, Maybe (ImportDecl RdrName)) -> (Module, Maybe (ImportDecl RdrName)) -> Bool
-sameFst x y = fst x == fst y
+sameMod :: ImportDecl RdrName -> ImportDecl RdrName -> Bool
+sameMod x y = unLoc (ideclName x) == unLoc (ideclName y)

 
 modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> InputT GHCi ()
 modulesLoadedMsg ok mods = do
 
 modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> InputT GHCi ()
 modulesLoadedMsg ok mods = do

@@ -1321,7 +1336,10 @@ browseCmd bang m =
                 -- recently-added module occurs last, it seems.
         case (as,bs) of
           (as@(_:_), _)   -> browseModule bang (last as) True
                 -- recently-added module occurs last, it seems.
         case (as,bs) of
           (as@(_:_), _)   -> browseModule bang (last as) True

-          ([],  bs@(_:_)) -> browseModule bang (fst (last bs)) True
+          ([],  bs@(_:_)) -> do
+             let i = last bs
+             m <- GHC.findModule (unLoc (ideclName i)) (ideclPkgQual i)
+             browseModule bang m True

           ([], [])  -> ghcError (CmdLineError ":browse: no current module")
     _ -> ghcError (CmdLineError "syntax:  :browse <module>")
 
           ([], [])  -> ghcError (CmdLineError ":browse: no current module")
     _ -> ghcError (CmdLineError "syntax:  :browse <module>")
 

@@ -1337,7 +1355,8 @@ browseModule bang modl exports_only = do
   -- just so we can get an appropriate PrintUnqualified
   (as,bs) <- GHC.getContext
   prel_mod <- lift getPrelude
   -- just so we can get an appropriate PrintUnqualified
   (as,bs) <- GHC.getContext
   prel_mod <- lift getPrelude

-  if exports_only then GHC.setContext [] [(prel_mod,Nothing), (modl,Nothing)]
+  if exports_only then GHC.setContext [] [simpleImportDecl prel_mod,
+                                          simpleImportDecl (GHC.moduleName modl)]

                   else GHC.setContext [modl] []
   target_unqual <- GHC.getPrintUnqual
   GHC.setContext as bs
                   else GHC.setContext [modl] []
   target_unqual <- GHC.getPrintUnqual
   GHC.setContext as bs

@@ -1415,13 +1434,13 @@ browseModule bang modl exports_only = do
 
 newContextCmd :: CtxtCmd -> GHCi ()
 newContextCmd cmd = do
 
 newContextCmd :: CtxtCmd -> GHCi ()
 newContextCmd cmd = do

-  playCtxtCmd True cmd
+  playCtxtCmds True [cmd]

   st <- getGHCiState
   let cmds = remembered_ctx st
   setGHCiState st{ remembered_ctx = cmds ++ [cmd] }
 
   st <- getGHCiState
   let cmds = remembered_ctx st
   setGHCiState st{ remembered_ctx = cmds ++ [cmd] }
 

-setContext :: String -> GHCi ()
-setContext str
+moduleCmd :: String -> GHCi ()
+moduleCmd str

   | all sensible strs = newContextCmd cmd
   | otherwise = ghcError (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
   where
   | all sensible strs = newContextCmd cmd
   | otherwise = ghcError (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
   where

@@ -1441,53 +1460,65 @@ setContext str
     starred ('*':m) = Left m
     starred m       = Right m
 
     starred ('*':m) = Left m
     starred m       = Right m
 

-playCtxtCmd:: Bool -> CtxtCmd -> GHCi ()
-playCtxtCmd fail cmd = do
-    (prev_as,prev_bs) <- GHC.getContext
+type Context = ([GHC.Module], [GHC.ImportDecl GHC.RdrName])
+
+playCtxtCmds :: Bool -> [CtxtCmd] -> GHCi ()
+playCtxtCmds fail cmds = do
+  ctx <- GHC.getContext
+  (as,bs) <- foldM (playCtxtCmd fail) ctx cmds
+  GHC.setContext as bs
+
+playCtxtCmd:: Bool -> Context -> CtxtCmd -> GHCi Context
+playCtxtCmd fail (prev_as, prev_bs) cmd = do

     case cmd of
         SetContext as bs -> do
           (as',bs') <- do_checks as bs
           prel_mod <- getPrelude
     case cmd of
         SetContext as bs -> do
           (as',bs') <- do_checks as bs
           prel_mod <- getPrelude

-          let bs'' = if null as && prel_mod `notElem` (map fst bs')
-                        then (prel_mod,Nothing):bs'
+          let bs'' = if null as && prel_mod `notElem` bs'
+                        then prel_mod : bs'

                         else bs'
                         else bs'

-          GHC.setContext as' bs''
+          return (as', map simpleImportDecl bs'')

 
         AddModules as bs -> do
           (as',bs') <- do_checks as bs
 
         AddModules as bs -> do
           (as',bs') <- do_checks as bs

-          -- it should replace the old stuff, not the other way around
-          -- need deleteAllBy, not deleteFirstsBy for sameFst
-          let remaining_as = prev_as \\ (as' ++ map fst bs')
-              remaining_bs = deleteAllBy sameFst prev_bs (bs' ++ map contextualize as')
-          GHC.setContext (remaining_as ++ as') (remaining_bs ++ bs')
+          let (remaining_as, remaining_bs) =
+                   prev_without (map moduleName as' ++ bs')
+          return (remaining_as ++ as', remaining_bs ++ map simpleImportDecl bs')

 
         RemModules as bs -> do
           (as',bs') <- do_checks as bs
 
         RemModules as bs -> do
           (as',bs') <- do_checks as bs

-          let new_as = prev_as \\ (as' ++ map fst bs')
-              new_bs = deleteAllBy sameFst prev_bs (map contextualize as' ++ bs')
-          GHC.setContext new_as new_bs
+          let (new_as, new_bs) = prev_without (map moduleName as' ++ bs')
+          return (new_as, new_bs)

 
         Import str -> do
           m_idecl <- maybe_fail $ GHC.parseImportDecl str
           case m_idecl of
 
         Import str -> do
           m_idecl <- maybe_fail $ GHC.parseImportDecl str
           case m_idecl of

-            Nothing    -> return ()
+            Nothing    -> return (prev_as, prev_bs)

             Just idecl -> do
               m_mdl <- maybe_fail $ loadModuleName idecl
               case m_mdl of
             Just idecl -> do
               m_mdl <- maybe_fail $ loadModuleName idecl
               case m_mdl of

-                Nothing -> return ()
-                Just m -> GHC.setContext prev_as (prev_bs ++ [(m, Just idecl)])
-    
+                Nothing -> return (prev_as, prev_bs)
+                Just _  -> return (prev_as,  prev_bs ++ [idecl])
+                     -- we don't filter the module out of the old declarations,
+                     -- because 'import' is supposed to be cumulative.

   where
     maybe_fail | fail      = liftM Just
                | otherwise = trymaybe
 
   where
     maybe_fail | fail      = liftM Just
                | otherwise = trymaybe
 

+    prev_without names = (as',bs')
+      where as' = deleteAllBy sameModName prev_as names
+            bs' = deleteAllBy importsSameMod prev_bs names
+

     do_checks as bs = do
          as' <- mapM (maybe_fail . wantInterpretedModule) as
     do_checks as bs = do
          as' <- mapM (maybe_fail . wantInterpretedModule) as

-         bs' <- mapM (maybe_fail . lookupModule) bs
-         return (catMaybes as', map contextualize (catMaybes bs'))
+         bs' <- mapM (maybe_fail . liftM moduleName . lookupModule) bs
+         return (catMaybes as', catMaybes bs')
+
+    sameModName a b = moduleName a == b
+    importsSameMod a b = unLoc (ideclName a) == b

 
 

-    contextualize x = (x,Nothing)
-    deleteAllBy f a b = filter (\x->(not (any (f x) b))) a
+    deleteAllBy :: (a -> b -> Bool) -> [a] -> [b] -> [a]
+    deleteAllBy f as bs = filter (\a-> not (any (f a) bs)) as

 
 trymaybe ::GHCi a -> GHCi (Maybe a)
 trymaybe m = do
 
 trymaybe ::GHCi a -> GHCi (Maybe a)
 trymaybe m = do

@@ -1828,8 +1859,8 @@ completeModule = wrapIdentCompleter $ \w -> do
 completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
   modules <- case m of
     Just '-' -> do
 completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
   modules <- case m of
     Just '-' -> do

-      (toplevs, exports) <- GHC.getContext
-      return $ map GHC.moduleName (nub (map fst exports) ++ toplevs)
+      (toplevs, imports) <- GHC.getContext
+      return $ map GHC.moduleName toplevs ++ map (unLoc.ideclName) imports

     _ -> do
       dflags <- GHC.getSessionDynFlags
       let pkg_mods = allExposedModules dflags
     _ -> do
       dflags <- GHC.getSessionDynFlags
       let pkg_mods = allExposedModules dflags