[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
Sun Jun 16 21:27:31 UTC 2019
Ben Gamari pushed to branch wip/T15336 at Glasgow Haskell Compiler / GHC
Commits:
558f2839 by Ben Gamari at 2019-06-16T21:27:19Z
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.
- - - - -
d71ea67e by Ben Gamari at 2019-06-16T21:27:19Z
testsuite: Add test for #16563
- - - - -
7 changed files:
- compiler/prelude/PrelNames.hs
- ghc/GHCi/UI/Monad.hs
- + libraries/base/GHC/GHCi/Helpers.hs
- libraries/base/base.cabal
- + testsuite/tests/ghci/scripts/T16563.script
- + testsuite/tests/ghci/scripts/T16563.stdout
- testsuite/tests/ghci/scripts/all.T
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/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/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'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7f1ee10c677a08db087cab996b48c1ec20b766e2...d71ea67ea50d095cbb636297817ef546f86b3f8e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7f1ee10c677a08db087cab996b48c1ec20b766e2...d71ea67ea50d095cbb636297817ef546f86b3f8e
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/20190616/79822008/attachment-0001.html>
More information about the ghc-commits
mailing list