Commit 65d9597d authored by Alan Zimmerman's avatar Alan Zimmerman

Add hook for creating ghci external interpreter

Summary:
The external interpreter is launched by calling
'System.Process.createProcess' with a 'CreateProcess' parameter.

The current value for this has the 'std_in', 'std_out' and 'std_err'
fields use the default of 'Inherit', meaning that the remote interpreter
shares the stdio with the original ghc/ghci process.

This patch introduces a new hook to the DynFlags, which has an
opportunity to override the 'CreateProcess' fields, launch the process,
and retrieve the stdio handles actually used.

So if a ghci external interpreter session is launched from the GHC API
the stdio can be redirected if required, which is useful for tooling/IDE
integration.

Test Plan: ./validate

Reviewers: austin, hvr, simonmar, bgamari

Reviewed By: simonmar, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2518
parent a8238a4e
......@@ -60,6 +60,7 @@ import Exception
import BasicTypes
import FastString
import Util
import Hooks
import Control.Concurrent
import Control.Monad
......@@ -449,7 +450,11 @@ startIServ dflags = do
prog = pgm_i dflags ++ flavour
opts = getOpts dflags opt_i
debugTraceMsg dflags 3 $ text "Starting " <> text prog
(ph, rh, wh) <- runWithPipes prog opts
let createProc = lookupHook createIservProcessHook
(\cp -> do { (_,_,_,ph) <- createProcess cp
; return ph })
dflags
(ph, rh, wh) <- runWithPipes createProc prog opts
lo_ref <- newIORef Nothing
cache_ref <- newIORef emptyUFM
return $ IServ
......@@ -474,7 +479,8 @@ stopIServ HscEnv{..} =
then return ()
else iservCall iserv Shutdown
runWithPipes :: FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)
runWithPipes :: (CreateProcess -> IO ProcessHandle)
-> FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)
#ifdef mingw32_HOST_OS
foreign import ccall "io.h _close"
c__close :: CInt -> IO CInt
......@@ -482,26 +488,26 @@ foreign import ccall "io.h _close"
foreign import ccall unsafe "io.h _get_osfhandle"
_get_osfhandle :: CInt -> IO CInt
runWithPipes prog opts = do
runWithPipes createProc prog opts = do
(rfd1, wfd1) <- createPipeFd -- we read on rfd1
(rfd2, wfd2) <- createPipeFd -- we write on wfd2
wh_client <- _get_osfhandle wfd1
rh_client <- _get_osfhandle rfd2
let args = show wh_client : show rh_client : opts
(_, _, _, ph) <- createProcess (proc prog args)
ph <- createProc (proc prog args)
rh <- mkHandle rfd1
wh <- mkHandle wfd2
return (ph, rh, wh)
where mkHandle :: CInt -> IO Handle
mkHandle fd = (fdToHandle fd) `onException` (c__close fd)
#else
runWithPipes prog opts = do
runWithPipes createProc prog opts = do
(rfd1, wfd1) <- Posix.createPipe -- we read on rfd1
(rfd2, wfd2) <- Posix.createPipe -- we write on wfd2
setFdOption rfd1 CloseOnExec True
setFdOption wfd2 CloseOnExec True
let args = show wfd1 : show rfd2 : opts
(_, _, _, ph) <- createProcess (proc prog args)
ph <- createProc (proc prog args)
closeFd wfd1
closeFd rfd2
rh <- fdToHandle rfd1
......
......@@ -25,6 +25,7 @@ module Hooks ( Hooks
, runRnSpliceHook
#ifdef GHCI
, getValueSafelyHook
, createIservProcessHook
#endif
) where
......@@ -45,6 +46,7 @@ import CoreSyn
import GHCi.RemoteTypes
import SrcLoc
import Type
import System.Process
#endif
import BasicTypes
......@@ -78,6 +80,7 @@ emptyHooks = Hooks
, runRnSpliceHook = Nothing
#ifdef GHCI
, getValueSafelyHook = Nothing
, createIservProcessHook = Nothing
#endif
}
......@@ -96,6 +99,7 @@ data Hooks = Hooks
, runRnSpliceHook :: Maybe (HsSplice Name -> RnM (HsSplice Name))
#ifdef GHCI
, getValueSafelyHook :: Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
, createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle)
#endif
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment