update to current master againwip/T13904

5 files changed, 260 insertions, 51 deletions

diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs
new file mode 100644
index 0000000000..47fed9c28f
--- /dev/null
+++ b/ghc/GHCi/Leak.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE RecordWildCards, LambdaCase, MagicHash, UnboxedTuples #-}
+module GHCi.Leak
+  ( LeakIndicators
+  , getLeakIndicators
+  , checkLeakIndicators
+  ) where
+
+import Control.Monad
+import Data.Bits
+import DynFlags (settings, sTargetPlatform)
+import Foreign.Ptr (ptrToIntPtr, intPtrToPtr)
+import GHC
+import GHC.Exts (anyToAddr#)
+import GHC.Ptr (Ptr (..))
+import GHC.Types (IO (..))
+import HscTypes
+import Outputable
+import Platform (target32Bit)
+import Prelude
+import System.Mem
+import System.Mem.Weak
+import UniqDFM
+
+-- Checking for space leaks in GHCi. See #15111, and the
+-- -fghci-leak-check flag.
+
+data LeakIndicators = LeakIndicators [LeakModIndicators]
+
+data LeakModIndicators = LeakModIndicators
+  { leakMod :: Weak HomeModInfo
+  , leakIface :: Weak ModIface
+  , leakDetails :: Weak ModDetails
+  , leakLinkable :: Maybe (Weak Linkable)
+  }
+
+-- | Grab weak references to some of the data structures representing
+-- the currently loaded modules.
+getLeakIndicators :: HscEnv -> IO LeakIndicators
+getLeakIndicators HscEnv{..} =
+  fmap LeakIndicators $
+    forM (eltsUDFM hsc_HPT) $ \hmi@HomeModInfo{..} -> do
+      leakMod <- mkWeakPtr hmi Nothing
+      leakIface <- mkWeakPtr hm_iface Nothing
+      leakDetails <- mkWeakPtr hm_details Nothing
+      leakLinkable <- mapM (`mkWeakPtr` Nothing) hm_linkable
+      return $ LeakModIndicators{..}
+
+-- | Look at the LeakIndicators collected by an earlier call to
+-- `getLeakIndicators`, and print messasges if any of them are still
+-- alive.
+checkLeakIndicators :: DynFlags -> LeakIndicators -> IO ()
+checkLeakIndicators dflags (LeakIndicators leakmods)  = do
+  performGC
+  forM_ leakmods $ \LeakModIndicators{..} -> do
+    deRefWeak leakMod >>= \case
+      Nothing -> return ()
+      Just hmi ->
+        report ("HomeModInfo for " ++
+          showSDoc dflags (ppr (mi_module (hm_iface hmi)))) (Just hmi)
+    deRefWeak leakIface >>= report "ModIface"
+    deRefWeak leakDetails >>= report "ModDetails"
+    forM_ leakLinkable $ \l -> deRefWeak l >>= report "Linkable"
+ where
+  report :: String -> Maybe a -> IO ()
+  report _ Nothing = return ()
+  report msg (Just a) = do
+    addr <- IO (\s -> case anyToAddr# a s of
+                        (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ())
+    putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive at " ++
+              show (maskTagBits addr))
+
+  tagBits
+    | target32Bit (sTargetPlatform (settings dflags)) = 2
+    | otherwise = 3
+
+  maskTagBits :: Ptr a -> Ptr a
+  maskTagBits p = intPtrToPtr (ptrToIntPtr p .&. complement (shiftL 1 tagBits - 1))
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 8012d741e0..1f862de4cb 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -43,15 +43,17 @@ import GHCi.RemoteTypes
 import GHCi.BreakArray
 import DynFlags
 import ErrUtils hiding (traceCmd)
+import Finder
 import GhcMonad ( modifySession )
 import qualified GHC
 import GHC ( LoadHowMuch(..), Target(..),  TargetId(..), InteractiveImport(..),
              TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,
+             GetDocsFailure(..),
              getModuleGraph, handleSourceError )
 import HsImpExp
 import HsSyn
 import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC,
-                  setInteractivePrintName, hsc_dflags )
+                  setInteractivePrintName, hsc_dflags, msObjFilePath )
 import Module
 import Name
 import Packages ( trusted, getPackageDetails, getInstalledPackageDetails,
@@ -98,10 +100,12 @@ import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub,
                    partition, sort, sortBy )
 import qualified Data.Set as S
 import Data.Maybe
+import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Time.LocalTime ( getZonedTime )
 import Data.Time.Format ( formatTime, defaultTimeLocale )
 import Data.Version ( showVersion )
+import Prelude hiding ((<>))
 
 import Exception hiding (catch)
 import Foreign hiding (void)
@@ -132,6 +136,8 @@ import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
 import GHC.IO.Handle ( hFlushAll )
 import GHC.TopHandler ( topHandler )
 
+import GHCi.Leak
+
 -----------------------------------------------------------------------------
 
 data GhciSettings = GhciSettings {
@@ -175,6 +181,7 @@ ghciCommands = map mkCmd [
   ("def",       keepGoing (defineMacro False),  completeExpression),
   ("def!",      keepGoing (defineMacro True),   completeExpression),
   ("delete",    keepGoing deleteCmd,            noCompletion),
+  ("doc",       keepGoing' docCmd,              completeIdentifier),
   ("edit",      keepGoing' editFile,            completeFilename),
   ("etags",     keepGoing createETagsFileCmd,   completeFilename),
   ("force",     keepGoing forceCmd,             completeExpression),
@@ -207,6 +214,7 @@ ghciCommands = map mkCmd [
   ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
   ("type",      keepGoing' typeOfExpr,          completeExpression),
   ("trace",     keepGoing traceCmd,             completeExpression),
+  ("unadd",     keepGoingPaths unAddModule,     completeFilename),
   ("undef",     keepGoing undefineMacro,        completeMacro),
   ("unset",     keepGoing unsetOptions,         completeSetOptions),
   ("where",     keepGoing whereCmd,             noCompletion)
@@ -283,6 +291,7 @@ defFullHelpText =
   "                               (!: use regex instead of line number)\n" ++
   "   :def <cmd> <expr>           define command :<cmd> (later defined command has\n" ++
   "                               precedence, ::<cmd> is always a builtin command)\n" ++
+  "   :doc <name>                 display docs for the given name (experimental)\n" ++
   "   :edit <file>                edit file\n" ++
   "   :edit                       edit last module\n" ++
   "   :etags [<file>]             create tags file <file> for Emacs (default: \"TAGS\")\n" ++
@@ -304,6 +313,7 @@ defFullHelpText =
   "   :type <expr>                show the type of <expr>\n" ++
   "   :type +d <expr>             show the type of <expr>, defaulting type variables\n" ++
   "   :type +v <expr>             show the type of <expr>, with its specified tyvars\n" ++
+  "   :unadd <module> ...         remove module(s) from the current target set\n" ++
   "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
   "   :!<command>                 run the shell command <command>\n" ++
   "\n" ++
@@ -370,6 +380,7 @@ defFullHelpText =
   "   :show packages              show the currently active package flags\n" ++
   "   :show paths                 show the currently active search paths\n" ++
   "   :show language              show the currently active language flags\n" ++
+  "   :show targets               show the current set of targets\n" ++
   "   :show <setting>             show value of <setting>, which is one of\n" ++
   "                                  [args, prog, editor, stop]\n" ++
   "   :showi language             show language flags for interactive evaluation\n" ++
@@ -786,16 +797,14 @@ checkPromptStringForErrors (_:xs) = checkPromptStringForErrors xs
 checkPromptStringForErrors "" = Nothing
 
 generatePromptFunctionFromString :: String -> PromptFunction
-generatePromptFunctionFromString promptS = \_ _ -> do
-    (context, modules_names, line) <- getInfoForPrompt
-
-    let
+generatePromptFunctionFromString promptS modules_names line =
+        processString promptS
+  where
         processString :: String -> GHCi SDoc
         processString ('%':'s':xs) =
             liftM2 (<>) (return modules_list) (processString xs)
             where
-              modules_list = context <> modules_bit
-              modules_bit = hsep $ map text modules_names
+              modules_list = hsep $ map text modules_names
         processString ('%':'l':xs) =
             liftM2 (<>) (return $ ppr line) (processString xs)
         processString ('%':'d':xs) =
@@ -856,8 +865,6 @@ generatePromptFunctionFromString promptS = \_ _ -> do
         processString "" =
             return empty
 
-    processString promptS
-
 mkPrompt :: GHCi String
 mkPrompt = do
   st <- getGHCiState
@@ -882,7 +889,10 @@ installInteractivePrint :: Maybe String -> Bool -> GHCi ()
 installInteractivePrint Nothing _  = return ()
 installInteractivePrint (Just ipFun) exprmode = do
   ok <- trySuccess $ do
-                (name:_) <- GHC.parseName ipFun
+                names <- GHC.parseName ipFun
+                let name = case names of
+                             name':_ -> name'
+                             [] -> panic "installInteractivePrint"
                 modifySession (\he -> let new_ic = setInteractivePrintName (hsc_IC he) name
                                       in he{hsc_IC = new_ic})
                 return Succeeded
@@ -1078,6 +1088,10 @@ enqueueCommands cmds = do
 runStmt :: String -> SingleStep -> GHCi (Maybe GHC.ExecResult)
 runStmt stmt step = do
   dflags <- GHC.getInteractiveDynFlags
+  -- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes`
+  -- and `-fdefer-out-of-scope-variables` for **naked expressions**. The
+  -- declarations and statements are not affected.
+  -- See Note [Deferred type errors in GHCi] in typecheck/TcRnDriver.hs
   if | GHC.isStmt dflags stmt    -> run_stmt
      | GHC.isImport dflags stmt  -> run_import
      -- Every import declaration should be handled by `run_import`. As GHCi
@@ -1513,7 +1527,7 @@ defineMacro overwrite s = do
         body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
                                    `mkHsApp` (nlHsPar expr)
         tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM)
-        new_expr = L (getLoc expr) $ ExprWithTySig body tySig
+        new_expr = L (getLoc expr) $ ExprWithTySig tySig body
     hv <- GHC.compileParsedExprRemote new_expr
 
     let newCmd = Command { cmdName = macro_name
@@ -1577,7 +1591,7 @@ getGhciStepIO = do
       ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
       body = nlHsVar (getRdrName ghciStepIoMName)
       tySig = mkLHsSigWcType (ghciM `nlHsFunTy` ioM)
-  return $ noLoc $ ExprWithTySig body tySig
+  return $ noLoc $ ExprWithTySig tySig body
 
 -----------------------------------------------------------------------------
 -- :check
@@ -1601,6 +1615,38 @@ checkModule m = do
           return True
   afterLoad (successIf ok) False
 
+-----------------------------------------------------------------------------
+-- :doc
+
+docCmd :: String -> InputT GHCi ()
+docCmd "" =
+  throwGhcException (CmdLineError "syntax: ':doc <thing-you-want-docs-for>'")
+docCmd s  = do
+  -- TODO: Maybe also get module headers for module names
+  names <- GHC.parseName s
+  e_docss <- mapM GHC.getDocs names
+  sdocs <- mapM (either handleGetDocsFailure (pure . pprDocs)) e_docss
+  let sdocs' = vcat (intersperse (text "") sdocs)
+  unqual <- GHC.getPrintUnqual
+  dflags <- getDynFlags
+  (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs'
+
+-- TODO: also print arg docs.
+pprDocs :: (Maybe HsDocString, Map Int HsDocString) -> SDoc
+pprDocs (mb_decl_docs, _arg_docs) =
+  maybe
+    (text "<has no documentation>")
+    (text . unpackHDS)
+    mb_decl_docs
+
+handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m SDoc
+handleGetDocsFailure no_docs = do
+  dflags <- getDynFlags
+  let msg = showPpr dflags no_docs
+  throwGhcException $ case no_docs of
+    NameHasNoModule {} -> Sorry msg
+    NoDocsInIface {} -> InstallationError msg
+    InteractiveName -> ProgramError msg
 
 -----------------------------------------------------------------------------
 -- :load, :add, :reload
@@ -1641,6 +1687,15 @@ loadModule' files = do
   -- require some re-working of the GHC interface, so we'll leave it
   -- as a ToDo for now.
 
+  hsc_env <- GHC.getSession
+
+  -- Grab references to the currently loaded modules so that we can
+  -- see if they leak.
+  let !dflags = hsc_dflags hsc_env
+  leak_indicators <- if gopt Opt_GhciLeakCheck dflags
+    then liftIO $ getLeakIndicators hsc_env
+    else return (panic "no leak indicators")
+
   -- unload first
   _ <- GHC.abandonAll
   lift discardActiveBreakPoints
@@ -1648,7 +1703,10 @@ loadModule' files = do
   _ <- GHC.load LoadAllTargets
 
   GHC.setTargets targets
-  doLoadAndCollectInfo False LoadAllTargets
+  success <- doLoadAndCollectInfo False LoadAllTargets
+  when (gopt Opt_GhciLeakCheck dflags) $
+    liftIO $ checkLeakIndicators dflags leak_indicators
+  return success
 
 -- | @:add@ command
 addModule :: [FilePath] -> InputT GHCi ()
@@ -1656,9 +1714,39 @@ addModule files = do
   lift revertCAFs -- always revert CAFs on load/add.
   files' <- mapM expandPath files
   targets <- mapM (\m -> GHC.guessTarget m Nothing) files'
+  targets' <- filterM checkTarget targets
   -- remove old targets with the same id; e.g. for :add *M
+  mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets' ]
+  mapM_ GHC.addTarget targets'
+  _ <- doLoadAndCollectInfo False LoadAllTargets
+  return ()
+  where
+    checkTarget :: Target -> InputT GHCi Bool
+    checkTarget (Target (TargetModule m) _ _) = checkTargetModule m
+    checkTarget (Target (TargetFile f _) _ _) = liftIO $ checkTargetFile f
+
+    checkTargetModule :: ModuleName -> InputT GHCi Bool
+    checkTargetModule m = do
+      hsc_env <- GHC.getSession
+      result <- liftIO $
+        Finder.findImportedModule hsc_env m (Just (fsLit "this"))
+      case result of
+        Found _ _ -> return True
+        _ -> (liftIO $ putStrLn $
+          "Module " ++ moduleNameString m ++ " not found") >> return False
+
+    checkTargetFile :: String -> IO Bool
+    checkTargetFile f = do
+      exists <- (doesFileExist f) :: IO Bool
+      unless exists $ putStrLn $ "File " ++ f ++ " not found"
+      return exists
+
+-- | @:unadd@ command
+unAddModule :: [FilePath] -> InputT GHCi ()
+unAddModule files = do
+  files' <- mapM expandPath files
+  targets <- mapM (\m -> GHC.guessTarget m Nothing) files'
   mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets ]
-  mapM_ GHC.addTarget targets
   _ <- doLoadAndCollectInfo False LoadAllTargets
   return ()
 
@@ -1725,7 +1813,7 @@ afterLoad ok retain_context = do
   lift revertCAFs  -- always revert CAFs on load.
   lift discardTickArrays
   loaded_mods <- getLoadedModules
-  modulesLoadedMsg ok (length loaded_mods)
+  modulesLoadedMsg ok loaded_mods
   lift $ setContextAfterLoad retain_context loaded_mods
 
 setContextAfterLoad :: Bool -> [GHC.ModSummary] -> GHCi ()
@@ -1801,22 +1889,36 @@ keepPackageImports = filterM is_pkg_import
           mod_name = unLoc (ideclName d)
 
 
-modulesLoadedMsg :: SuccessFlag -> Int -> InputT GHCi ()
-modulesLoadedMsg ok num_mods = do
+modulesLoadedMsg :: SuccessFlag -> [GHC.ModSummary] -> InputT GHCi ()
+modulesLoadedMsg ok mods = do
   dflags <- getDynFlags
   unqual <- GHC.getPrintUnqual
-  let status = case ok of
-                   Failed    -> text "Failed"
-                   Succeeded -> text "Ok"
 
-      num_mods_pp = if num_mods == 1
-        then "1 module"
-        else int num_mods <+> "modules"
-      msg = status <> text "," <+> num_mods_pp <+> "loaded."
+  msg <- if gopt Opt_ShowLoadedModules dflags
+         then do
+               mod_names <- mapM mod_name mods
+               let mod_commas
+                     | null mods = text "none."
+                     | otherwise = hsep (punctuate comma mod_names) <> text "."
+               return $ status <> text ", modules loaded:" <+> mod_commas
+         else do
+               return $ status <> text ","
+                    <+> speakNOf (length mods) (text "module") <+> "loaded."
 
   when (verbosity dflags > 0) $
      liftIO $ putStrLn $ showSDocForUser dflags unqual msg
-
+  where
+    status = case ok of
+                  Failed    -> text "Failed"
+                  Succeeded -> text "Ok"
+
+    mod_name mod = do
+        is_interpreted <- GHC.moduleIsBootOrNotObjectLinkable mod
+        return $ if is_interpreted
+                 then ppr (GHC.ms_mod mod)
+                 else ppr (GHC.ms_mod mod)
+                      <+> parens (text $ normalise $ msObjFilePath mod)
+                      -- Fix #9887
 
 -- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors
 -- and printing 'throwE' strings to 'stderr'
@@ -2510,7 +2612,9 @@ showDynFlags show_all dflags = do
                 is_on = test f dflags
                 quiet = not show_all && test f default_dflags == is_on
 
-        default_dflags = defaultDynFlags (settings dflags)
+        llvmConfig = (llvmTargets dflags, llvmPasses dflags)
+
+        default_dflags = defaultDynFlags (settings dflags) llvmConfig
 
         (ghciFlags,others)  = partition (\f -> flagSpecFlag f `elem` flgs)
                                         DynFlags.fFlags
@@ -2764,6 +2868,7 @@ showCmd str = do
             , action "language"   $ showLanguages
             , hidden "languages"  $ showLanguages -- backwards compat
             , hidden "lang"       $ showLanguages -- useful abbreviation
+            , action "targets"    $ showTargets
             ]
 
     case words str of
@@ -2920,12 +3025,22 @@ showLanguages' show_all dflags =
                 is_on = test f dflags
                 quiet = not show_all && test f default_dflags == is_on
 
+   llvmConfig = (llvmTargets dflags, llvmPasses dflags)
+
    default_dflags =
-       defaultDynFlags (settings dflags) `lang_set`
+       defaultDynFlags (settings dflags) llvmConfig `lang_set`
          case language dflags of
            Nothing -> Just Haskell2010
            other   -> other
 
+showTargets :: GHCi ()
+showTargets = mapM_ showTarget =<< GHC.getTargets
+  where
+    showTarget :: Target -> GHCi ()
+    showTarget (Target (TargetFile f _) _ _) = liftIO (putStrLn f)
+    showTarget (Target (TargetModule m) _ _) =
+      liftIO (putStrLn $ moduleNameString m)
+
 -- -----------------------------------------------------------------------------
 -- Completion
 
@@ -3137,7 +3252,7 @@ stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
       case mb_span of
         Nothing  -> stepCmd []
         Just loc -> do
-           Just md <- getCurrentBreakModule
+           md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule
            current_toplevel_decl <- enclosingTickSpan md loc
            doContinue (`isSubspanOf` RealSrcSpan current_toplevel_decl) GHC.SingleStep
 
@@ -3628,7 +3743,7 @@ turnOffBreak loc = do
 
 getModBreak :: Module -> GHCi (ForeignRef BreakArray, Array Int SrcSpan)
 getModBreak m = do
-   Just mod_info <- GHC.getModuleInfo m
+   mod_info      <- fromMaybe (panic "getModBreak") <$> GHC.getModuleInfo m
    let modBreaks  = GHC.modInfoModBreaks mod_info
    let arr        = GHC.modBreaks_flags modBreaks
    let ticks      = GHC.modBreaks_locs  modBreaks
diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index a114ebff29..0b354f93e7 100644
--- a/ghc/GHCi/UI/Info.hs
+++ b/ghc/GHCi/UI/Info.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
--- | Get information on modules, expreesions, and identifiers
+-- | Get information on modules, expressions, and identifiers
 module GHCi.UI.Info
     ( ModInfo(..)
     , SpanInfo(..)
@@ -27,7 +27,7 @@ import           Data.Map.Strict   (Map)
 import qualified Data.Map.Strict   as M
 import           Data.Maybe
 import           Data.Time
-import           Prelude           hiding (mod)
+import           Prelude           hiding (mod,(<>))
 import           System.Directory
 
 import qualified CoreUtils
@@ -276,7 +276,9 @@ collectInfo ms loaded = do
     cacheInvalid name = case M.lookup name ms of
         Nothing -> return True
         Just mi -> do
-            let fp = ml_obj_file (ms_location (modinfoSummary mi))
+            let src_fp = ml_hs_file (ms_location (modinfoSummary mi))
+                obj_fp = ml_obj_file (ms_location (modinfoSummary mi))
+                fp     = fromMaybe obj_fp src_fp
                 last' = modinfoLastUpdate mi
             exists <- doesFileExist fp
             if exists
@@ -309,7 +311,7 @@ processAllTypeCheckedModule tcm = do
 
     -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsBind's
     getTypeLHsBind :: LHsBind GhcTc -> m (Maybe (Maybe Id,SrcSpan,Type))
-    getTypeLHsBind (L _spn FunBind{fun_id = pid,fun_matches = MG _ _ _typ _})
+    getTypeLHsBind (L _spn FunBind{fun_id = pid,fun_matches = MG _ _ _})
         = pure $ Just (Just (unLoc pid),getLoc pid,varType (unLoc pid))
     getTypeLHsBind _ = pure Nothing
 
@@ -321,19 +323,19 @@ processAllTypeCheckedModule tcm = do
         return $ fmap (\expr -> (mid, getLoc e, CoreUtils.exprType expr)) mbe
       where
         mid :: Maybe Id
-        mid | HsVar (L _ i) <- unwrapVar (unLoc e) = Just i
-            | otherwise                            = Nothing
+        mid | HsVar _ (L _ i) <- unwrapVar (unLoc e) = Just i
+            | otherwise                              = Nothing
 
-        unwrapVar (HsWrap _ var) = var
-        unwrapVar e'             = e'
+        unwrapVar (HsWrap _ _ var) = var
+        unwrapVar e'               = e'
 
     -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LPats's
     getTypeLPat :: LPat GhcTc -> m (Maybe (Maybe Id,SrcSpan,Type))
     getTypeLPat (L spn pat) =
         pure (Just (getMaybeId pat,spn,hsPatType pat))
       where
-        getMaybeId (VarPat (L _ vid)) = Just vid
-        getMaybeId _                  = Nothing
+        getMaybeId (VarPat _ (L _ vid)) = Just vid
+        getMaybeId _                    = Nothing
 
     -- | Get ALL source spans in the source.
     listifyAllSpans :: Typeable a => TypecheckedSource -> [Located a]
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 46f0860ab9..45a52712da 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -55,12 +55,14 @@ import Data.Time
 import System.Environment
 import System.IO
 import Control.Monad
+import Prelude hiding ((<>))
 
 import System.Console.Haskeline (CompletionFunc, InputT)
 import qualified System.Console.Haskeline as Haskeline
 import Control.Monad.Trans.Class
 import Control.Monad.IO.Class
 import Data.Map.Strict (Map)
+import qualified GHC.LanguageExtensions as LangExt
 
 -----------------------------------------------------------------------------
 -- GHCi monad
@@ -420,15 +422,13 @@ foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()
 -- | Compile "hFlush stdout; hFlush stderr" once, so we can use it repeatedly
 initInterpBuffering :: Ghc (ForeignHValue, ForeignHValue)
 initInterpBuffering = do
-  -- We take great care not to use do-notation in the expressions below, as
-  -- they are fragile in the presence of RebindableSyntax (Trac #13385).
-  nobuf <- GHC.compileExprRemote $
-   "                  System.IO.hSetBuffering System.IO.stdin  System.IO.NoBuffering" ++
-   "`GHC.Base.thenIO` System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering" ++
-   "`GHC.Base.thenIO` System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering"
-  flush <- GHC.compileExprRemote $
-   "                  System.IO.hFlush System.IO.stdout" ++
-   "`GHC.Base.thenIO` System.IO.hFlush System.IO.stderr"
+  nobuf <- compileGHCiExpr $
+   "do { System.IO.hSetBuffering System.IO.stdin System.IO.NoBuffering; " ++
+       " System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering; " ++
+       " System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering }"
+  flush <- compileGHCiExpr $
+   "do { System.IO.hFlush System.IO.stdout; " ++
+       " System.IO.hFlush System.IO.stderr }"
   return (nobuf, flush)
 
 -- | Invoke "hFlush stdout; hFlush stderr" in the interpreter
@@ -451,6 +451,20 @@ turnOffBuffering_ fhv = do
 
 mkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue
 mkEvalWrapper progname args =
-  GHC.compileExprRemote $
+  compileGHCiExpr $
     "\\m -> System.Environment.withProgName " ++ show progname ++
     "(System.Environment.withArgs " ++ show args ++ " m)"
+
+compileGHCiExpr :: GhcMonad m => String -> m ForeignHValue
+compileGHCiExpr expr = do
+  hsc_env <- getSession
+  let dflags = hsc_dflags hsc_env
+      -- RebindableSyntax can wreak havoc with GHCi in several ways
+      -- (see #13385 and #14342 for examples), so we take care to disable it
+      -- for the duration of running expressions that are internal to GHCi.
+      no_rb_hsc_env =
+        hsc_env { hsc_dflags = xopt_unset dflags LangExt.RebindableSyntax }
+  setSession no_rb_hsc_env
+  res <- GHC.compileExprRemote expr
+  setSession hsc_env
+  pure res
diff --git a/ghc/GHCi/UI/Tags.hs b/ghc/GHCi/UI/Tags.hs
index d8af7f8718..09a8406d96 100644
--- a/ghc/GHCi/UI/Tags.hs
+++ b/ghc/GHCi/UI/Tags.hs
@@ -25,13 +25,14 @@ import OccName (pprOccName)
 import ConLike
 import MonadUtils
 
+import Control.Monad
 import Data.Function
+import Data.List
 import Data.Maybe
 import Data.Ord
 import DriverPhases
 import Panic
-import Data.List
-import Control.Monad
+import Prelude
 import System.Directory
 import System.IO
 import System.IO.Error