diff options
Diffstat (limited to 'ghc')
-rw-r--r-- | ghc/GHCi/UI/Monad.hs | 39 |
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 |