[Git][ghc/ghc][wip/T15336] 2 commits: ghci: Don't rely on resolution of System.IO to base module
Ben Gamari
gitlab at gitlab.haskell.org
Mon Jun 17 13:05:34 UTC 2019
Ben Gamari pushed to branch wip/T15336 at Glasgow Haskell Compiler / GHC
Commits:
485aa6ee by Ben Gamari at 2019-06-17T03:53:22Z
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.
- - - - -
af64eaf2 by Ben Gamari at 2019-06-17T03:53:22Z
testsuite: Add test for #16563
- - - - -
16 changed files:
- compiler/prelude/PrelNames.hs
- ghc/GHCi/UI/Monad.hs
- + libraries/base/GHC/GHCi/Helpers.hs
- libraries/base/base.cabal
- testsuite/tests/ghci.debugger/scripts/break006.stdout
- testsuite/tests/ghci.debugger/scripts/break013.stdout
- testsuite/tests/ghci.debugger/scripts/hist001.stdout
- testsuite/tests/ghci.debugger/scripts/hist002.stdout
- + testsuite/tests/ghci/scripts/T16563.script
- + testsuite/tests/ghci/scripts/T16563.stdout
- testsuite/tests/ghci/scripts/T4175.stdout
- testsuite/tests/ghci/scripts/T7627.stdout
- testsuite/tests/ghci/scripts/T8469.stdout
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/ghci/scripts/ghci011.stdout
- testsuite/tests/ghci/scripts/ghci064.stdout
Changes:
=====================================
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")
=====================================
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,9 +520,13 @@ 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)"
+ 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")
compileGHCiExpr :: GhcMonad m => String -> m ForeignHValue
compileGHCiExpr expr =
=====================================
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 at 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)
=====================================
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
=====================================
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
=====================================
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, ()) = _
=====================================
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
=====================================
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
=====================================
testsuite/tests/ghci/scripts/T16563.script
=====================================
@@ -0,0 +1 @@
+putStrLn "hello world"
=====================================
testsuite/tests/ghci/scripts/T16563.stdout
=====================================
@@ -0,0 +1,2 @@
+hello world
+
=====================================
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
=====================================
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’
() :: ()
=====================================
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’
=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -296,5 +296,6 @@ test('T16089', normal, ghci_script, ['T16089.script'])
test('T14828', normal, ghci_script, ['T14828.script'])
test('T16376', normal, ghci_script, ['T16376.script'])
test('T16527', normal, ghci_script, ['T16527.script'])
+test('T16563', extra_hc_opts("-clear-package-db -global-package-db"), ghci_script, ['T16563.script'])
test('T16569', normal, ghci_script, ['T16569.script'])
test('T16767', normal, ghci_script, ['T16767.script'])
=====================================
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’
=====================================
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’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d71ea67ea50d095cbb636297817ef546f86b3f8e...af64eaf2bc7634a69f31f4535324ec81798467a4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d71ea67ea50d095cbb636297817ef546f86b3f8e...af64eaf2bc7634a69f31f4535324ec81798467a4
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190617/512e340f/attachment-0001.html>
More information about the ghc-commits
mailing list