[commit: ghc] master: Retain ic_monad and ic_int_print from external packages after load (03c4893)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/03c4893e355948fe865bc52c744359c42e4b06d7/ghc

>---------------------------------------------------------------

commit 03c4893e355948fe865bc52c744359c42e4b06d7
Author: watashi <zejun.wu at gmail.com>
Date:   Wed May 6 07:47:04 2015 -0500

    Retain ic_monad and ic_int_print from external packages after load
    
    Retain ic_monad and ic_int_print in InteractiveContext after load
    when they are defined in external packages. This is supposed to be
    the desired behavior that the interactive-print and setGHCiMonad
    will survive after :cd, :add, :load, :reload and :set in GHCi.
    
    Test Plan:
    Install a interactive-print function and GHCi monad from extenal
    pacakge. Try :cd, :load and other commands, make sure that the
    interactive-print function and GHCi monad always keep the same.
    
    Reviewed By: simonmar
    
    Differential Revision: https://phabricator.haskell.org/D867


>---------------------------------------------------------------

03c4893e355948fe865bc52c744359c42e4b06d7
 compiler/basicTypes/Name.hs      | 13 ++++++++++++-
 compiler/main/GhcMake.hs         | 26 ++++++++++++++++++++------
 compiler/typecheck/TcRnDriver.hs | 11 +----------
 3 files changed, 33 insertions(+), 17 deletions(-)

diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index 80b7cc8..88b6e68 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -61,7 +61,7 @@ module Name (
         isValName, isVarName,
         isWiredInName, isBuiltInSyntax,
         wiredInNameTyThing_maybe,
-        nameIsLocalOrFrom, nameIsHomePackageImport,
+        nameIsLocalOrFrom, nameIsHomePackageImport, nameIsFromExternalPackage,
         stableNameCmp,
 
         -- * Class 'NamedThing' and overloaded friends
@@ -256,6 +256,17 @@ nameIsHomePackageImport this_mod
   where
     this_pkg = modulePackageKey this_mod
 
+-- | Returns True if the Name comes from some other package: neither this
+-- pacakge nor the interactive package.
+nameIsFromExternalPackage :: PackageKey -> Name -> Bool
+nameIsFromExternalPackage this_pkg name
+  | Just mod <- nameModule_maybe name
+  , modulePackageKey mod /= this_pkg    -- Not this package
+  , not (isInteractiveModule mod)       -- Not the 'interactive' package
+  = True
+  | otherwise
+  = False
+
 isTyVarName :: Name -> Bool
 isTyVarName name = isTvOcc (nameOccName name)
 
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 7d44704..7dcf379 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -47,6 +47,7 @@ import Digraph
 import Exception        ( tryIO, gbracket, gfinally )
 import FastString
 import Maybes           ( expectJust )
+import Name
 import MonadUtils       ( allM, MonadIO )
 import Outputable
 import Panic
@@ -139,12 +140,12 @@ data LoadHowMuch
 -- possible.  Depending on the target (see 'DynFlags.hscTarget') compilating
 -- and loading may result in files being created on disk.
 --
--- Calls the 'reportModuleCompilationResult' callback after each compiling
--- each module, whether successful or not.
+-- Calls the 'defaultWarnErrLogger' after each compiling each module, whether
+-- successful or not.
 --
 -- Throw a 'SourceError' if errors are encountered before the actual
 -- compilation starts (e.g., during dependency analysis).  All other errors
--- are reported using the callback.
+-- are reported using the 'defaultWarnErrLogger'.
 --
 load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
 load how_much = do
@@ -208,7 +209,7 @@ load how_much = do
     -- before we unload anything, make sure we don't leave an old
     -- interactive context around pointing to dead bindings.  Also,
     -- write the pruned HPT to allow the old HPT to be GC'd.
-    modifySession $ \_ -> discardIC $ hsc_env { hsc_HPT = pruned_hpt }
+    setSession $ discardIC $ hsc_env { hsc_HPT = pruned_hpt }
 
     liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
                             text "Stable BCO:" <+> ppr stable_bco)
@@ -392,10 +393,23 @@ discardProg hsc_env
   = discardIC $ hsc_env { hsc_mod_graph = emptyMG
                         , hsc_HPT = emptyHomePackageTable }
 
--- | Discard the contents of the InteractiveContext, but keep the DynFlags
+-- | Discard the contents of the InteractiveContext, but keep the DynFlags.
+-- It will also keep ic_int_print and ic_monad if their names are from
+-- external packages.
 discardIC :: HscEnv -> HscEnv
 discardIC hsc_env
-  = hsc_env { hsc_IC = emptyInteractiveContext (ic_dflags (hsc_IC hsc_env)) }
+  = hsc_env { hsc_IC = new_ic { ic_int_print = keep_external_name ic_int_print
+                              , ic_monad = keep_external_name ic_monad } }
+  where
+  dflags = ic_dflags old_ic
+  old_ic = hsc_IC hsc_env
+  new_ic = emptyInteractiveContext dflags
+  keep_external_name ic_name
+    | nameIsFromExternalPackage this_pkg old_name = old_name
+    | otherwise = ic_name new_ic
+    where
+    this_pkg = thisPackage dflags
+    old_name = ic_name old_ic
 
 intermediateCleanTempFiles :: DynFlags -> [ModSummary] -> HscEnv -> IO ()
 intermediateCleanTempFiles dflags summaries hsc_env
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 30cd8fd..ec22699 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -2027,20 +2027,11 @@ loadUnqualIfaces hsc_env ictxt
     unqual_mods = [ nameModule name
                   | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt)
                   , let name = gre_name gre
-                  , from_external_package name
+                  , nameIsFromExternalPackage this_pkg name
                   , isTcOcc (nameOccName name)   -- Types and classes only
                   , unQualOK gre ]               -- In scope unqualified
     doc = ptext (sLit "Need interface for module whose export(s) are in scope unqualified")
 
-    from_external_package name  -- True <=> the Name comes from some other package
-                                --          (not the home package, not the interactive package)
-      | Just mod <- nameModule_maybe name
-      , modulePackageKey mod /= this_pkg    -- Not the home package
-      , not (isInteractiveModule mod)       -- Not the 'interactive' package
-      = True
-      | otherwise
-      = False
-
 
 {-
 ************************************************************************