Generalise the implicit prelude import

Now it's possible to have two lists of imports:
* extra_imports are imports that are always added to the context
* prelude_imports are imports that are added if we don't have
  any open modules in scope.

No UI changes or new commands are added for now.  This was functionality
that we needed in our customized GHCi at Facebook, so I wanted to get it
upstream to reduce the differences between our version and the upstream
version.

2 files changed, 66 insertions, 18 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index d3c62e6c26..29f423869d 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -448,6 +448,7 @@ interactiveUI config srcs maybe_exprs = do
 
    default_editor <- liftIO $ findEditor
    eval_wrapper <- mkEvalWrapper default_progname default_args
+   let prelude_import = simpleImportDecl preludeModuleName
    startGHCi (runGHCi srcs maybe_exprs)
         GHCiState{ progname           = default_progname,
                    args               = default_args,
@@ -470,6 +471,8 @@ interactiveUI config srcs maybe_exprs = do
                    cmdqueue           = [],
                    remembered_ctx     = [],
                    transient_ctx      = [],
+                   extra_imports      = [],
+                   prelude_imports    = [prelude_import],
                    ghc_e              = isJust maybe_exprs,
                    short_help         = shortHelpText config,
                    long_help          = fullHelpText config,
@@ -2315,13 +2318,33 @@ setGHCContextFromGHCiState = do
       -- the actual exception thrown by checkAdd, using tryBool to
       -- turn it into a Bool.
   iidecls <- filterM (tryBool.checkAdd) (transient_ctx st ++ remembered_ctx st)
-  dflags <- GHC.getSessionDynFlags
-  GHC.setContext $
-     if xopt LangExt.ImplicitPrelude dflags && not (any isPreludeImport iidecls)
-        then iidecls ++ [implicitPreludeImport]
-        else iidecls
-    -- XXX put prel at the end, so that guessCurrentModule doesn't pick it up.
 
+  prel_iidecls <- getImplicitPreludeImports iidecls
+  valid_prel_iidecls <- filterM (tryBool . checkAdd) prel_iidecls
+
+  extra_imports <- filterM (tryBool . checkAdd) (map IIDecl (extra_imports st))
+
+  GHC.setContext $ iidecls ++ extra_imports ++ valid_prel_iidecls
+
+
+getImplicitPreludeImports :: [InteractiveImport] -> GHCi [InteractiveImport]
+getImplicitPreludeImports iidecls = do
+  dflags <- GHC.getInteractiveDynFlags
+     -- allow :seti to override -XNoImplicitPrelude
+  st <- getGHCiState
+
+  -- We add the prelude imports if there are no *-imports, and we also
+  -- allow each prelude import to be subsumed by another explicit import
+  -- of the same module.  This means that you can override the prelude import
+  -- with "import Prelude hiding (map)", for example.
+  let prel_iidecls =
+         if xopt LangExt.ImplicitPrelude dflags && not (any isIIModule iidecls)
+            then [ IIDecl imp
+                 | imp <- prelude_imports st
+                 , not (any (sameImpModule imp) iidecls) ]
+            else []
+
+  return prel_iidecls
 
 -- -----------------------------------------------------------------------------
 -- Utils on InteractiveImport
@@ -2335,6 +2358,10 @@ mkIIDecl = IIDecl . simpleImportDecl
 iiModules :: [InteractiveImport] -> [ModuleName]
 iiModules is = [m | IIModule m <- is]
 
+isIIModule :: InteractiveImport -> Bool
+isIIModule (IIModule _) = True
+isIIModule _ = False
+
 iiModuleName :: InteractiveImport -> ModuleName
 iiModuleName (IIModule m) = m
 iiModuleName (IIDecl d)   = unLoc (ideclName d)
@@ -2342,12 +2369,9 @@ iiModuleName (IIDecl d)   = unLoc (ideclName d)
 preludeModuleName :: ModuleName
 preludeModuleName = GHC.mkModuleName "Prelude"
 
-implicitPreludeImport :: InteractiveImport
-implicitPreludeImport = IIDecl (simpleImportDecl preludeModuleName)
-
-isPreludeImport :: InteractiveImport -> Bool
-isPreludeImport (IIModule {}) = True
-isPreludeImport (IIDecl d)    = unLoc (ideclName d) == preludeModuleName
+sameImpModule :: ImportDecl RdrName -> InteractiveImport -> Bool
+sameImpModule _ (IIModule _) = False -- we only care about imports here
+sameImpModule imp (IIDecl d) = unLoc (ideclName d) == unLoc (ideclName imp)
 
 addNotSubsumed :: InteractiveImport
                -> [InteractiveImport] -> [InteractiveImport]
@@ -2765,15 +2789,17 @@ showImports = do
           = ":module +*" ++ moduleNameString star_m
       show_one (IIDecl imp) = showPpr dflags imp
 
-      prel_imp
-        | any isPreludeImport (rem_ctx ++ trans_ctx) = []
-        | not (xopt LangExt.ImplicitPrelude dflags)      = []
-        | otherwise = ["import Prelude -- implicit"]
+  prel_iidecls <- getImplicitPreludeImports (rem_ctx ++ trans_ctx)
+
+  let show_prel p = show_one p ++ " -- implicit"
+      show_extra p = show_one (IIDecl p) ++ " -- fixed"
 
       trans_comment s = s ++ " -- added automatically" :: String
   --
-  liftIO $ mapM_ putStrLn (prel_imp ++ map show_one rem_ctx
-                                    ++ map (trans_comment . show_one) trans_ctx)
+  liftIO $ mapM_ putStrLn (map show_one rem_ctx ++
+                           map (trans_comment . show_one) trans_ctx ++
+                           map show_prel prel_iidecls ++
+                           map show_extra (extra_imports st))
 
 showModules :: GHCi ()
 showModules = do
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 260d92c008..244595b8b0 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -44,6 +44,8 @@ import SrcLoc
 import Module
 import GHCi
 import GHCi.RemoteTypes
+import HsSyn (ImportDecl)
+import RdrName (RdrName)
 
 import Exception
 import Numeric
@@ -106,6 +108,26 @@ data GHCiState = GHCiState
             -- :load, :reload, and :add.  In between it may be modified
             -- by :module.
 
+        extra_imports  :: [ImportDecl RdrName],
+            -- ^ These are "always-on" imports, added to the
+            -- context regardless of what other imports we have.
+            -- This is useful for adding imports that are required
+            -- by setGHCiMonad.  Be careful adding things here:
+            -- you can create ambiguities if these imports overlap
+            -- with other things in scope.
+            --
+            -- NB. although this is not currently used by GHCi itself,
+            -- it was added to support other front-ends that are based
+            -- on the GHCi code.  Potentially we could also expose
+            -- this functionality via GHCi commands.
+
+        prelude_imports :: [ImportDecl RdrName],
+            -- ^ These imports are added to the context when
+            -- -XImplicitPrelude is on and we don't have a *-module
+            -- in the context.  They can also be overridden by another
+            -- import for the same module, e.g.
+            -- "import Prelude hiding (map)"
+
         ghc_e :: Bool, -- ^ True if this is 'ghc -e' (or runghc)
 
         short_help :: String,