{-# LANGUAGE CPP #-}
module GHC.Runtime.Interpreter.Types
( Interp(..)
, InterpInstance(..)
, InterpProcess (..)
, ExtInterp (..)
, ExtInterpStatusVar
, ExtInterpInstance (..)
, ExtInterpState (..)
, InterpStatus(..)
, IServ
, IServConfig(..)
, JSInterp
, JSInterpExtra (..)
, JSInterpConfig (..)
, JSState (..)
, NodeJsSettings (..)
, defaultNodeJsSettings
, WasmInterp
, WasmInterpConfig (..)
)
where
import GHC.Prelude
import GHC.Linker.Types
import GHCi.RemoteTypes
import GHCi.Message ( Pipe )
import GHC.Types.Unique.FM
import GHC.Data.FastString ( FastString )
import Foreign
import GHC.Platform
import GHC.Utils.TmpFs
import GHC.Utils.Logger
import GHC.Unit.Env
import GHC.Unit.State
import GHC.Unit.Types
import GHC.StgToJS.Types
import GHC.StgToJS.Linker.Types
import Control.Concurrent
import System.Process ( ProcessHandle, CreateProcess )
import System.IO
import GHC.Unit.Finder.Types (FinderCache, FinderOpts)
data Interp = Interp
{ Interp -> InterpInstance
interpInstance :: !InterpInstance
, Interp -> Loader
interpLoader :: !Loader
, Interp -> MVar (UniqFM FastString (Ptr ()))
interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ())))
}
data InterpInstance
= ExternalInterp !ExtInterp
#if defined(HAVE_INTERNAL_INTERPRETER)
| InternalInterp
#endif
data ExtInterp
= ExtIServ !IServ
| ExtJS !JSInterp
| ExtWasm !WasmInterp
data ExtInterpState cfg details = ExtInterpState
{ forall cfg details. ExtInterpState cfg details -> cfg
interpConfig :: !cfg
, forall cfg details.
ExtInterpState cfg details -> ExtInterpStatusVar details
interpStatus :: !(ExtInterpStatusVar details)
}
type ExtInterpStatusVar d = MVar (InterpStatus (ExtInterpInstance d))
type IServ = ExtInterpState IServConfig ()
type JSInterp = ExtInterpState JSInterpConfig JSInterpExtra
type WasmInterp = ExtInterpState WasmInterpConfig ()
data InterpProcess = InterpProcess
{ InterpProcess -> Pipe
interpPipe :: !Pipe
, InterpProcess -> ProcessHandle
interpHandle :: !ProcessHandle
, InterpProcess -> MVar ()
interpLock :: !(MVar ())
}
data InterpStatus inst
= InterpPending
| InterpRunning !inst
data IServConfig = IServConfig
{ IServConfig -> String
iservConfProgram :: !String
, IServConfig -> [String]
iservConfOpts :: ![String]
, IServConfig -> Bool
iservConfProfiled :: !Bool
, IServConfig -> Bool
iservConfDynamic :: !Bool
, IServConfig -> Maybe (CreateProcess -> IO ProcessHandle)
iservConfHook :: !(Maybe (CreateProcess -> IO ProcessHandle))
, IServConfig -> IO ()
iservConfTrace :: IO ()
}
data ExtInterpInstance c = ExtInterpInstance
{ forall c. ExtInterpInstance c -> InterpProcess
instProcess :: {-# UNPACK #-} !InterpProcess
, forall c. ExtInterpInstance c -> MVar [HValueRef]
instPendingFrees :: !(MVar [HValueRef])
, :: !c
}
data =
{ JSInterpExtra -> Handle
instStdIn :: !Handle
, JSInterpExtra -> FinderCache
instFinderCache :: !FinderCache
, JSInterpExtra -> FinderOpts
instFinderOpts :: !FinderOpts
, JSInterpExtra -> MVar JSState
instJSState :: !(MVar JSState)
, JSInterpExtra -> UnitId
instGhciUnitId :: !UnitId
}
data JSState = JSState
{ JSState -> LinkPlan
jsLinkState :: !LinkPlan
, JSState -> Bool
jsServerStarted :: !Bool
}
data NodeJsSettings = NodeJsSettings
{ NodeJsSettings -> String
nodeProgram :: FilePath
, NodeJsSettings -> Maybe String
nodePath :: Maybe FilePath
, :: [String]
, NodeJsSettings -> Integer
nodeKeepAliveMaxMem :: Integer
}
defaultNodeJsSettings :: NodeJsSettings
defaultNodeJsSettings :: NodeJsSettings
defaultNodeJsSettings = NodeJsSettings
{ nodeProgram :: String
nodeProgram = String
"node"
, nodePath :: Maybe String
nodePath = Maybe String
forall a. Maybe a
Nothing
, nodeExtraArgs :: [String]
nodeExtraArgs = []
, nodeKeepAliveMaxMem :: Integer
nodeKeepAliveMaxMem = Integer
536870912
}
data JSInterpConfig = JSInterpConfig
{ JSInterpConfig -> NodeJsSettings
jsInterpNodeConfig :: !NodeJsSettings
, JSInterpConfig -> String
jsInterpScript :: !FilePath
, JSInterpConfig -> TmpFs
jsInterpTmpFs :: !TmpFs
, JSInterpConfig -> TempDir
jsInterpTmpDir :: !TempDir
, JSInterpConfig -> Logger
jsInterpLogger :: !Logger
, JSInterpConfig -> StgToJSConfig
jsInterpCodegenCfg :: !StgToJSConfig
, JSInterpConfig -> UnitEnv
jsInterpUnitEnv :: !UnitEnv
, JSInterpConfig -> FinderOpts
jsInterpFinderOpts :: !FinderOpts
, JSInterpConfig -> FinderCache
jsInterpFinderCache :: !FinderCache
}
data WasmInterpConfig = WasmInterpConfig
{ WasmInterpConfig -> String
wasmInterpDyLD :: !FilePath
, WasmInterpConfig -> String
wasmInterpLibDir :: FilePath
, WasmInterpConfig -> [String]
wasmInterpOpts :: ![String]
, WasmInterpConfig -> Platform
wasmInterpTargetPlatform :: !Platform
, WasmInterpConfig -> Bool
wasmInterpProfiled :: !Bool
, WasmInterpConfig -> String
wasmInterpHsSoSuffix :: !String
, WasmInterpConfig -> UnitState
wasmInterpUnitState :: !UnitState
}