    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE BlockArguments #-}
    {-# LANGUAGE LambdaCase #-}

    -- | JavaScript interpreter
    --
    -- See Note [The JS interpreter]
    --
    module GHC.Runtime.Interpreter.JS
      ( spawnJSInterp
      , jsLinkRts
      , jsLinkInterp
      , jsLinkObject
      , jsLinkObjects
      , jsLoadFile
      , jsRunServer
      -- * Reexported for convenience
      , mkExportedModFuns
      )
    where

    import GHC.Prelude
    import GHC.Runtime.Interpreter.Types
    import GHC.Runtime.Interpreter.Process
    import GHC.Runtime.Utils
    import GHCi.Message

    import GHC.StgToJS.Linker.Types
    import GHC.StgToJS.Linker.Linker
    import GHC.StgToJS.Types
    import GHC.StgToJS.Object

    import GHC.Unit.Env
    import GHC.Unit.Types
    import GHC.Unit.State

    import GHC.Utils.Logger
    import GHC.Utils.TmpFs
    import GHC.Utils.Panic
    import GHC.Utils.Error (logInfo)
    import GHC.Utils.Outputable (text)
    import GHC.Data.FastString
    import GHC.Types.Unique.FM

    import Control.Concurrent
    import Control.Monad

    import System.Process
    import System.IO
    import System.FilePath

    import Data.IORef
    import qualified Data.Set    as Set
    import qualified Data.ByteString as B

    import Foreign.C.String

    -- Note [The JS interpreter]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- The JS interpreter works as follows:
    --
    -- ghc-interp.js is a simple JS script used to bootstrap the external
    -- interpreter server (iserv) that is written in Haskell. This script waits for
    -- commands on stdin:
    --
    --      LOAD foo.js
    --
    --        load a JS file in the current JS environment
    --
    --      RUN_SERVER ghci_unit_id
    --
    --        execute h$main(h$ghci_unit_idZCGHCiziServerzidefaultServer),
    --        the entry point of the interpreter server
    --
    -- On the GHC side, when we need the interpreter we do the following:
    --
    -- 1. spawn nodejs with $topdir/ghc-interp.js script
    -- 2. link the JS rts and send a LOAD command to load it
    -- 3. link iserv (i.e. use GHCi.Server.defaultServer as root) and LOAD it
    -- 4. send a RUN_SERVER command to execute the JS iserv
    --
    -- From this moment on, everything happens as with the native iserv, using a
    -- pipe for communication, with the following differences:
    --
    --  - the JS iserv only supports the LoadObj linking command which has been
    --  repurposed to load a JS source file. The JS iserv doesn't deal with
    --  libraries (.a) and with object files (.o). The linker state is maintained on
    --  the GHC side and GHC only sends the appropriate chunks of JS code to link.
    --
    --  - the JS iserv doesn't support ByteCode (i.e. it doesn't support CreateBCOs
    --  messages). JS iserv clients should use the usual JS compilation pipeline and
    --  send JS code instead. See GHC.Driver.Main.hscCompileCoreExpr for an example.
    --
    -- GHC keeps track of JS blocks (JS unit of linking corresponding to top-level
    -- binding groups) that have already been linked by the JS interpreter. It only
    -- links new ones when necessary.
    --
    -- Note that the JS interpreter isn't subject to staging issues: we can use it
    -- in a Stage1 GHC.
    --

    ---------------------------------------------------------
    -- Running node
    ---------------------------------------------------------

    -- | Start NodeJS interactively with "ghc-interp.js" script loaded in
    startTHRunnerProcess :: FilePath -> NodeJsSettings -> IO (Handle,InterpProcess)
    startTHRunnerProcess :: FilePath -> NodeJsSettings -> IO (Handle, InterpProcess)
    startTHRunnerProcess FilePath
    interp_js NodeJsSettings
    settings = do
      interp_in <- Handle -> IO (IORef Handle)
    forall a. a -> IO (IORef a)
    newIORef Handle
    forall a. HasCallStack => a
    undefined

      let createProc CreateProcess
    cp = do
              let cp' :: CreateProcess
    cp' = CreateProcess
    cp
                          { std_in  = CreatePipe
                          , std_out = Inherit
                          , std_err = Inherit
                          }
              (mb_in, _mb_out, _mb_err, hdl) <- CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcess CreateProcess
    cp'
              -- we can't directly return stdin for the process given the current
              -- implementation of runWithPipes. So we just use an IORef for this...
              case mb_in of
                Maybe Handle
    Nothing -> FilePath -> IO ()
    forall a. HasCallStack => FilePath -> a
    panic FilePath
    "startTHRunnerProcess: expected stdin for interpreter"
                Just Handle
    i  -> IORef Handle -> Handle -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Handle
    interp_in Handle
    i
              return hdl

      (hdl, rh, wh) <- runWithPipes createProc (nodeProgram settings)
                                               [interp_js]
                                               (nodeExtraArgs settings)
      std_in <- readIORef interp_in

      lo_ref <- newIORef Nothing
      let pipe = Pipe { pipeRead :: Handle
    pipeRead = Handle
    rh, pipeWrite :: Handle
    pipeWrite = Handle
    wh, pipeLeftovers :: IORef (Maybe ByteString)
    pipeLeftovers = IORef (Maybe ByteString)
    lo_ref }
      let proc = InterpProcess
                  { interpHandle :: ProcessHandle
    interpHandle = ProcessHandle
    hdl
                  , interpPipe :: Pipe
    interpPipe   = Pipe
    pipe
                  }
      pure (std_in, proc)

    -- | Spawn a JS interpreter
    --
    -- Run NodeJS with "ghc-interp.js" loaded in. Then load GHCi.Server and its deps
    -- (including the rts) and run GHCi.Server.defaultServer.
    spawnJSInterp :: JSInterpConfig -> IO (ExtInterpInstance JSInterpExtra)
    spawnJSInterp :: JSInterpConfig -> IO (ExtInterpInstance JSInterpExtra)
    spawnJSInterp JSInterpConfig
    cfg = do
      let logger :: Logger
    logger= JSInterpConfig -> Logger
    jsInterpLogger JSInterpConfig
    cfg
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Logger -> Int -> Bool
    logVerbAtLeast Logger
    logger Int
    2) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Logger -> SDoc -> IO ()
    logInfo Logger
    logger (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Spawning JS interpreter")

      let tmpfs :: TmpFs
    tmpfs        = JSInterpConfig -> TmpFs
    jsInterpTmpFs JSInterpConfig
    cfg
          tmp_dir :: TempDir
    tmp_dir      = JSInterpConfig -> TempDir
    jsInterpTmpDir JSInterpConfig
    cfg
          logger :: Logger
    logger       = JSInterpConfig -> Logger
    jsInterpLogger JSInterpConfig
    cfg
          codegen_cfg :: StgToJSConfig
    codegen_cfg  = JSInterpConfig -> StgToJSConfig
    jsInterpCodegenCfg JSInterpConfig
    cfg
          unit_env :: UnitEnv
    unit_env     = JSInterpConfig -> UnitEnv
    jsInterpUnitEnv JSInterpConfig
    cfg
          finder_opts :: FinderOpts
    finder_opts  = JSInterpConfig -> FinderOpts
    jsInterpFinderOpts JSInterpConfig
    cfg
          finder_cache :: FinderCache
    finder_cache = JSInterpConfig -> FinderCache
    jsInterpFinderCache JSInterpConfig
    cfg

      (std_in, proc) <- FilePath -> NodeJsSettings -> IO (Handle, InterpProcess)
    startTHRunnerProcess (JSInterpConfig -> FilePath
    jsInterpScript JSInterpConfig
    cfg) (JSInterpConfig -> NodeJsSettings
    jsInterpNodeConfig JSInterpConfig
    cfg)

      js_state <- newMVar (JSState
                    { jsLinkState     = emptyLinkPlan
                    , jsServerStarted = False
                    })

      -- get the unit-id of the ghci package. We need this to load the
      -- interpreter code.
      ghci_unit_id <- case lookupPackageName (ue_units unit_env) (PackageName (fsLit "ghci")) of
        Maybe UnitId
    Nothing -> FilePath -> IO UnitId
    forall a. FilePath -> IO a
    cmdLineErrorIO FilePath
    "JS interpreter: couldn't find \"ghci\" package"
        Just UnitId
    i  -> UnitId -> IO UnitId
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure UnitId
    i

      let extra = JSInterpExtra
            { instStdIn :: Handle
    instStdIn        = Handle
    std_in
            , instJSState :: MVar JSState
    instJSState      = MVar JSState
    js_state
            , instFinderCache :: FinderCache
    instFinderCache  = FinderCache
    finder_cache
            , instFinderOpts :: FinderOpts
    instFinderOpts   = FinderOpts
    finder_opts
            , instGhciUnitId :: UnitId
    instGhciUnitId   = UnitId
    ghci_unit_id
            }

      pending_frees <- newMVar []
      lookup_cache  <- newMVar emptyUFM
      let inst = ExtInterpInstance
            { instProcess :: InterpProcess
    instProcess           = InterpProcess
    proc
            , instPendingFrees :: MVar [HValueRef]
    instPendingFrees      = MVar [HValueRef]
    pending_frees
            , instLookupSymbolCache :: MVar (UniqFM FastString (Ptr ()))
    instLookupSymbolCache = MVar (UniqFM FastString (Ptr ()))
    lookup_cache
            , instExtra :: JSInterpExtra
    instExtra             = JSInterpExtra
    extra
            }

      -- TODO: to support incremental linking of wasm modules (e.g. produced from C
      -- sources), we should:
      --
      -- 1. link the emcc rts without trimming dead code as we don't know what might
      -- be needed later by the Wasm modules we will dynamically load (cf
      -- -sMAIN_MODULE).
      -- 2. make the RUN_SERVER command wait for the emcc rts to be loaded.
      -- 3. link wasm modules with -sSIDE_MODULE
      -- 4. add a new command to load side modules with Emscripten's dlopen
      --
      -- cf https://emscripten.org/docs/compiling/Dynamic-Linking.html

      -- link rts and its deps
      jsLinkRts logger tmpfs tmp_dir codegen_cfg unit_env inst

      -- link interpreter and its deps
      jsLinkInterp logger tmpfs tmp_dir codegen_cfg unit_env inst

      -- run interpreter main loop
      jsRunServer inst

      pure inst

    ---------------------------------------------------------
    -- Interpreter commands
    ---------------------------------------------------------

    -- | Link JS RTS
    jsLinkRts :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> IO ()
    jsLinkRts :: Logger
    -> TmpFs
    -> TempDir
    -> StgToJSConfig
    -> UnitEnv
    -> ExtInterpInstance JSInterpExtra
    -> IO ()
    jsLinkRts Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir StgToJSConfig
    cfg UnitEnv
    unit_env ExtInterpInstance JSInterpExtra
    inst = do
      let link_cfg :: JSLinkConfig
    link_cfg = JSLinkConfig
            { lcNoStats :: Bool
    lcNoStats         = Bool
    True  -- we don't need the stats
            , lcNoRts :: Bool
    lcNoRts           = Bool
    False -- we need the RTS
            , lcCombineAll :: Bool
    lcCombineAll      = Bool
    False -- we don't need the combined all.js, we'll link each part independently below
            , lcForeignRefs :: Bool
    lcForeignRefs     = Bool
    False -- we don't need foreign references
            , lcNoJSExecutables :: Bool
    lcNoJSExecutables = Bool
    True  -- we don't need executables
            , lcNoHsMain :: Bool
    lcNoHsMain        = Bool
    True  -- nor HsMain
            , lcForceEmccRts :: Bool
    lcForceEmccRts    = Bool
    False -- nor the emcc rts
            , lcLinkCsources :: Bool
    lcLinkCsources    = Bool
    False -- we know that there are no C sources to load for the RTS
            }

      -- link the RTS and its dependencies (things it uses from `base`, etc.)
      let link_spec :: LinkSpec
    link_spec = LinkSpec
            { lks_unit_ids :: [UnitId]
    lks_unit_ids        = [UnitId
    rtsUnitId, UnitId
    ghcInternalUnitId, UnitId
    primUnitId]
            , lks_obj_root_filter :: ExportedFun -> Bool
    lks_obj_root_filter = Bool -> ExportedFun -> Bool
    forall a b. a -> b -> a
    const Bool
    False
            , lks_extra_roots :: Set ExportedFun
    lks_extra_roots     = Set ExportedFun
    forall a. Monoid a => a
    mempty
            , lks_objs_hs :: [FilePath]
    lks_objs_hs         = [FilePath]
    forall a. Monoid a => a
    mempty
            , lks_objs_js :: [FilePath]
    lks_objs_js         = [FilePath]
    forall a. Monoid a => a
    mempty
            , lks_objs_cc :: [FilePath]
    lks_objs_cc         = [FilePath]
    forall a. Monoid a => a
    mempty
            }

      let finder_opts :: FinderOpts
    finder_opts  = JSInterpExtra -> FinderOpts
    instFinderOpts (ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst)
          finder_cache :: FinderCache
    finder_cache = JSInterpExtra -> FinderCache
    instFinderCache (ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst)

      ar_cache <- IO ArchiveCache
    newArchiveCache
      link_plan <- computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache ar_cache
      jsLinkPlan logger tmpfs tmp_dir ar_cache link_cfg cfg inst link_plan

    -- | Link JS interpreter
    jsLinkInterp :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> IO ()
    jsLinkInterp :: Logger
    -> TmpFs
    -> TempDir
    -> StgToJSConfig
    -> UnitEnv
    -> ExtInterpInstance JSInterpExtra
    -> IO ()
    jsLinkInterp Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir StgToJSConfig
    cfg UnitEnv
    unit_env ExtInterpInstance JSInterpExtra
    inst = do

      let link_cfg :: JSLinkConfig
    link_cfg = JSLinkConfig
            { lcNoStats :: Bool
    lcNoStats         = Bool
    True  -- we don't need the stats
            , lcNoRts :: Bool
    lcNoRts           = Bool
    True  -- we don't need the RTS
            , lcCombineAll :: Bool
    lcCombineAll      = Bool
    False -- we don't need the combined all.js, we'll link each part independently below
            , lcForeignRefs :: Bool
    lcForeignRefs     = Bool
    False -- we don't need foreign references
            , lcNoJSExecutables :: Bool
    lcNoJSExecutables = Bool
    True  -- we don't need executables
            , lcNoHsMain :: Bool
    lcNoHsMain        = Bool
    True  -- nor HsMain
            , lcForceEmccRts :: Bool
    lcForceEmccRts    = Bool
    False -- nor the emcc rts
            , lcLinkCsources :: Bool
    lcLinkCsources    = Bool
    True  -- enable C sources, if any
            }

      let is_root :: p -> Bool
    is_root p
    _ = Bool
    True -- FIXME: we shouldn't consider every function as a root

      let ghci_unit_id :: UnitId
    ghci_unit_id = JSInterpExtra -> UnitId
    instGhciUnitId (ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst)

      -- compute unit dependencies of ghc_unit_id
      let unit_map :: UnitInfoMap
    unit_map = UnitState -> UnitInfoMap
    unitInfoMap (HasDebugCallStack => UnitEnv -> UnitState
    UnitEnv -> UnitState
    ue_units UnitEnv
    unit_env)
      dep_units <- MaybeErr UnitErr [UnitId] -> IO [UnitId]
    forall a. MaybeErr UnitErr a -> IO a
    mayThrowUnitErr (MaybeErr UnitErr [UnitId] -> IO [UnitId])
    -> MaybeErr UnitErr [UnitId] -> IO [UnitId]
    forall a b. (a -> b) -> a -> b
    $ UnitInfoMap
    -> [(UnitId, Maybe UnitId)] -> MaybeErr UnitErr [UnitId]
    closeUnitDeps UnitInfoMap
    unit_map [(UnitId
    ghci_unit_id,Maybe UnitId
    forall a. Maybe a
    Nothing)]
      let units = [UnitId]
    dep_units [UnitId] -> [UnitId] -> [UnitId]
    forall a. [a] -> [a] -> [a]
    ++ [UnitId
    ghci_unit_id]

      -- indicate that our root function is GHCi.Server.defaultServer
      let root_deps = [ExportedFun] -> Set ExportedFun
    forall a. Ord a => [a] -> Set a
    Set.fromList ([ExportedFun] -> Set ExportedFun)
    -> [ExportedFun] -> Set ExportedFun
    forall a b. (a -> b) -> a -> b
    $ UnitId -> FastString -> [FastString] -> [ExportedFun]
    mkExportedFuns UnitId
    ghci_unit_id (FilePath -> FastString
    fsLit FilePath
    "GHCi.Server") [FilePath -> FastString
    fsLit FilePath
    "defaultServer"]

      -- link the interpreter and its dependencies
      let link_spec = LinkSpec
            { lks_unit_ids :: [UnitId]
    lks_unit_ids        = [UnitId]
    units
            , lks_obj_root_filter :: ExportedFun -> Bool
    lks_obj_root_filter = ExportedFun -> Bool
    forall {p}. p -> Bool
    is_root
            , lks_extra_roots :: Set ExportedFun
    lks_extra_roots     = Set ExportedFun
    root_deps
            , lks_objs_hs :: [FilePath]
    lks_objs_hs         = [FilePath]
    forall a. Monoid a => a
    mempty
            , lks_objs_js :: [FilePath]
    lks_objs_js         = [FilePath]
    forall a. Monoid a => a
    mempty
            , lks_objs_cc :: [FilePath]
    lks_objs_cc         = [FilePath]
    forall a. Monoid a => a
    mempty
            }

      let finder_cache = JSInterpExtra -> FinderCache
    instFinderCache (ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst)
          finder_opts  = JSInterpExtra -> FinderOpts
    instFinderOpts (ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst)

      ar_cache <- newArchiveCache
      link_plan <- computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache ar_cache
      jsLinkPlan logger tmpfs tmp_dir ar_cache link_cfg cfg inst link_plan

    -- | Link object files
    jsLinkObjects :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> [FilePath] -> (ExportedFun -> Bool) -> IO ()
    jsLinkObjects :: Logger
    -> TmpFs
    -> TempDir
    -> StgToJSConfig
    -> UnitEnv
    -> ExtInterpInstance JSInterpExtra
    -> [FilePath]
    -> (ExportedFun -> Bool)
    -> IO ()
    jsLinkObjects Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir StgToJSConfig
    cfg UnitEnv
    unit_env ExtInterpInstance JSInterpExtra
    inst [FilePath]
    objs ExportedFun -> Bool
    is_root = do
      let link_cfg :: JSLinkConfig
    link_cfg = JSLinkConfig
            { lcNoStats :: Bool
    lcNoStats         = Bool
    True  -- we don't need the stats
            , lcNoRts :: Bool
    lcNoRts           = Bool
    True  -- we don't need the RTS (already linked)
            , lcCombineAll :: Bool
    lcCombineAll      = Bool
    False -- we don't need the combined all.js, we'll link each part independently below
            , lcForeignRefs :: Bool
    lcForeignRefs     = Bool
    False -- we don't need foreign references
            , lcNoJSExecutables :: Bool
    lcNoJSExecutables = Bool
    True  -- we don't need executables
            , lcNoHsMain :: Bool
    lcNoHsMain        = Bool
    True  -- nor HsMain
            , lcForceEmccRts :: Bool
    lcForceEmccRts    = Bool
    False -- nor the emcc rts
            , lcLinkCsources :: Bool
    lcLinkCsources    = Bool
    True  -- enable C sources, if any
            }

      let units :: [UnitId]
    units = UnitState -> [UnitId]
    preloadUnits (HasDebugCallStack => UnitEnv -> UnitState
    UnitEnv -> UnitState
    ue_units UnitEnv
    unit_env)
                  [UnitId] -> [UnitId] -> [UnitId]
    forall a. [a] -> [a] -> [a]
    ++ [UnitId
    thUnitId] -- don't forget TH which is an implicit dep

      -- compute dependencies
      let link_spec :: LinkSpec
    link_spec = LinkSpec
            { lks_unit_ids :: [UnitId]
    lks_unit_ids        = [UnitId]
    units
            , lks_obj_root_filter :: ExportedFun -> Bool
    lks_obj_root_filter = ExportedFun -> Bool
    is_root
            , lks_extra_roots :: Set ExportedFun
    lks_extra_roots     = Set ExportedFun
    forall a. Monoid a => a
    mempty
            , lks_objs_hs :: [FilePath]
    lks_objs_hs         = [FilePath]
    objs
            , lks_objs_js :: [FilePath]
    lks_objs_js         = [FilePath]
    forall a. Monoid a => a
    mempty
            , lks_objs_cc :: [FilePath]
    lks_objs_cc         = [FilePath]
    forall a. Monoid a => a
    mempty
            }

      let finder_opts :: FinderOpts
    finder_opts  = JSInterpExtra -> FinderOpts
    instFinderOpts (ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst)
          finder_cache :: FinderCache
    finder_cache = JSInterpExtra -> FinderCache
    instFinderCache (ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst)

      ar_cache <- IO ArchiveCache
    newArchiveCache
      link_plan <- computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache ar_cache
      jsLinkPlan logger tmpfs tmp_dir ar_cache link_cfg cfg inst link_plan

    -- | Link an object file using the given functions as roots
    jsLinkObject :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> FilePath -> [ExportedFun] -> IO ()
    jsLinkObject :: Logger
    -> TmpFs
    -> TempDir
    -> StgToJSConfig
    -> UnitEnv
    -> ExtInterpInstance JSInterpExtra
    -> FilePath
    -> [ExportedFun]
    -> IO ()
    jsLinkObject Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir StgToJSConfig
    cfg UnitEnv
    unit_env ExtInterpInstance JSInterpExtra
    inst FilePath
    obj [ExportedFun]
    roots = do
      let is_root :: ExportedFun -> Bool
    is_root ExportedFun
    f = ExportedFun -> Set ExportedFun -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member ExportedFun
    f ([ExportedFun] -> Set ExportedFun
    forall a. Ord a => [a] -> Set a
    Set.fromList [ExportedFun]
    roots)
      let objs :: [FilePath]
    objs      = [FilePath
    obj]
      Logger
    -> TmpFs
    -> TempDir
    -> StgToJSConfig
    -> UnitEnv
    -> ExtInterpInstance JSInterpExtra
    -> [FilePath]
    -> (ExportedFun -> Bool)
    -> IO ()
    jsLinkObjects Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir StgToJSConfig
    cfg UnitEnv
    unit_env ExtInterpInstance JSInterpExtra
    inst [FilePath]
    objs ExportedFun -> Bool
    is_root

    -- | Link the given link plan
    --
    -- Perform incremental linking by removing what is already linked from the plan
    jsLinkPlan :: Logger -> TmpFs -> TempDir -> ArchiveCache -> JSLinkConfig -> StgToJSConfig -> ExtInterpInstance JSInterpExtra -> LinkPlan -> IO ()
    jsLinkPlan :: Logger
    -> TmpFs
    -> TempDir
    -> ArchiveCache
    -> JSLinkConfig
    -> StgToJSConfig
    -> ExtInterpInstance JSInterpExtra
    -> LinkPlan
    -> IO ()
    jsLinkPlan Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir ArchiveCache
    ar_cache JSLinkConfig
    link_cfg StgToJSConfig
    cfg ExtInterpInstance JSInterpExtra
    inst LinkPlan
    link_plan = do
      ----------------------------------------------------------------
      -- Get already linked stuff and compute incremental plan
      ----------------------------------------------------------------

      old_plan <- JSState -> LinkPlan
    jsLinkState (JSState -> LinkPlan) -> IO JSState -> IO LinkPlan
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVar JSState -> IO JSState
    forall a. MVar a -> IO a
    readMVar (JSInterpExtra -> MVar JSState
    instJSState (ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst))

      -- compute new plan discarding what's already linked
      let (diff_plan, total_plan) = incrementLinkPlan old_plan link_plan

      ----------------------------------------------------------------
      -- Generate JS code for the incremental plan
      ----------------------------------------------------------------

      tmp_out <- newTempSubDir logger tmpfs tmp_dir
      void $ jsLink link_cfg cfg logger tmpfs ar_cache tmp_out diff_plan

      -- Code has been linked into the following files:
      --  - generated rts from tmp_out/rts.js (depends on link options)
      --  - raw js files from tmp_out/lib.js
      --  - Haskell generated JS from tmp_out/out.js

      -- We need to combine at least rts.js and lib.js for the RTS because they
      -- depend on each other. We might as well combine them all, so that's what we
      -- do.
      let filenames
            | JSLinkConfig -> Bool
    lcNoRts JSLinkConfig
    link_cfg = [FilePath
    "lib.js", FilePath
    "out.js"]
            | Bool
    otherwise        = [FilePath
    "rts.js", FilePath
    "lib.js", FilePath
    "out.js"]
      let files = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath
    tmp_out FilePath -> FilePath -> FilePath
    </>) [FilePath]
    filenames
      let all_js = FilePath
    tmp_out FilePath -> FilePath -> FilePath
    </> FilePath
    "all.js"
      let all_files = FilePath
    all_js FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : [FilePath]
    files
      withBinaryFile all_js WriteMode $ \Handle
    h -> do
        let cpy :: FilePath -> IO ()
    cpy FilePath
    i = FilePath -> IO ByteString
    B.readFile FilePath
    i IO ByteString -> (ByteString -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Handle -> ByteString -> IO ()
    B.hPut Handle
    h
        (FilePath -> IO ()) -> [FilePath] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ FilePath -> IO ()
    cpy [FilePath]
    files

      -- add files to clean
      addFilesToClean tmpfs TFL_CurrentModule all_files

      ----------------------------------------------------------------
      -- Link JS code
      ----------------------------------------------------------------

      -- linking JS code depends on the phase we're in:
      -- - during in the initialization phase, we send a LoadFile message to the
      --   JS server;
      -- - once the Haskell server is started, we send a LoadObj message to the
      --   Haskell server.
      server_started <- jsServerStarted <$> readMVar (instJSState (instExtra inst))
      if server_started
        then sendMessageNoResponse inst $ LoadObj all_js
        else jsLoadFile            inst all_js

      ----------------------------------------------------------------
      -- update linker state
      ----------------------------------------------------------------
      modifyMVar_ (instJSState (instExtra inst)) $ \JSState
    state -> JSState -> IO JSState
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JSState
    state { jsLinkState = total_plan }

    -- | Send a command to the JS interpreter
    jsSendCommand :: ExtInterpInstance JSInterpExtra -> String -> IO ()
    jsSendCommand :: ExtInterpInstance JSInterpExtra -> FilePath -> IO ()
    jsSendCommand ExtInterpInstance JSInterpExtra
    inst FilePath
    cmd = FilePath -> IO ()
    send_cmd FilePath
    cmd
      where
        extra :: JSInterpExtra
    extra      = ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst
        handle :: Handle
    handle     = JSInterpExtra -> Handle
    instStdIn JSInterpExtra
    extra
        send_cmd :: FilePath -> IO ()
    send_cmd FilePath
    s = do
          FilePath -> (CStringLen -> IO ()) -> IO ()
    forall a. FilePath -> (CStringLen -> IO a) -> IO a
    withCStringLen FilePath
    s \(Ptr CChar
    p,Int
    n) -> Handle -> Ptr CChar -> Int -> IO ()
    forall a. Handle -> Ptr a -> Int -> IO ()
    hPutBuf Handle
    handle Ptr CChar
    p Int
    n
          Handle -> IO ()
    hFlush Handle
    handle

    -- | Load a JS file in the interpreter
    jsLoadFile :: ExtInterpInstance JSInterpExtra -> FilePath -> IO ()
    jsLoadFile :: ExtInterpInstance JSInterpExtra -> FilePath -> IO ()
    jsLoadFile ExtInterpInstance JSInterpExtra
    inst FilePath
    path = ExtInterpInstance JSInterpExtra -> FilePath -> IO ()
    jsSendCommand ExtInterpInstance JSInterpExtra
    inst (FilePath
    "LOAD " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    path FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "\n")

    -- | Run JS server
    jsRunServer :: ExtInterpInstance JSInterpExtra -> IO ()
    jsRunServer :: ExtInterpInstance JSInterpExtra -> IO ()
    jsRunServer ExtInterpInstance JSInterpExtra
    inst = do
      let ghci_unit_id :: UnitId
    ghci_unit_id = JSInterpExtra -> UnitId
    instGhciUnitId (ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst)
      let zghci_unit_id :: FilePath
    zghci_unit_id = FastZString -> FilePath
    zString (FastString -> FastZString
    zEncodeFS (UnitId -> FastString
    unitIdFS UnitId
    ghci_unit_id))

      -- Run `GHCi.Server.defaultServer`
      ExtInterpInstance JSInterpExtra -> FilePath -> IO ()
    jsSendCommand ExtInterpInstance JSInterpExtra
    inst (FilePath
    "RUN_SERVER " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    zghci_unit_id FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "\n")

      -- indicate that the Haskell server is now started
      MVar JSState -> (JSState -> IO JSState) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ (JSInterpExtra -> MVar JSState
    instJSState (ExtInterpInstance JSInterpExtra -> JSInterpExtra
    forall c. ExtInterpInstance c -> c
    instExtra ExtInterpInstance JSInterpExtra
    inst)) ((JSState -> IO JSState) -> IO ())
    -> (JSState -> IO JSState) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \JSState
    state -> JSState -> IO JSState
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JSState
    state { jsServerStarted = True }