ghci: Don't rely on resolution of System.IO to base module

Previously we would hackily evaluate a textual code snippet to compute
actions to disable I/O buffering and flush the stdout/stderr handles.
This broke in a number of ways (#15336, #16563).

Instead we now ship a module (`GHC.GHCi.Helpers`) with `base` containing
the needed actions. We can then easily refer to these via `Orig` names.

13 files changed, 79 insertions, 36 deletions

diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 4a104c63a9..c4956ad98b 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -498,7 +498,7 @@ pRELUDE :: Module
 pRELUDE         = mkBaseModule_ pRELUDE_NAME
 
 gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
-    gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_CSTRING,
+    gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING,
     gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_INTEGER_TYPE, gHC_NATURAL,
     gHC_LIST, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING,
     dATA_FOLDABLE, dATA_TRAVERSABLE,
@@ -520,6 +520,7 @@ gHC_CLASSES     = mkPrimModule (fsLit "GHC.Classes")
 gHC_BASE        = mkBaseModule (fsLit "GHC.Base")
 gHC_ENUM        = mkBaseModule (fsLit "GHC.Enum")
 gHC_GHCI        = mkBaseModule (fsLit "GHC.GHCi")
+gHC_GHCI_HELPERS= mkBaseModule (fsLit "GHC.GHCi.Helpers")
 gHC_SHOW        = mkBaseModule (fsLit "GHC.Show")
 gHC_READ        = mkBaseModule (fsLit "GHC.Read")
 gHC_NUM         = mkBaseModule (fsLit "GHC.Num")
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 4491d24a52..8bdeb04834 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -41,14 +41,18 @@ import qualified GHC
 import GhcMonad         hiding (liftIO)
 import Outputable       hiding (printForUser, printForUserPartWay)
 import qualified Outputable
+import OccName
 import DynFlags
 import FastString
 import HscTypes
 import SrcLoc
 import Module
+import RdrName (mkOrig)
+import PrelNames (gHC_GHCI_HELPERS)
 import GHCi
 import GHCi.RemoteTypes
 import HsSyn (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
+import HsUtils
 import Util
 
 import Exception
@@ -488,13 +492,12 @@ revertCAFs = do
 -- | Compile "hFlush stdout; hFlush stderr" once, so we can use it repeatedly
 initInterpBuffering :: Ghc (ForeignHValue, ForeignHValue)
 initInterpBuffering = do
-  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 }"
+  let mkHelperExpr :: OccName -> Ghc ForeignHValue
+      mkHelperExpr occ =
+        GHC.compileParsedExprRemote
+        $ GHC.nlHsVar $ RdrName.mkOrig gHC_GHCI_HELPERS occ
+  nobuf <- mkHelperExpr $ mkVarOcc "disableBuffering"
+  flush <- mkHelperExpr $ mkVarOcc "flushAll"
   return (nobuf, flush)
 
 -- | Invoke "hFlush stdout; hFlush stderr" in the interpreter
@@ -517,13 +520,18 @@ turnOffBuffering_ fhv = do
 
 mkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue
 mkEvalWrapper progname args =
-  compileGHCiExpr $
-    "\\m -> System.Environment.withProgName " ++ show progname ++
-    "(System.Environment.withArgs " ++ show args ++ " m)"
-
-compileGHCiExpr :: GhcMonad m => String -> m ForeignHValue
-compileGHCiExpr expr =
-  withTempSession mkTempSession $ GHC.compileExprRemote expr
+  runInternal $ GHC.compileParsedExprRemote
+  $ evalWrapper `GHC.mkHsApp` nlHsString progname
+                `GHC.mkHsApp` nlList (map nlHsString args)
+  where
+    nlHsString = nlHsLit . mkHsString
+    evalWrapper =
+      GHC.nlHsVar $ RdrName.mkOrig gHC_GHCI_HELPERS (mkVarOcc "evalWrapper")
+
+-- | Run a 'GhcMonad' action to compile an expression for internal usage.
+runInternal :: GhcMonad m => m a -> m a
+runInternal =
+    withTempSession mkTempSession
   where
     mkTempSession hsc_env = hsc_env
       { hsc_dflags = (hsc_dflags hsc_env) {
@@ -540,3 +548,6 @@ compileGHCiExpr expr =
           -- with fully qualified names without imports.
           `gopt_set` Opt_ImplicitImportQualified
       }
+
+compileGHCiExpr :: GhcMonad m => String -> m ForeignHValue
+compileGHCiExpr expr = runInternal $ GHC.compileExprRemote expr
diff --git a/libraries/base/GHC/GHCi/Helpers.hs b/libraries/base/GHC/GHCi/Helpers.hs
new file mode 100644
index 0000000000..de510f3674
--- /dev/null
+++ b/libraries/base/GHC/GHCi/Helpers.hs
@@ -0,0 +1,36 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.GHCi.Helpers
+-- Copyright   :  (c) The GHC Developers
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Various helpers used by the GHCi shell.
+--
+-----------------------------------------------------------------------------
+
+module GHC.GHCi.Helpers
+  ( disableBuffering, flushAll
+  , evalWrapper
+  ) where
+
+import System.IO
+import System.Environment
+
+disableBuffering :: IO ()
+disableBuffering = do
+  hSetBuffering stdin NoBuffering
+  hSetBuffering stdout NoBuffering
+  hSetBuffering stderr NoBuffering
+
+flushAll :: IO ()
+flushAll = do
+  hFlush stdout
+  hFlush stderr
+
+evalWrapper :: String -> [String] -> IO a -> IO a
+evalWrapper progName args m =
+  withProgName progName (withArgs args m)
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index c4f9cfb941..da018d27ce 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -230,6 +230,7 @@ Library
         GHC.Foreign
         GHC.ForeignPtr
         GHC.GHCi
+        GHC.GHCi.Helpers
         GHC.Generics
         GHC.IO
         GHC.IO.Buffer
diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stdout b/testsuite/tests/ghci.debugger/scripts/break006.stdout
index 2b4a6c20f8..407ad3739b 100644
--- a/testsuite/tests/ghci.debugger/scripts/break006.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break006.stdout
@@ -4,14 +4,14 @@ f :: Int -> a = _
 x :: Int = 1
 xs :: [Int] = [2,3]
 xs :: [Int] = [2,3]
-f :: Int -> a = _
 x :: Int = 1
+f :: Int -> a = _
 _result :: [a] = _
 y = (_t1::a)
 y = 2
 xs :: [Int] = [2,3]
-f :: Int -> Int = _
 x :: Int = 1
+f :: Int -> Int = _
 _result :: [Int] = _
 y :: Int = 2
 _t1 :: Int = 2
diff --git a/testsuite/tests/ghci.debugger/scripts/break013.stdout b/testsuite/tests/ghci.debugger/scripts/break013.stdout
index 52aa48ee83..0024bc62d0 100644
--- a/testsuite/tests/ghci.debugger/scripts/break013.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break013.stdout
@@ -3,7 +3,7 @@ _result :: (Bool, Bool, ()) = _
 a :: Bool = _
 b :: Bool = _
 c :: () = _
-b :: Bool = _
 c :: () = _
+b :: Bool = _
 a :: Bool = _
 _result :: (Bool, Bool, ()) = _
diff --git a/testsuite/tests/ghci.debugger/scripts/hist001.stdout b/testsuite/tests/ghci.debugger/scripts/hist001.stdout
index b52e8aa5fe..a19a34f315 100644
--- a/testsuite/tests/ghci.debugger/scripts/hist001.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/hist001.stdout
@@ -20,8 +20,8 @@ _result :: a
 f :: Integer -> a
 x :: Integer
 xs :: [t] = []
-f :: Integer -> a = _
 x :: Integer = 2
+f :: Integer -> a = _
 _result :: a = _
 _result = 3
 Logged breakpoint at Test3.hs:2:18-31
diff --git a/testsuite/tests/ghci.debugger/scripts/hist002.stdout b/testsuite/tests/ghci.debugger/scripts/hist002.stdout
index b52e8aa5fe..a19a34f315 100644
--- a/testsuite/tests/ghci.debugger/scripts/hist002.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/hist002.stdout
@@ -20,8 +20,8 @@ _result :: a
 f :: Integer -> a
 x :: Integer
 xs :: [t] = []
-f :: Integer -> a = _
 x :: Integer = 2
+f :: Integer -> a = _
 _result :: a = _
 _result = 3
 Logged breakpoint at Test3.hs:2:18-31
diff --git a/testsuite/tests/ghci/scripts/T4175.stdout b/testsuite/tests/ghci/scripts/T4175.stdout
index 5e4560a868..9dfcd6c0d6 100644
--- a/testsuite/tests/ghci/scripts/T4175.stdout
+++ b/testsuite/tests/ghci/scripts/T4175.stdout
@@ -21,9 +21,9 @@ instance Eq () -- Defined in ‘GHC.Classes’
 instance Monoid () -- Defined in ‘GHC.Base’
 instance Ord () -- Defined in ‘GHC.Classes’
 instance Semigroup () -- Defined in ‘GHC.Base’
+instance Enum () -- Defined in ‘GHC.Enum’
 instance Show () -- Defined in ‘GHC.Show’
 instance Read () -- Defined in ‘GHC.Read’
-instance Enum () -- Defined in ‘GHC.Enum’
 instance Bounded () -- Defined in ‘GHC.Enum’
 type instance D () () = Bool 	-- Defined at T4175.hs:22:10
 type instance D Int () = String 	-- Defined at T4175.hs:19:10
@@ -38,8 +38,8 @@ instance Ord a => Ord (Maybe a) -- Defined in ‘GHC.Maybe’
 instance Semigroup a => Semigroup (Maybe a)
   -- Defined in ‘GHC.Base’
 instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
-instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’
 instance MonadFail Maybe -- Defined in ‘Control.Monad.Fail’
+instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’
 instance Foldable Maybe -- Defined in ‘Data.Foldable’
 instance Traversable Maybe -- Defined in ‘Data.Traversable’
 type instance A (Maybe a) a = a 	-- Defined at T4175.hs:9:15
@@ -47,11 +47,11 @@ data Int = GHC.Types.I# GHC.Prim.Int# 	-- Defined in ‘GHC.Types’
 instance [safe] C Int -- Defined at T4175.hs:18:10
 instance Eq Int -- Defined in ‘GHC.Classes’
 instance Ord Int -- Defined in ‘GHC.Classes’
-instance Show Int -- Defined in ‘GHC.Show’
-instance Read Int -- Defined in ‘GHC.Read’
 instance Enum Int -- Defined in ‘GHC.Enum’
 instance Num Int -- Defined in ‘GHC.Num’
 instance Real Int -- Defined in ‘GHC.Real’
+instance Show Int -- Defined in ‘GHC.Show’
+instance Read Int -- Defined in ‘GHC.Read’
 instance Bounded Int -- Defined in ‘GHC.Enum’
 instance Integral Int -- Defined in ‘GHC.Real’
 type instance D Int () = String 	-- Defined at T4175.hs:19:10
diff --git a/testsuite/tests/ghci/scripts/T7627.stdout b/testsuite/tests/ghci/scripts/T7627.stdout
index ff4e67005e..ea9aaafb80 100644
--- a/testsuite/tests/ghci/scripts/T7627.stdout
+++ b/testsuite/tests/ghci/scripts/T7627.stdout
@@ -3,9 +3,9 @@ instance Eq () -- Defined in ‘GHC.Classes’
 instance Monoid () -- Defined in ‘GHC.Base’
 instance Ord () -- Defined in ‘GHC.Classes’
 instance Semigroup () -- Defined in ‘GHC.Base’
+instance Enum () -- Defined in ‘GHC.Enum’
 instance Show () -- Defined in ‘GHC.Show’
 instance Read () -- Defined in ‘GHC.Read’
-instance Enum () -- Defined in ‘GHC.Enum’
 instance Bounded () -- Defined in ‘GHC.Enum’
 data (##) = (##) 	-- Defined in ‘GHC.Prim’
 () :: ()
diff --git a/testsuite/tests/ghci/scripts/T8469.stdout b/testsuite/tests/ghci/scripts/T8469.stdout
index ec14842359..1a511e6b55 100644
--- a/testsuite/tests/ghci/scripts/T8469.stdout
+++ b/testsuite/tests/ghci/scripts/T8469.stdout
@@ -1,10 +1,10 @@
 data Int = GHC.Types.I# GHC.Prim.Int# 	-- Defined in ‘GHC.Types’
 instance Eq Int -- Defined in ‘GHC.Classes’
 instance Ord Int -- Defined in ‘GHC.Classes’
-instance Show Int -- Defined in ‘GHC.Show’
-instance Read Int -- Defined in ‘GHC.Read’
 instance Enum Int -- Defined in ‘GHC.Enum’
 instance Num Int -- Defined in ‘GHC.Num’
 instance Real Int -- Defined in ‘GHC.Real’
+instance Show Int -- Defined in ‘GHC.Show’
+instance Read Int -- Defined in ‘GHC.Read’
 instance Bounded Int -- Defined in ‘GHC.Enum’
 instance Integral Int -- Defined in ‘GHC.Real’
diff --git a/testsuite/tests/ghci/scripts/ghci011.stdout b/testsuite/tests/ghci/scripts/ghci011.stdout
index 112dde7811..6dd5782d6c 100644
--- a/testsuite/tests/ghci/scripts/ghci011.stdout
+++ b/testsuite/tests/ghci/scripts/ghci011.stdout
@@ -7,8 +7,8 @@ instance Monoid [a] -- Defined in ‘GHC.Base’
 instance Ord a => Ord [a] -- Defined in ‘GHC.Classes’
 instance Semigroup [a] -- Defined in ‘GHC.Base’
 instance Show a => Show [a] -- Defined in ‘GHC.Show’
-instance Read a => Read [a] -- Defined in ‘GHC.Read’
 instance MonadFail [] -- Defined in ‘Control.Monad.Fail’
+instance Read a => Read [a] -- Defined in ‘GHC.Read’
 instance Foldable [] -- Defined in ‘Data.Foldable’
 instance Traversable [] -- Defined in ‘Data.Traversable’
 data () = () 	-- Defined in ‘GHC.Tuple’
@@ -16,9 +16,9 @@ instance Eq () -- Defined in ‘GHC.Classes’
 instance Monoid () -- Defined in ‘GHC.Base’
 instance Ord () -- Defined in ‘GHC.Classes’
 instance Semigroup () -- Defined in ‘GHC.Base’
+instance Enum () -- Defined in ‘GHC.Enum’
 instance Show () -- Defined in ‘GHC.Show’
 instance Read () -- Defined in ‘GHC.Read’
-instance Enum () -- Defined in ‘GHC.Enum’
 instance Bounded () -- Defined in ‘GHC.Enum’
 data (,) a b = (,) a b 	-- Defined in ‘GHC.Tuple’
 instance Monoid a => Applicative ((,) a) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/scripts/ghci064.stdout b/testsuite/tests/ghci/scripts/ghci064.stdout
index afe039c9ea..2b841138ce 100644
--- a/testsuite/tests/ghci/scripts/ghci064.stdout
+++ b/testsuite/tests/ghci/scripts/ghci064.stdout
@@ -9,13 +9,11 @@ instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’
 instance Semigroup _ => Semigroup (Maybe _)
   -- Defined in ‘GHC.Base’
 instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’
-instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’
 instance Eq _ => Eq [_] -- Defined in ‘GHC.Classes’
 instance Monoid [_] -- Defined in ‘GHC.Base’
 instance Ord _ => Ord [_] -- Defined in ‘GHC.Classes’
 instance Semigroup [_] -- Defined in ‘GHC.Base’
 instance Show _ => Show [_] -- Defined in ‘GHC.Show’
-instance Read _ => Read [_] -- Defined in ‘GHC.Read’
 instance [safe] MyShow _ => MyShow [_]
   -- Defined at ghci064.hs:7:10
 instance Monoid [T] -- Defined in ‘GHC.Base’
@@ -24,12 +22,8 @@ instance [safe] MyShow [T] -- Defined at ghci064.hs:7:10
 instance [safe] MyShow [T] -- Defined at ghci064.hs:15:10
 instance Eq Bool -- Defined in ‘GHC.Classes’
 instance Ord Bool -- Defined in ‘GHC.Classes’
-instance Show Bool -- Defined in ‘GHC.Show’
-instance Read Bool -- Defined in ‘GHC.Read’
 instance Enum Bool -- Defined in ‘GHC.Enum’
+instance Show Bool -- Defined in ‘GHC.Show’
 instance Bounded Bool -- Defined in ‘GHC.Enum’
-instance Data.Bits.Bits Bool -- Defined in ‘Data.Bits’
-instance Data.Bits.FiniteBits Bool -- Defined in ‘Data.Bits’
-instance GHC.Arr.Ix Bool -- Defined in ‘GHC.Arr’
 instance Functor ((,) Int) -- Defined in ‘GHC.Base’
 instance Foldable ((,) Int) -- Defined in ‘Data.Foldable’