{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Runtime.Interpreter.Wasm (spawnWasmInterp) where
import GHC.Prelude
import GHC.Runtime.Interpreter.Types
#if !defined(mingw32_HOST_OS)
import Control.Concurrent.MVar
import Data.IORef
import GHC.Data.FastString
import qualified GHC.Data.ShortText as ST
import GHC.Platform
import GHC.Unit
import GHCi.Message
import System.Directory
import System.IO
import qualified System.Posix.IO as Posix
import System.Process
#else
import GHC.Utils.Panic
#endif
spawnWasmInterp :: WasmInterpConfig -> IO (ExtInterpInstance ())
#if !defined(mingw32_HOST_OS)
spawnWasmInterp :: WasmInterpConfig -> IO (ExtInterpInstance ())
spawnWasmInterp WasmInterpConfig {Bool
String
[String]
Platform
UnitState
wasmInterpDyLD :: String
wasmInterpLibDir :: String
wasmInterpOpts :: [String]
wasmInterpTargetPlatform :: Platform
wasmInterpProfiled :: Bool
wasmInterpHsSoSuffix :: String
wasmInterpUnitState :: UnitState
wasmInterpUnitState :: WasmInterpConfig -> UnitState
wasmInterpHsSoSuffix :: WasmInterpConfig -> String
wasmInterpProfiled :: WasmInterpConfig -> Bool
wasmInterpTargetPlatform :: WasmInterpConfig -> Platform
wasmInterpOpts :: WasmInterpConfig -> [String]
wasmInterpLibDir :: WasmInterpConfig -> String
wasmInterpDyLD :: WasmInterpConfig -> String
..} = do
let Just UnitId
ghci_unit_id =
UnitState -> PackageName -> Maybe UnitId
lookupPackageName
UnitState
wasmInterpUnitState
(FastString -> PackageName
PackageName (FastString -> PackageName) -> FastString -> PackageName
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"ghci")
ghci_unit_info :: UnitInfo
ghci_unit_info = HasDebugCallStack => UnitState -> UnitId -> UnitInfo
UnitState -> UnitId -> UnitInfo
unsafeLookupUnitId UnitState
wasmInterpUnitState UnitId
ghci_unit_id
ghci_so_dirs :: [String]
ghci_so_dirs = (FilePathST -> String) -> [FilePathST] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FilePathST -> String
ST.unpack ([FilePathST] -> [String]) -> [FilePathST] -> [String]
forall a b. (a -> b) -> a -> b
$ UnitInfo -> [FilePathST]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [FilePathST]
unitLibraryDynDirs UnitInfo
ghci_unit_info
[String
ghci_lib_name] = (FilePathST -> String) -> [FilePathST] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FilePathST -> String
ST.unpack ([FilePathST] -> [String]) -> [FilePathST] -> [String]
forall a b. (a -> b) -> a -> b
$ UnitInfo -> [FilePathST]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [FilePathST]
unitLibraries UnitInfo
ghci_unit_info
ghci_so_name :: String
ghci_so_name = String
ghci_lib_name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wasmInterpHsSoSuffix
ghci_so_file :: String
ghci_so_file = Platform -> String -> String
platformHsSOName Platform
wasmInterpTargetPlatform String
ghci_so_name
Just ghci_so_path <- [String] -> String -> IO (Maybe String)
findFile [String]
ghci_so_dirs String
ghci_so_file
(rfd1, wfd1) <- Posix.createPipe
(rfd2, wfd2) <- Posix.createPipe
Posix.setFdOption rfd1 Posix.CloseOnExec True
Posix.setFdOption wfd2 Posix.CloseOnExec True
(_, _, _, ph) <-
createProcess
( proc wasmInterpDyLD $
[wasmInterpLibDir, ghci_so_path, show wfd1, show rfd2]
++ wasmInterpOpts
++ ["+RTS", "-H64m", "-RTS"]
)
Posix.closeFd wfd1
Posix.closeFd rfd2
rh <- Posix.fdToHandle rfd1
wh <- Posix.fdToHandle wfd2
hSetBuffering wh NoBuffering
hSetBuffering rh NoBuffering
lo_ref <- newIORef Nothing
pending_frees <- newMVar []
lock <- newMVar ()
pure
$ ExtInterpInstance
{ instProcess =
InterpProcess
{ interpHandle = ph,
interpPipe = Pipe {pipeRead = rh, pipeWrite = wh, pipeLeftovers = lo_ref},
interpLock = lock
},
instPendingFrees = pending_frees,
instExtra = ()
}
#else
spawnWasmInterp _ = sorry "Wasm iserv doesn't work on Win32 host yet"
#endif