summaryrefslogtreecommitdiff
path: root/ghc
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2019-06-16 11:15:11 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-06-22 10:06:05 -0400
commit655c6e265e06acbebcb6f9aa084efb3ce933e189 (patch)
treee916c8cfbc01efffa8261e174a5ccc3d723be165 /ghc
parente0595d22ce5bc19699079abdb47377b5707cdbbc (diff)
downloadhaskell-655c6e265e06acbebcb6f9aa084efb3ce933e189.tar.gz
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.
Diffstat (limited to 'ghc')
-rw-r--r--ghc/GHCi/UI/Monad.hs39
1 files changed, 25 insertions, 14 deletions
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