Commit abee907f authored by Ben Gamari's avatar Ben Gamari 🐢

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.
parent 4549cadf
......@@ -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")
......
......@@ -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
-----------------------------------------------------------------------------
-- |
-- 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)
......@@ -230,6 +230,7 @@ Library
GHC.Foreign
GHC.ForeignPtr
GHC.GHCi
GHC.GHCi.Helpers
GHC.Generics
GHC.IO
GHC.IO.Buffer
......
......@@ -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
......
......@@ -3,7 +3,7 @@ _result :: (Bool, Bool, ()) = _
a :: Bool = _
b :: Bool = _
c :: () = _
b :: Bool = _
c :: () = _
b :: Bool = _
a :: Bool = _
_result :: (Bool, Bool, ()) = _
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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’
() :: ()
......
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’
......@@ -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’
......
......@@ -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’
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment