{-# 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)

-- See Note [The Wasm Dynamic Linker] for details
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

-- Due to difficulty of using inherited pipe file descriptor in
-- nodejs, unfortunately we don't support Win32 host yet
spawnWasmInterp _ = sorry "Wasm iserv doesn't work on Win32 host yet"

#endif