[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
Tue Jun 18 01:54:56 UTC 2019



Ben Gamari pushed to branch wip/T15336 at Glasgow Haskell Compiler / GHC


Commits:
300ccec8 by Ben Gamari at 2019-06-18T01:54:47Z
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.

- - - - -
750b199a by Ben Gamari at 2019-06-18T01:54:47Z
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,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


=====================================
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/af64eaf2bc7634a69f31f4535324ec81798467a4...750b199a0d971ebc02b367fcd19c4d646e8bf664

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/af64eaf2bc7634a69f31f4535324ec81798467a4...750b199a0d971ebc02b367fcd19c4d646e8bf664
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/1b1f4b46/attachment-0001.html>


More information about the ghc-commits mailing list