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

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.StgToJS.Linker.Linker
    -- Copyright   :  (c) The University of Glasgow 2001
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Jeffrey Young  <jeffrey.young@iohk.io>
    --                Luite Stegeman <luite.stegeman@iohk.io>
    --                Sylvain Henry  <sylvain.henry@iohk.io>
    --                Josh Meredith  <josh.meredith@iohk.io>
    -- Stability   :  experimental
    --
    -- GHCJS linker, collects dependencies from the object files
    -- which contain linkable units with dependency information
    --
    -----------------------------------------------------------------------------

    module GHC.StgToJS.Linker.Linker
      ( jsLinkBinary
      , jsLink
      , embedJsFile
      , staticInitStat
      , staticDeclStat
      , mkExportedFuns
      , mkExportedModFuns
      , computeLinkDependencies
      , LinkSpec (..)
      , LinkPlan (..)
      , emptyLinkPlan
      , incrementLinkPlan
      , ArchiveCache
      , newArchiveCache
      )
    where

    import GHC.Prelude

    import GHC.Platform.Host (hostPlatformArchOS)

    import GHC.JS.Make
    import GHC.JS.Optimizer
    import GHC.JS.Ident
    import GHC.JS.JStg.Syntax
    import GHC.JS.JStg.Monad
    import qualified GHC.JS.Syntax as JS
    import GHC.JS.Transform

    import GHC.Driver.DynFlags (DynFlags(..))
    import Language.Haskell.Syntax.Module.Name
    import GHC.SysTools.Cpp
    import GHC.SysTools

    import GHC.Linker.Static.Utils (exeFileName)
    import GHC.Linker.Types (Unlinked(..), linkableUnlinked)
    import GHC.Linker.External

    import GHC.StgToJS.Linker.Types
    import GHC.StgToJS.Linker.Utils
    import GHC.StgToJS.Linker.Opt
    import GHC.StgToJS.Rts.Rts
    import GHC.StgToJS.Object
    import GHC.StgToJS.Types hiding (LinkableUnit)
    import GHC.StgToJS.Symbols
    import GHC.StgToJS.Arg
    import GHC.StgToJS.Closure

    import GHC.Unit.State
    import GHC.Unit.Env
    import GHC.Unit.Home.ModInfo
    import GHC.Unit.Types
    import GHC.Unit.Module (moduleStableString)

    import GHC.Utils.Outputable hiding ((<>))
    import GHC.Utils.BufHandle
    import GHC.Utils.Panic
    import GHC.Utils.Error
    import GHC.Utils.Logger (Logger, logVerbAtLeast)
    import GHC.Utils.Binary
    import qualified GHC.Utils.Ppr as Ppr
    import GHC.Utils.TmpFs

    import GHC.Types.Unique.Set

    import qualified GHC.SysTools.Ar          as Ar

    import qualified GHC.Data.ShortText as ST
    import GHC.Data.FastString

    import Control.Monad

    import Data.Array
    import qualified Data.ByteString          as B
    import qualified Data.ByteString.Char8    as BC
    import qualified Data.ByteString.Lazy     as BL
    import qualified Data.ByteString          as BS
    import Data.Function            (on)
    import qualified Data.IntSet              as IS
    import Data.IORef
    import Data.List  ( nub, intercalate, groupBy, intersperse, sortBy)
    import Data.Map.Strict          (Map)
    import qualified Data.Map.Strict          as M
    import Data.Maybe
    import Data.Set                 (Set)
    import qualified Data.Set                 as S
    import Data.Word
    import Data.Monoid

    import System.IO
    import System.FilePath ((<.>), (</>), dropExtension, takeDirectory)
    import System.Directory ( createDirectoryIfMissing
                            , doesFileExist
                            , getCurrentDirectory
                            , Permissions(..)
                            , setPermissions
                            , getPermissions
                            )

    import GHC.Unit.Finder.Types
    import GHC.Unit.Finder (findObjectLinkableMaybe, findHomeModule)
    import GHC.Driver.Config.Finder (initFinderOpts)

    data LinkerStats = LinkerStats
      { LinkerStats -> Map Module Word64
    bytesPerModule     :: !(Map Module Word64) -- ^ number of bytes linked per module
      , LinkerStats -> Word64
    packedMetaDataSize :: !Word64              -- ^ number of bytes for metadata
      }

    newtype ArchiveCache = ArchiveCache { ArchiveCache -> IORef (Map FilePath Archive)
    loadedArchives :: IORef (Map FilePath Ar.Archive) }

    newArchiveCache :: IO ArchiveCache
    newArchiveCache :: IO ArchiveCache
    newArchiveCache = IORef (Map FilePath Archive) -> ArchiveCache
    ArchiveCache (IORef (Map FilePath Archive) -> ArchiveCache)
    -> IO (IORef (Map FilePath Archive)) -> IO ArchiveCache
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Map FilePath Archive -> IO (IORef (Map FilePath Archive))
    forall a. a -> IO (IORef a)
    newIORef Map FilePath Archive
    forall k a. Map k a
    M.empty

    defaultJsContext :: SDocContext
    defaultJsContext :: SDocContext
    defaultJsContext = SDocContext
    defaultSDocContext{sdocStyle = PprCode}

    jsLinkBinary
      :: FinderCache
      -> JSLinkConfig
      -> StgToJSConfig
      -> Logger
      -> TmpFs
      -> DynFlags
      -> UnitEnv
      -> [FilePath]
      -> [UnitId]
      -> IO ()
    jsLinkBinary :: FinderCache
    -> JSLinkConfig
    -> StgToJSConfig
    -> Logger
    -> TmpFs
    -> DynFlags
    -> UnitEnv
    -> [FilePath]
    -> [UnitId]
    -> IO ()
    jsLinkBinary FinderCache
    finder_cache JSLinkConfig
    lc_cfg StgToJSConfig
    cfg Logger
    logger TmpFs
    tmpfs DynFlags
    dflags UnitEnv
    unit_env [FilePath]
    hs_objs [UnitId]
    dep_units
      | JSLinkConfig -> Bool
    lcNoJSExecutables JSLinkConfig
    lc_cfg = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool
    otherwise = do

        -- additional objects to link are passed as FileOption ldInputs...
        let cmdline_objs :: [FilePath]
    cmdline_objs = [ FilePath
    f | FileOption FilePath
    _ FilePath
    f <- DynFlags -> [Option]
    ldInputs DynFlags
    dflags ]

        -- cmdline objects: discriminate between the 3 kinds of objects we have
        let disc :: [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> IO ([FilePath], [FilePath], [FilePath])
    disc [FilePath]
    hss [FilePath]
    jss [FilePath]
    ccs = \case
              []     -> ([FilePath], [FilePath], [FilePath])
    -> IO ([FilePath], [FilePath], [FilePath])
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([FilePath]
    hss, [FilePath]
    jss, [FilePath]
    ccs)
              (FilePath
    o:[FilePath]
    os) -> FilePath -> IO (Maybe ObjectKind)
    getObjectKind FilePath
    o IO (Maybe ObjectKind)
    -> (Maybe ObjectKind -> IO ([FilePath], [FilePath], [FilePath]))
    -> IO ([FilePath], [FilePath], [FilePath])
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                Just ObjectKind
    ObjHs -> [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> IO ([FilePath], [FilePath], [FilePath])
    disc (FilePath
    oFilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :[FilePath]
    hss) [FilePath]
    jss [FilePath]
    ccs [FilePath]
    os
                Just ObjectKind
    ObjJs -> [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> IO ([FilePath], [FilePath], [FilePath])
    disc [FilePath]
    hss (FilePath
    oFilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :[FilePath]
    jss) [FilePath]
    ccs [FilePath]
    os
                Just ObjectKind
    ObjCc -> [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> IO ([FilePath], [FilePath], [FilePath])
    disc [FilePath]
    hss [FilePath]
    jss (FilePath
    oFilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :[FilePath]
    ccs) [FilePath]
    os
                Maybe ObjectKind
    Nothing    -> do
                  Logger -> SDoc -> IO ()
    logInfo Logger
    logger ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Ignoring unexpected command-line object: ", FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    o])
                  [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> IO ([FilePath], [FilePath], [FilePath])
    disc [FilePath]
    hss [FilePath]
    jss [FilePath]
    ccs [FilePath]
    os
        (cmdline_hs_objs, cmdline_js_objs, cmdline_cc_objs) <- [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> [FilePath]
    -> IO ([FilePath], [FilePath], [FilePath])
    disc [] [] [] [FilePath]
    cmdline_objs

        let
            exe         = DynFlags -> FilePath
    jsExeFileName DynFlags
    dflags
            all_hs_objs = [FilePath]
    hs_objs [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ [FilePath]
    cmdline_hs_objs
            all_js_objs = [FilePath]
    cmdline_js_objs
            all_cc_objs = [FilePath]
    cmdline_cc_objs
            is_root p
    _   = Bool
    True
                          -- FIXME: we shouldn't consider every function as a root,
                          -- but only the program entry point (main), either the
                          -- generated one or coming from an object

        -- compute dependencies
        let link_spec = LinkSpec
              { lks_unit_ids :: [UnitId]
    lks_unit_ids        = [UnitId]
    dep_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
    forall a. Monoid a => a
    mempty
              , lks_objs_hs :: [FilePath]
    lks_objs_hs         = [FilePath]
    all_hs_objs
              , lks_objs_js :: [FilePath]
    lks_objs_js         = [FilePath]
    all_js_objs
              , lks_objs_cc :: [FilePath]
    lks_objs_cc         = [FilePath]
    all_cc_objs
              }

        let finder_opts = DynFlags -> FinderOpts
    initFinderOpts DynFlags
    dflags
        ar_cache <- newArchiveCache

        link_plan <- computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache ar_cache

        void $ jsLink lc_cfg cfg logger tmpfs ar_cache exe link_plan

    -- | link and write result to disk (jsexe directory)
    jsLink
         :: JSLinkConfig
         -> StgToJSConfig
         -> Logger
         -> TmpFs
         -> ArchiveCache
         -> FilePath               -- ^ output file/directory
         -> LinkPlan
         -> IO ()
    jsLink :: JSLinkConfig
    -> StgToJSConfig
    -> Logger
    -> TmpFs
    -> ArchiveCache
    -> FilePath
    -> LinkPlan
    -> IO ()
    jsLink JSLinkConfig
    lc_cfg StgToJSConfig
    cfg Logger
    logger TmpFs
    tmpfs ArchiveCache
    ar_cache FilePath
    out LinkPlan
    link_plan = do

          -- create output directory
          Bool -> FilePath -> IO ()
    createDirectoryIfMissing Bool
    False FilePath
    out

          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Logger -> BlockId -> Bool
    logVerbAtLeast Logger
    logger BlockId
    2) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Logger -> SDoc -> IO ()
    logInfo Logger
    logger (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ SDoc -> BlockId -> SDoc -> SDoc
    hang (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "jsLink:") BlockId
    2 (LinkPlan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LinkPlan
    link_plan)

          -------------------------------------------------------------
          -- link all Haskell code (program + dependencies) into out.js

          -- retrieve code for Haskell dependencies
          mods <- ArchiveCache -> LinkPlan -> IO [ModuleCode]
    collectModuleCodes ArchiveCache
    ar_cache LinkPlan
    link_plan

          -- LTO + rendering of JS code
          link_stats <- withBinaryFile (out </> "out.js") WriteMode $ \Handle
    h ->
            Handle -> Bool -> [ModuleCode] -> IO LinkerStats
    renderModules Handle
    h (StgToJSConfig -> Bool
    csPrettyRender StgToJSConfig
    cfg) [ModuleCode]
    mods

          -------------------------------------------------------------

          -- dump foreign references file (.frefs)
          when (lcForeignRefs lc_cfg) $ do
            let frefsFile  = FilePath
    "out.frefs"
                -- frefs      = concatMap mc_frefs mods
                jsonFrefs  = ByteString
    forall a. Monoid a => a
    mempty -- FIXME: toJson frefs

            BL.writeFile (out </> frefsFile <.> "json") jsonFrefs
            BL.writeFile (out </> frefsFile <.> "js")
                         ("h$checkForeignRefs(" <> jsonFrefs <> ");")

          -- dump stats
          unless (lcNoStats lc_cfg) $ do
            let statsFile = FilePath
    "out.stats"
            writeFile (out </> statsFile) (renderLinkerStats link_stats)

          -- link generated RTS parts into rts.js
          unless (lcNoRts lc_cfg) $ do
            jsm <- initJSM
            withFile (out </> "rts.js") WriteMode $ \Handle
    h -> do
              let opt :: JStat
    opt = JStat -> JStat
    jsOptimize (JEnv -> JSM JStat -> JStat
    forall a. JEnv -> JSM a -> a
    runJSM JEnv
    jsm (JSM JStat -> JStat) -> JSM JStat -> JStat
    forall a b. (a -> b) -> a -> b
    $ JStgStat -> JStat
    jStgStatToJS (JStgStat -> JStat) -> StateT JEnv Identity JStgStat -> JSM JStat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StgToJSConfig -> StateT JEnv Identity JStgStat
    rts StgToJSConfig
    cfg)
              IO Integer -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO Integer -> IO ()) -> IO Integer -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                Bool -> Handle -> JStat -> IO Integer
    hPutJS (StgToJSConfig -> Bool
    csPrettyRender StgToJSConfig
    cfg) Handle
    h JStat
    opt

          -- link user-provided JS files into lib.js
          (emcc_opts,lib_cc_objs) <- withBinaryFile (out </> "lib.js") WriteMode $ \Handle
    h -> do

            let
                tmp_dir :: TempDir
    tmp_dir = LinkerConfig -> TempDir
    linkerTempDir (StgToJSConfig -> LinkerConfig
    csLinkerConfig StgToJSConfig
    cfg)

                -- JS objects from dependencies' archives (.a)
                go_archives :: JSOptions -> [FilePath] -> [FilePath] -> IO (JSOptions, [FilePath])
    go_archives JSOptions
    emcc_opts [FilePath]
    cc_objs = \case
                  []     -> (JSOptions, [FilePath]) -> IO (JSOptions, [FilePath])
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (JSOptions
    emcc_opts, [FilePath]
    cc_objs)
                  (FilePath
    a:[FilePath]
    as) -> do
                    Ar.Archive entries <- ArchiveCache -> FilePath -> IO Archive
    loadArchive ArchiveCache
    ar_cache FilePath
    a
                    (emcc_opts', cc_objs') <- go_entries emcc_opts cc_objs entries
                    go_archives emcc_opts' cc_objs' as

                -- archive's entries
                go_entries :: JSOptions
    -> [FilePath] -> [ArchiveEntry] -> IO (JSOptions, [FilePath])
    go_entries JSOptions
    emcc_opts [FilePath]
    cc_objs = \case
                  []     -> (JSOptions, [FilePath]) -> IO (JSOptions, [FilePath])
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (JSOptions
    emcc_opts, [FilePath]
    cc_objs)
                  (ArchiveEntry
    e:[ArchiveEntry]
    es) -> case ByteString -> Maybe ObjectKind
    getObjectKindBS (ArchiveEntry -> ByteString
    Ar.filedata ArchiveEntry
    e) of
                    Just ObjectKind
    ObjHs -> do
                      -- Nothing to do. HS objects are collected in
                      -- collectModuleCodes
                      JSOptions
    -> [FilePath] -> [ArchiveEntry] -> IO (JSOptions, [FilePath])
    go_entries JSOptions
    emcc_opts [FilePath]
    cc_objs [ArchiveEntry]
    es
                    Just ObjectKind
    ObjCc -> do
                      -- extract the object file from the archive in a temporary
                      -- file and return its path
                      cc_obj_fn <- Logger
    -> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
    newTempName Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir TempFileLifetime
    TFL_CurrentModule FilePath
    "o"
                      B.writeFile cc_obj_fn (Ar.filedata e)
                      let cc_objs' = FilePath
    cc_obj_fnFilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :[FilePath]
    cc_objs
                      go_entries emcc_opts cc_objs' es
                    Just ObjectKind
    ObjJs -> do
                      -- extract the JS code and append it to the `lib.js` file
                      (opts,bs) <- ByteString -> IO (JSOptions, ByteString)
    parseJSObjectBS (ArchiveEntry -> ByteString
    Ar.filedata ArchiveEntry
    e)
                      B.hPut   h bs
                      hPutChar h '\n'
                      let emcc_opts' = JSOptions
    emcc_opts JSOptions -> JSOptions -> JSOptions
    forall a. Semigroup a => a -> a -> a
    <> JSOptions
    opts
                      go_entries emcc_opts' cc_objs es
                    Maybe ObjectKind
    Nothing -> do
                      Logger -> SDoc -> IO ()
    logInfo Logger
    logger ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Ignoring unexpected archive entry: ", FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text (ArchiveEntry -> FilePath
    Ar.filename ArchiveEntry
    e)])
                      JSOptions
    -> [FilePath] -> [ArchiveEntry] -> IO (JSOptions, [FilePath])
    go_entries JSOptions
    emcc_opts [FilePath]
    cc_objs [ArchiveEntry]
    es

                -- additional JS objects (e.g. from the command-line)
                go_extra :: JSOptions -> [FilePath] -> IO JSOptions
    go_extra JSOptions
    emcc_opts = \case
                  []     -> JSOptions -> IO JSOptions
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JSOptions
    emcc_opts
                  (FilePath
    e:[FilePath]
    es) -> do
                    (opts,bs) <- FilePath -> IO (JSOptions, ByteString)
    readJSObject FilePath
    e
                    B.hPut h bs
                    hPutChar h '\n'
                    let emcc_opts' = JSOptions
    emcc_opts JSOptions -> JSOptions -> JSOptions
    forall a. Semigroup a => a -> a -> a
    <> JSOptions
    opts
                    go_extra emcc_opts' es

            -- archives
            (emcc_opts0, cc_objs) <- JSOptions -> [FilePath] -> [FilePath] -> IO (JSOptions, [FilePath])
    go_archives JSOptions
    defaultJSOptions [] (Set FilePath -> [FilePath]
    forall a. Set a -> [a]
    S.toList (LinkPlan -> Set FilePath
    lkp_archives LinkPlan
    link_plan))
            -- extra object files
            emcc_opts1            <- go_extra emcc_opts0 (S.toList (lkp_objs_js link_plan))
            pure (emcc_opts1,cc_objs)

          -- Link Cc objects using emcc's linker
          --
          -- Cc objects have been extracted from archives (see above) and are listed
          -- in lib_cc_objs.
          --
          -- We don't link C sources if there are none (obviously) or if asked
          -- explicitly by the user with -ddisable-js-c-sources (mostly used for
          -- debugging purpose).
          let emcc_objs     = [FilePath]
    lib_cc_objs [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ Set FilePath -> [FilePath]
    forall a. Set a -> [a]
    S.toList (LinkPlan -> Set FilePath
    lkp_objs_cc LinkPlan
    link_plan)
          let has_emcc_objs = Bool -> Bool
    not ([FilePath] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FilePath]
    emcc_objs)
          let link_c_sources = JSLinkConfig -> Bool
    lcLinkCsources JSLinkConfig
    lc_cfg Bool -> Bool -> Bool
    && Bool
    has_emcc_objs

          when link_c_sources $ do

            runLink logger tmpfs (csLinkerConfig cfg) $
              [ Option "-o"
              , FileOption "" (out </> "clibs.js")
              -- Embed wasm files into a single .js file
              , Option "-sSINGLE_FILE=1"
              -- Enable support for addFunction (callbacks)
              , Option "-sALLOW_TABLE_GROWTH"
              -- keep some RTS methods and functions (otherwise removed as dead
              -- code)
              , Option ("-sEXPORTED_RUNTIME_METHODS=" ++ concat (intersperse "," (emccExportedRuntimeMethods emcc_opts)))
              , Option ("-sEXPORTED_FUNCTIONS=" ++ concat (intersperse "," (emccExportedFunctions emcc_opts)))
              ]
              -- pass extra options from JS files' pragmas
              ++ map Option (emccExtraOptions emcc_opts)
              -- link objects
              ++ map (FileOption "") emcc_objs

          -- Don't enable the Emcc rts when not needed (i.e. no Wasm module to link
          -- with) and not forced by the caller (e.g. in the future iserv may require
          -- incremental linking of Wasm modules, hence the emcc rts even building
          -- iserv itself doesn't require the emcc rts)
          let use_emcc_rts = Bool -> UseEmccRts
    UseEmccRts (Bool -> UseEmccRts) -> Bool -> UseEmccRts
    forall a b. (a -> b) -> a -> b
    $ Bool
    link_c_sources Bool -> Bool -> Bool
    || JSLinkConfig -> Bool
    lcForceEmccRts JSLinkConfig
    lc_cfg

          -- link everything together into a runnable all.js
          -- only if we link a complete application,
          --   no incremental linking and no skipped parts
          when (lcCombineAll lc_cfg && not (lcNoRts lc_cfg)) $ do
            writeRunMain out use_emcc_rts
            _ <- combineFiles lc_cfg link_c_sources out
            writeHtml    out
            writeRunner lc_cfg out
            writeExterns out

    data LinkSpec = LinkSpec
      { LinkSpec -> [UnitId]
    lks_unit_ids        :: [UnitId]
      , LinkSpec -> ExportedFun -> Bool
    lks_obj_root_filter :: ExportedFun -> Bool -- ^ Predicate for exported functions in objects to declare as root
      , LinkSpec -> Set ExportedFun
    lks_extra_roots     :: Set ExportedFun -- ^ Extra root functions from loaded units
      , LinkSpec -> [FilePath]
    lks_objs_hs         :: [FilePath]      -- ^ HS objects to link
      , LinkSpec -> [FilePath]
    lks_objs_js         :: [FilePath]      -- ^ JS objects to link
      , LinkSpec -> [FilePath]
    lks_objs_cc         :: [FilePath]      -- ^ Cc objects to link
      }

    instance Outputable LinkSpec where
      ppr :: LinkSpec -> SDoc
    ppr LinkSpec
    s = SDoc -> BlockId -> SDoc -> SDoc
    hang (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "LinkSpec") BlockId
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat
                [ [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat [FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Unit ids: ", [UnitId] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (LinkSpec -> [UnitId]
    lks_unit_ids LinkSpec
    s)]
                , [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat [FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "HS objects:", [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((FilePath -> SDoc) -> [FilePath] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text (LinkSpec -> [FilePath]
    lks_objs_hs LinkSpec
    s))]
                , SDoc -> BlockId -> SDoc -> SDoc
    hang (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "JS objects::") BlockId
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((FilePath -> SDoc) -> [FilePath] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text (LinkSpec -> [FilePath]
    lks_objs_js LinkSpec
    s)))
                , SDoc -> BlockId -> SDoc -> SDoc
    hang (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Cc objects::") BlockId
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((FilePath -> SDoc) -> [FilePath] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text (LinkSpec -> [FilePath]
    lks_objs_cc LinkSpec
    s)))
                , FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Object root filter: <function>"
                , [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat [FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Extra roots: ", Set ExportedFun -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (LinkSpec -> Set ExportedFun
    lks_extra_roots LinkSpec
    s)]
                ]

    emptyLinkPlan :: LinkPlan
    emptyLinkPlan :: LinkPlan
    emptyLinkPlan = LinkPlan
      { lkp_block_info :: Map Module LocatedBlockInfo
    lkp_block_info = Map Module LocatedBlockInfo
    forall a. Monoid a => a
    mempty
      , lkp_dep_blocks :: Set BlockRef
    lkp_dep_blocks = Set BlockRef
    forall a. Monoid a => a
    mempty
      , lkp_archives :: Set FilePath
    lkp_archives   = Set FilePath
    forall a. Monoid a => a
    mempty
      , lkp_objs_js :: Set FilePath
    lkp_objs_js    = Set FilePath
    forall a. Monoid a => a
    mempty
      , lkp_objs_cc :: Set FilePath
    lkp_objs_cc    = Set FilePath
    forall a. Monoid a => a
    mempty
      }

    -- | Given a `base` link plan (assumed to be already linked) and a `new` link
    -- plan, compute `(diff, total)` link plans.
    --
    -- - `diff` is the incremental link plan to get from `base` to `total`
    -- - `total` is the total link plan as if `base` and `new` were linked at once
    incrementLinkPlan :: LinkPlan -> LinkPlan -> (LinkPlan, LinkPlan)
    incrementLinkPlan :: LinkPlan -> LinkPlan -> (LinkPlan, LinkPlan)
    incrementLinkPlan LinkPlan
    base LinkPlan
    new = (LinkPlan
    diff,LinkPlan
    total)
      where
        total :: LinkPlan
    total = LinkPlan
          { lkp_block_info :: Map Module LocatedBlockInfo
    lkp_block_info = Map Module LocatedBlockInfo
    -> Map Module LocatedBlockInfo -> Map Module LocatedBlockInfo
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union (LinkPlan -> Map Module LocatedBlockInfo
    lkp_block_info LinkPlan
    base) (LinkPlan -> Map Module LocatedBlockInfo
    lkp_block_info LinkPlan
    new)
          , lkp_dep_blocks :: Set BlockRef
    lkp_dep_blocks = Set BlockRef -> Set BlockRef -> Set BlockRef
    forall a. Ord a => Set a -> Set a -> Set a
    S.union (LinkPlan -> Set BlockRef
    lkp_dep_blocks LinkPlan
    base) (LinkPlan -> Set BlockRef
    lkp_dep_blocks LinkPlan
    new)
          , lkp_archives :: Set FilePath
    lkp_archives   = Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    S.union (LinkPlan -> Set FilePath
    lkp_archives LinkPlan
    base) (LinkPlan -> Set FilePath
    lkp_archives LinkPlan
    new)
          , lkp_objs_js :: Set FilePath
    lkp_objs_js    = Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    S.union (LinkPlan -> Set FilePath
    lkp_objs_js LinkPlan
    base) (LinkPlan -> Set FilePath
    lkp_objs_js LinkPlan
    new)
          , lkp_objs_cc :: Set FilePath
    lkp_objs_cc    = Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    S.union (LinkPlan -> Set FilePath
    lkp_objs_cc LinkPlan
    base) (LinkPlan -> Set FilePath
    lkp_objs_cc LinkPlan
    new)
          }
        diff :: LinkPlan
    diff = LinkPlan
          { lkp_block_info :: Map Module LocatedBlockInfo
    lkp_block_info = LinkPlan -> Map Module LocatedBlockInfo
    lkp_block_info LinkPlan
    new -- block info from "new" contains all we need to load new blocks
          , lkp_dep_blocks :: Set BlockRef
    lkp_dep_blocks = Set BlockRef -> Set BlockRef -> Set BlockRef
    forall a. Ord a => Set a -> Set a -> Set a
    S.difference (LinkPlan -> Set BlockRef
    lkp_dep_blocks LinkPlan
    new) (LinkPlan -> Set BlockRef
    lkp_dep_blocks LinkPlan
    base)
          , lkp_archives :: Set FilePath
    lkp_archives   = Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    S.difference (LinkPlan -> Set FilePath
    lkp_archives LinkPlan
    new)   (LinkPlan -> Set FilePath
    lkp_archives LinkPlan
    base)
          , lkp_objs_js :: Set FilePath
    lkp_objs_js    = Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    S.difference (LinkPlan -> Set FilePath
    lkp_objs_js LinkPlan
    new)    (LinkPlan -> Set FilePath
    lkp_objs_js LinkPlan
    base)
          , lkp_objs_cc :: Set FilePath
    lkp_objs_cc    = Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    S.difference (LinkPlan -> Set FilePath
    lkp_objs_cc LinkPlan
    new)    (LinkPlan -> Set FilePath
    lkp_objs_cc LinkPlan
    base)
          }

    computeLinkDependencies
      :: StgToJSConfig
      -> UnitEnv
      -> LinkSpec
      -> FinderOpts
      -> FinderCache
      -> ArchiveCache
      -> IO LinkPlan
    computeLinkDependencies :: StgToJSConfig
    -> UnitEnv
    -> LinkSpec
    -> FinderOpts
    -> FinderCache
    -> ArchiveCache
    -> IO LinkPlan
    computeLinkDependencies StgToJSConfig
    cfg UnitEnv
    unit_env LinkSpec
    link_spec FinderOpts
    finder_opts FinderCache
    finder_cache ArchiveCache
    ar_cache = do

      let units :: [UnitId]
    units       = LinkSpec -> [UnitId]
    lks_unit_ids        LinkSpec
    link_spec
      let hs_objs :: [FilePath]
    hs_objs     = LinkSpec -> [FilePath]
    lks_objs_hs         LinkSpec
    link_spec
      let js_objs :: [FilePath]
    js_objs     = LinkSpec -> [FilePath]
    lks_objs_js         LinkSpec
    link_spec
      let cc_objs :: [FilePath]
    cc_objs     = LinkSpec -> [FilePath]
    lks_objs_cc         LinkSpec
    link_spec
      let extra_roots :: Set ExportedFun
    extra_roots = LinkSpec -> Set ExportedFun
    lks_extra_roots     LinkSpec
    link_spec
      let obj_is_root :: ExportedFun -> Bool
    obj_is_root = LinkSpec -> ExportedFun -> Bool
    lks_obj_root_filter LinkSpec
    link_spec

      -- Process:
      -- 1) Find new required linkables (object files, libraries, etc.) for all
      -- transitive dependencies
      -- 2) Load ObjBlockInfo from them and cache them
      -- 3) Compute ObjBlock dependencies and return the link plan

      -- TODO (#23013): currently we directly compute the ObjBlock dependencies and
      -- find/load linkable on-demand when a module is missing.

      (objs_block_info, objs_required_blocks) <- [FilePath] -> IO (Map Module LocatedBlockInfo, [BlockRef])
    loadObjBlockInfo [FilePath]
    hs_objs

      let obj_roots = [ExportedFun] -> Set ExportedFun
    forall a. Ord a => [a] -> Set a
    S.fromList ([ExportedFun] -> Set ExportedFun)
    -> ([ExportedFun] -> [ExportedFun])
    -> [ExportedFun]
    -> Set ExportedFun
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ExportedFun -> Bool) -> [ExportedFun] -> [ExportedFun]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ExportedFun -> Bool
    obj_is_root ([ExportedFun] -> Set ExportedFun)
    -> [ExportedFun] -> Set ExportedFun
    forall a b. (a -> b) -> a -> b
    $ (LocatedBlockInfo -> [ExportedFun])
    -> [LocatedBlockInfo] -> [ExportedFun]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Map ExportedFun BlockId -> [ExportedFun]
    forall k a. Map k a -> [k]
    M.keys (Map ExportedFun BlockId -> [ExportedFun])
    -> (LocatedBlockInfo -> Map ExportedFun BlockId)
    -> LocatedBlockInfo
    -> [ExportedFun]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlockInfo -> Map ExportedFun BlockId
    bi_exports (BlockInfo -> Map ExportedFun BlockId)
    -> (LocatedBlockInfo -> BlockInfo)
    -> LocatedBlockInfo
    -> Map ExportedFun BlockId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LocatedBlockInfo -> BlockInfo
    lbi_info) (Map Module LocatedBlockInfo -> [LocatedBlockInfo]
    forall k a. Map k a -> [a]
    M.elems Map Module LocatedBlockInfo
    objs_block_info)
          obj_units = (Module -> UnitId) -> [Module] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map Module -> UnitId
    moduleUnitId ([Module] -> [UnitId]) -> [Module] -> [UnitId]
    forall a b. (a -> b) -> a -> b
    $ [Module] -> [Module]
    forall a. Eq a => [a] -> [a]
    nub (Map Module LocatedBlockInfo -> [Module]
    forall k a. Map k a -> [k]
    M.keys Map Module LocatedBlockInfo
    objs_block_info)

      let (rts_wired_units, rts_wired_functions) = rtsDeps

      -- all the units we want to link together, without their dependencies
      let root_units = (UnitId -> Bool) -> [UnitId] -> [UnitId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= UnitEnv -> UnitId
    ue_currentUnit UnitEnv
    unit_env)
                       ([UnitId] -> [UnitId]) -> [UnitId] -> [UnitId]
    forall a b. (a -> b) -> a -> b
    $ (UnitId -> Bool) -> [UnitId] -> [UnitId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= UnitId
    interactiveUnitId)
                       ([UnitId] -> [UnitId]) -> [UnitId] -> [UnitId]
    forall a b. (a -> b) -> a -> b
    $ [UnitId] -> [UnitId]
    forall a. Eq a => [a] -> [a]
    nub
                       ([UnitId] -> [UnitId]) -> [UnitId] -> [UnitId]
    forall a b. (a -> b) -> a -> b
    $ [UnitId]
    rts_wired_units [UnitId] -> [UnitId] -> [UnitId]
    forall a. [a] -> [a] -> [a]
    ++ [UnitId] -> [UnitId]
    forall a. [a] -> [a]
    reverse [UnitId]
    obj_units [UnitId] -> [UnitId] -> [UnitId]
    forall a. [a] -> [a] -> [a]
    ++ [UnitId] -> [UnitId]
    forall a. [a] -> [a]
    reverse [UnitId]
    units

      -- all the units we want to link together, including their dependencies,
      -- preload units, and backpack instantiations
      all_units_infos <- mayThrowUnitErr (preloadUnitsInfo' unit_env root_units)

      let all_units = (UnitInfo -> UnitId) -> [UnitInfo] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap UnitInfo -> UnitId
    forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
    unitId [UnitInfo]
    all_units_infos

      dep_archives <- getPackageArchives cfg unit_env all_units
      (archives_block_info, archives_required_blocks) <- loadArchiveBlockInfo ar_cache dep_archives

      -- compute dependencies
      let block_info      = Map Module LocatedBlockInfo
    objs_block_info Map Module LocatedBlockInfo
    -> Map Module LocatedBlockInfo -> Map Module LocatedBlockInfo
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `M.union` Map Module LocatedBlockInfo
    archives_block_info
          dep_fun_roots   = Set ExportedFun
    obj_roots Set ExportedFun -> Set ExportedFun -> Set ExportedFun
    forall a. Ord a => Set a -> Set a -> Set a
    `S.union` Set ExportedFun
    rts_wired_functions Set ExportedFun -> Set ExportedFun -> Set ExportedFun
    forall a. Ord a => Set a -> Set a -> Set a
    `S.union` Set ExportedFun
    extra_roots

      -- read transitive dependencies
      new_required_blocks_var <- newIORef []
      let load_info Module
    mod = do
            -- Adapted from the tangled code in GHC.Linker.Loader.getLinkDeps.
            linkable <- case Module -> HomeUnitGraph -> Maybe HomeModInfo
    lookupHugByModule Module
    mod (UnitEnv -> HomeUnitGraph
    ue_home_unit_graph UnitEnv
    unit_env) of
              Maybe HomeModInfo
    Nothing ->
                    -- It's not in the HPT because we are in one shot mode,
                    -- so use the Finder to get a ModLocation...
                  case UnitEnv -> Maybe HomeUnit
    ue_homeUnit UnitEnv
    unit_env of
                    Maybe HomeUnit
    Nothing -> FilePath -> SDoc -> IO Linkable
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "getDeps: No home-unit: " (Module -> SDoc
    forall doc. IsLine doc => Module -> doc
    pprModule Module
    mod)
                    Just HomeUnit
    home_unit -> do
                        mb_stuff <- FinderCache
    -> FinderOpts -> HomeUnit -> ModuleName -> IO FindResult
    findHomeModule FinderCache
    finder_cache FinderOpts
    finder_opts HomeUnit
    home_unit (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod)
                        case mb_stuff of
                          Found ModLocation
    loc Module
    mod -> ModLocation -> Module -> IO Linkable
    found ModLocation
    loc Module
    mod
                          FindResult
    _ -> FilePath -> SDoc -> IO Linkable
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "getDeps: Couldn't find home-module: " (Module -> SDoc
    forall doc. IsLine doc => Module -> doc
    pprModule Module
    mod)
                    where
                        found :: ModLocation -> Module -> IO Linkable
    found ModLocation
    loc Module
    mod = do {
                          mb_lnk <- Module -> ModLocation -> IO (Maybe Linkable)
    findObjectLinkableMaybe Module
    mod ModLocation
    loc ;
                          case mb_lnk of {
                              Maybe Linkable
    Nothing  -> FilePath -> SDoc -> IO Linkable
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "getDeps: Couldn't find linkable for module: " (Module -> SDoc
    forall doc. IsLine doc => Module -> doc
    pprModule Module
    mod) ;
                              Just Linkable
    lnk -> Linkable -> IO Linkable
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Linkable
    lnk
                          }}

              Just HomeModInfo
    mod_info -> case HomeModInfo -> Maybe Linkable
    homeModInfoObject HomeModInfo
    mod_info of
                Maybe Linkable
    Nothing  -> FilePath -> SDoc -> IO Linkable
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "getDeps: Couldn't find object file for home-module: " (Module -> SDoc
    forall doc. IsLine doc => Module -> doc
    pprModule Module
    mod)
                Just Linkable
    lnk -> Linkable -> IO Linkable
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Linkable
    lnk

            case linkableUnlinked linkable of
                  [DotO FilePath
    p] -> do
                      (bis, req_b) <- [FilePath] -> IO (Map Module LocatedBlockInfo, [BlockRef])
    loadObjBlockInfo [FilePath
    p]
                      -- Store new required blocks in IORef
                      modifyIORef new_required_blocks_var ((++) req_b)
                      case M.lookup mod bis of
                        Maybe LocatedBlockInfo
    Nothing -> FilePath -> SDoc -> IO LocatedBlockInfo
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "getDeps: Didn't load any block info for home-module: " (Module -> SDoc
    forall doc. IsLine doc => Module -> doc
    pprModule Module
    mod)
                        Just LocatedBlockInfo
    bi -> LocatedBlockInfo -> IO LocatedBlockInfo
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure LocatedBlockInfo
    bi
                  [Unlinked]
    ul -> FilePath -> SDoc -> IO LocatedBlockInfo
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "getDeps: Unrecognized linkable for home-module: "
                          ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ Module -> SDoc
    forall doc. IsLine doc => Module -> doc
    pprModule Module
    mod
                                , [Unlinked] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Unlinked]
    ul])

      -- required blocks have no dependencies, so don't have to use them as roots in
      -- the traversal
      (updated_block_info, transitive_deps) <- getDeps block_info load_info dep_fun_roots mempty

      new_required_blocks <- readIORef new_required_blocks_var
      let required_blocks = [BlockRef] -> Set BlockRef
    forall a. Ord a => [a] -> Set a
    S.fromList ([BlockRef] -> Set BlockRef) -> [BlockRef] -> Set BlockRef
    forall a b. (a -> b) -> a -> b
    $ [[BlockRef]] -> [BlockRef]
    forall a. Monoid a => [a] -> a
    mconcat
            [ [BlockRef]
    archives_required_blocks
            , [BlockRef]
    objs_required_blocks
            , [BlockRef]
    new_required_blocks
            ]

      let all_deps = Set BlockRef -> Set BlockRef -> Set BlockRef
    forall a. Ord a => Set a -> Set a -> Set a
    S.union Set BlockRef
    transitive_deps Set BlockRef
    required_blocks

      let plan = LinkPlan
            { lkp_block_info :: Map Module LocatedBlockInfo
    lkp_block_info = Map Module LocatedBlockInfo
    updated_block_info
            , lkp_dep_blocks :: Set BlockRef
    lkp_dep_blocks = Set BlockRef
    all_deps
            , lkp_archives :: Set FilePath
    lkp_archives   = [FilePath] -> Set FilePath
    forall a. Ord a => [a] -> Set a
    S.fromList [FilePath]
    dep_archives
            , lkp_objs_js :: Set FilePath
    lkp_objs_js    = [FilePath] -> Set FilePath
    forall a. Ord a => [a] -> Set a
    S.fromList [FilePath]
    js_objs
            , lkp_objs_cc :: Set FilePath
    lkp_objs_cc    = [FilePath] -> Set FilePath
    forall a. Ord a => [a] -> Set a
    S.fromList [FilePath]
    cc_objs
            }

      return plan

    -- | Compiled module
    data ModuleCode = ModuleCode
      { ModuleCode -> Module
    mc_module   :: !Module
      , ModuleCode -> JStat
    mc_js_code  :: !JS.JStat
      , ModuleCode -> ByteString
    mc_exports  :: !B.ByteString        -- ^ rendered exports
      , ModuleCode -> [ClosureInfo]
    mc_closures :: ![ClosureInfo]
      , ModuleCode -> [StaticInfo]
    mc_statics  :: ![StaticInfo]
      , ModuleCode -> [ForeignJSRef]
    mc_frefs    :: ![ForeignJSRef]
      }

    -- | ModuleCode after link with other modules.
    --
    -- It contains less information than ModuleCode because they have been commoned
    -- up into global "metadata" for the whole link.
    data CompactedModuleCode = CompactedModuleCode
      { CompactedModuleCode -> Module
    cmc_module  :: !Module
      , CompactedModuleCode -> JStat
    cmc_js_code :: !JS.JStat
      , CompactedModuleCode -> ByteString
    cmc_exports :: !B.ByteString        -- ^ rendered exports
      }

    -- | Output JS statements and return the output size in bytes.
    hPutJS :: Bool -> Handle -> JS.JStat -> IO Integer
    hPutJS :: Bool -> Handle -> JStat -> IO Integer
    hPutJS Bool
    render_pretty Handle
    h = \case
      JS.BlockStat [] -> Integer -> IO Integer
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Integer
    0
      JStat
    x                -> do
        before <- Handle -> IO Integer
    hTell Handle
    h
        if render_pretty
          then do
            printSDoc defaultJsContext (Ppr.PageMode True) h (pretty render_pretty x)
          else do
            bh <- newBufHandle h
            bPutHDoc bh defaultJsContext (line $ pretty render_pretty x)
            bFlush bh
        -- Append an empty line to correctly end the file in a newline
        hPutChar h '\n'
        after <- hTell h
        pure $! (after - before)

    -- | Link modules and pretty-print them into the given Handle
    renderModules
      :: Handle
      -> Bool         -- ^ should we render readable JS for debugging?
      -> [ModuleCode] -- ^ linked code per module
      -> IO LinkerStats
    renderModules :: Handle -> Bool -> [ModuleCode] -> IO LinkerStats
    renderModules Handle
    h Bool
    render_pretty [ModuleCode]
    mods = do

      -- link modules
      let ([CompactedModuleCode]
    compacted_mods, JStat
    meta) = [ModuleCode] -> ([CompactedModuleCode], JStat)
    linkModules [ModuleCode]
    mods

      let
        putJS :: JStat -> IO Integer
    putJS   = Bool -> Handle -> JStat -> IO Integer
    hPutJS Bool
    render_pretty Handle
    h

      ---------------------------------------------------------
      -- Pretty-print JavaScript code for all the dependencies.
      --
      -- We have to pretty-print at link time because we want to be able to perform
      -- global link-time optimisations (e.g. renamings) on the whole generated JS
      -- file.

      -- modules themselves
      mod_sizes <- [CompactedModuleCode]
    -> (CompactedModuleCode -> IO (Module, Word64))
    -> IO [(Module, Word64)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [CompactedModuleCode]
    compacted_mods ((CompactedModuleCode -> IO (Module, Word64))
     -> IO [(Module, Word64)])
    -> (CompactedModuleCode -> IO (Module, Word64))
    -> IO [(Module, Word64)]
    forall a b. (a -> b) -> a -> b
    $ \CompactedModuleCode
    m -> do

        !mod_size <- Integer -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Word64) -> IO Integer -> IO Word64
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (JStat -> IO Integer
    putJS (JStat -> IO Integer) -> JStat -> IO Integer
    forall a b. (a -> b) -> a -> b
    $ CompactedModuleCode -> JStat
    cmc_js_code CompactedModuleCode
    m)
        let !mod_mod  = CompactedModuleCode -> Module
    cmc_module CompactedModuleCode
    m
        pure (mod_mod, mod_size)

      -- commoned up metadata
      let meta_opt = JStat -> JStat
    jsOptimize JStat
    meta
      !meta_length <- fromIntegral <$> putJS meta_opt

      -- module exports
      mapM_ (B.hPut h . cmc_exports) compacted_mods

      -- stats
      let !link_stats = LinkerStats
            { bytesPerModule :: Map Module Word64
    bytesPerModule     = [(Module, Word64)] -> Map Module Word64
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(Module, Word64)]
    mod_sizes
            , packedMetaDataSize :: Word64
    packedMetaDataSize = Word64
    meta_length
            }

      pure link_stats

    -- | Render linker stats
    renderLinkerStats :: LinkerStats -> String
    renderLinkerStats :: LinkerStats -> FilePath
    renderLinkerStats LinkerStats
    s =
      FilePath -> [FilePath] -> FilePath
    forall a. [a] -> [[a]] -> [a]
    intercalate FilePath
    "\n\n" [FilePath
    meta_stats, FilePath
    package_stats, FilePath
    module_stats] FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "\n\n"
      where
        meta :: Word64
    meta = LinkerStats -> Word64
    packedMetaDataSize LinkerStats
    s
        meta_stats :: FilePath
    meta_stats = FilePath
    "number of modules: " FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> BlockId -> FilePath
    forall a. Show a => a -> FilePath
    show ([(Module, Word64)] -> BlockId
    forall a. [a] -> BlockId
    forall (t :: * -> *) a. Foldable t => t a -> BlockId
    length [(Module, Word64)]
    bytes_per_mod)
                     FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "\npacked metadata:   " FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> Word64 -> FilePath
    forall a. Show a => a -> FilePath
    show Word64
    meta

        bytes_per_mod :: [(Module, Word64)]
    bytes_per_mod = Map Module Word64 -> [(Module, Word64)]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map Module Word64 -> [(Module, Word64)])
    -> Map Module Word64 -> [(Module, Word64)]
    forall a b. (a -> b) -> a -> b
    $ LinkerStats -> Map Module Word64
    bytesPerModule LinkerStats
    s

        show_unit :: UnitId -> FilePath
    show_unit (UnitId FastString
    fs) = FastString -> FilePath
    unpackFS FastString
    fs

        ps :: Map UnitId Word64
        ps :: Map UnitId Word64
    ps = (Word64 -> Word64 -> Word64)
    -> [(UnitId, Word64)] -> Map UnitId Word64
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    M.fromListWith Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    (+) ([(UnitId, Word64)] -> Map UnitId Word64)
    -> ([(Module, Word64)] -> [(UnitId, Word64)])
    -> [(Module, Word64)]
    -> Map UnitId Word64
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Module, Word64) -> (UnitId, Word64))
    -> [(Module, Word64)] -> [(UnitId, Word64)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Module
    m,Word64
    s) -> (Module -> UnitId
    moduleUnitId Module
    m,Word64
    s)) ([(Module, Word64)] -> Map UnitId Word64)
    -> [(Module, Word64)] -> Map UnitId Word64
    forall a b. (a -> b) -> a -> b
    $ [(Module, Word64)]
    bytes_per_mod

        pad :: Int -> String -> String
        pad :: BlockId -> FilePath -> FilePath
    pad BlockId
    n FilePath
    t = let l :: BlockId
    l = FilePath -> BlockId
    forall a. [a] -> BlockId
    forall (t :: * -> *) a. Foldable t => t a -> BlockId
    length FilePath
    t
                  in  if BlockId
    l BlockId -> BlockId -> Bool
    forall a. Ord a => a -> a -> Bool
    < BlockId
    n then FilePath
    t FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> BlockId -> Char -> FilePath
    forall a. BlockId -> a -> [a]
    replicate (BlockId
    nBlockId -> BlockId -> BlockId
    forall a. Num a => a -> a -> a
    -BlockId
    l) Char
    ' ' else FilePath
    t

        pkgMods :: [[(Module,Word64)]]
        pkgMods :: [[(Module, Word64)]]
    pkgMods = ((Module, Word64) -> (Module, Word64) -> Bool)
    -> [(Module, Word64)] -> [[(Module, Word64)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (UnitId -> UnitId -> Bool)
    -> ((Module, Word64) -> UnitId)
    -> (Module, Word64)
    -> (Module, Word64)
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Module -> UnitId
    moduleUnitId (Module -> UnitId)
    -> ((Module, Word64) -> Module) -> (Module, Word64) -> UnitId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Module, Word64) -> Module
    forall a b. (a, b) -> a
    fst)) [(Module, Word64)]
    bytes_per_mod

        showMod :: (Module, Word64) -> String
        showMod :: (Module, Word64) -> FilePath
    showMod (Module
    m,Word64
    s) = BlockId -> FilePath -> FilePath
    pad BlockId
    40 (FilePath
    "    " FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> Module -> FilePath
    moduleStableString Module
    m FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    ":") FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> Word64 -> FilePath
    forall a. Show a => a -> FilePath
    show Word64
    s FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "\n"

        package_stats :: String
        package_stats :: FilePath
    package_stats = FilePath
    "code size summary per package (in bytes):\n\n"
                         FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> ((UnitId, Word64) -> FilePath) -> [(UnitId, Word64)] -> FilePath
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\(UnitId
    p,Word64
    s) -> BlockId -> FilePath -> FilePath
    pad BlockId
    25 (UnitId -> FilePath
    show_unit UnitId
    p FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    ":") FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> Word64 -> FilePath
    forall a. Show a => a -> FilePath
    show Word64
    s FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "\n") (Map UnitId Word64 -> [(UnitId, Word64)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map UnitId Word64
    ps)

        module_stats :: String
        module_stats :: FilePath
    module_stats = FilePath
    "code size per module (in bytes):\n\n" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> [FilePath] -> FilePath
    unlines (([(Module, Word64)] -> FilePath)
    -> [[(Module, Word64)]] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (((Module, Word64) -> FilePath) -> [(Module, Word64)] -> FilePath
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Module, Word64) -> FilePath
    showMod) [[(Module, Word64)]]
    pkgMods)

    getPackageArchives :: StgToJSConfig -> UnitEnv -> [UnitId] -> IO [FilePath]
    getPackageArchives :: StgToJSConfig -> UnitEnv -> [UnitId] -> IO [FilePath]
    getPackageArchives StgToJSConfig
    cfg UnitEnv
    unit_env [UnitId]
    units =
      (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM FilePath -> IO Bool
    doesFileExist [ ShortText -> FilePath
    ST.unpack ShortText
    p FilePath -> FilePath -> FilePath
    </> FilePath
    "lib" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ShortText -> FilePath
    ST.unpack ShortText
    l FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    profSuff FilePath -> FilePath -> FilePath
    <.> FilePath
    "a"
                            | UnitId
    u <- [UnitId]
    units
                            , ShortText
    p <- UnitState -> UnitId -> [ShortText]
    getInstalledPackageLibDirs UnitState
    ue_state UnitId
    u
                            , ShortText
    l <- UnitState -> UnitId -> [ShortText]
    getInstalledPackageHsLibs  UnitState
    ue_state UnitId
    u
                            ]
      where
        ue_state :: UnitState
    ue_state = HasDebugCallStack => UnitEnv -> UnitState
    UnitEnv -> UnitState
    ue_units UnitEnv
    unit_env

        -- XXX the profiling library name is probably wrong now
        profSuff :: FilePath
    profSuff | StgToJSConfig -> Bool
    csProf StgToJSConfig
    cfg = FilePath
    "_p"
                 | Bool
    otherwise  = FilePath
    ""

    -- | Combine rts.js, lib.js, out.js to all.js that can be run
    -- directly with node.js or SpiderMonkey jsshell
    combineFiles :: JSLinkConfig
                 -> Bool -- has clibs.js
                 -> FilePath
                 -> IO ()
    combineFiles :: JSLinkConfig -> Bool -> FilePath -> IO ()
    combineFiles JSLinkConfig
    cfg Bool
    has_clibs FilePath
    fp = do
      let files :: [FilePath]
    files = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath
    fp FilePath -> FilePath -> FilePath
    </>) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ [Maybe FilePath] -> [FilePath]
    forall a. [Maybe a] -> [a]
    catMaybes
            [ FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    "rts.js"
            , FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    "lib.js"
            , FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    "out.js"
            , if Bool
    has_clibs      then FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    "clibs.js" else Maybe FilePath
    forall a. Maybe a
    Nothing
            , if JSLinkConfig -> Bool
    lcNoHsMain JSLinkConfig
    cfg then Maybe FilePath
    forall a. Maybe a
    Nothing else FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    "runmain.js"
            ]
      FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile (FilePath
    fp FilePath -> FilePath -> FilePath
    </> FilePath
    "all.js") IOMode
    WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h ->
        [FilePath] -> (FilePath -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [FilePath]
    files ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \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

    -- | write the index.html file that loads the program if it does not exit
    writeHtml
      :: FilePath -- ^ output directory
      -> IO ()
    writeHtml :: FilePath -> IO ()
    writeHtml FilePath
    out = do
      let htmlFile :: FilePath
    htmlFile = FilePath
    out FilePath -> FilePath -> FilePath
    </> FilePath
    "index.html"
      e <- FilePath -> IO Bool
    doesFileExist FilePath
    htmlFile
      unless e $
        B.writeFile htmlFile templateHtml

    templateHtml :: B.ByteString
    templateHtml :: ByteString
    templateHtml =
      ByteString
    "<!DOCTYPE html>\n\
      \<html>\n\
      \  <head>\n\
      \  </head>\n\
      \  <body>\n\
      \  </body>\n\
      \  <script language=\"javascript\" src=\"all.js\" defer></script>\n\
      \</html>"

    -- | write the runmain.js file that will be run with defer so that it runs after
    -- index.html is loaded
    writeRunMain
      :: FilePath -- ^ output directory
      -> UseEmccRts
      -> IO ()
    writeRunMain :: FilePath -> UseEmccRts -> IO ()
    writeRunMain FilePath
    out UseEmccRts
    use_emcc_rts = do
      let runMainFile :: FilePath
    runMainFile = FilePath
    out FilePath -> FilePath -> FilePath
    </> FilePath
    "runmain.js"
      FilePath -> ByteString -> IO ()
    B.writeFile FilePath
    runMainFile (UseEmccRts -> ByteString
    runMainJS UseEmccRts
    use_emcc_rts)

    newtype UseEmccRts = UseEmccRts Bool

    runMainJS :: UseEmccRts -> B.ByteString
    runMainJS :: UseEmccRts -> ByteString
    runMainJS (UseEmccRts Bool
    use_emcc_rts) = if Bool
    use_emcc_rts
      then ByteString
    "Module['onRuntimeInitialized'] = function() {\n\
           \h$initEmscriptenHeap();\n\
           \h$main(h$mainZCZCMainzimain);\n\
           \}\n"
      else ByteString
    "h$main(h$mainZCZCMainzimain);\n"

    writeRunner :: JSLinkConfig -- ^ Settings
                -> FilePath     -- ^ Output directory
                -> IO ()
    writeRunner :: JSLinkConfig -> FilePath -> IO ()
    writeRunner JSLinkConfig
    _settings FilePath
    out = do
      cd    <- IO FilePath
    getCurrentDirectory
      let arch_os = ArchOS
    hostPlatformArchOS
      let runner  = FilePath
    cd FilePath -> FilePath -> FilePath
    </> ArchOS -> Bool -> Maybe FilePath -> FilePath
    exeFileName ArchOS
    arch_os Bool
    False (FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> FilePath
    dropExtension FilePath
    out))
          srcFile = FilePath
    out FilePath -> FilePath -> FilePath
    </> FilePath
    "all" FilePath -> FilePath -> FilePath
    <.> FilePath
    "js"
          nodePgm :: B.ByteString
          nodePgm = ByteString
    "node"
      src <- B.readFile (cd </> srcFile)
      B.writeFile runner ("#!/usr/bin/env " <> nodePgm <> "\n" <> src)
      perms <- getPermissions runner
      setPermissions runner (perms {executable = True})

    rtsExterns :: FastString
    rtsExterns :: FastString
    rtsExterns =
      FastString
    "// GHCJS RTS externs for closure compiler ADVANCED_OPTIMIZATIONS\n\n" FastString -> FastString -> FastString
    forall a. Semigroup a => a -> a -> a
    <>
      [FastString] -> FastString
    forall a. Monoid a => [a] -> a
    mconcat ((BlockId -> FastString) -> [BlockId] -> [FastString]
    forall a b. (a -> b) -> [a] -> [b]
    map (\BlockId
    x -> FastString
    "/** @type {*} */\nObject.d" FastString -> FastString -> FastString
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> FastString
    mkFastString (BlockId -> FilePath
    forall a. Show a => a -> FilePath
    show BlockId
    x) FastString -> FastString -> FastString
    forall a. Semigroup a => a -> a -> a
    <> FastString
    ";\n")
                   [(BlockId
    7::Int)..BlockId
    16384])

    writeExterns :: FilePath -> IO ()
    writeExterns :: FilePath -> IO ()
    writeExterns FilePath
    out = FilePath -> FilePath -> IO ()
    writeFile (FilePath
    out FilePath -> FilePath -> FilePath
    </> FilePath
    "all.js.externs")
      (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FastString -> FilePath
    unpackFS FastString
    rtsExterns

    -- | Get all block dependencies for a given set of roots
    --
    -- Returns the update block info map and the blocks.
    getDeps :: Map Module LocatedBlockInfo     -- ^ Block info per module
            -> (Module -> IO LocatedBlockInfo) -- ^ Used to load block info if missing
            -> Set ExportedFun                 -- ^ start here
            -> Set BlockRef                    -- ^ and also link these
            -> IO (Map Module LocatedBlockInfo, Set BlockRef)
    getDeps :: Map Module LocatedBlockInfo
    -> (Module -> IO LocatedBlockInfo)
    -> Set ExportedFun
    -> Set BlockRef
    -> IO (Map Module LocatedBlockInfo, Set BlockRef)
    getDeps Map Module LocatedBlockInfo
    init_infos Module -> IO LocatedBlockInfo
    load_info Set ExportedFun
    root_funs Set BlockRef
    root_blocks = Map Module LocatedBlockInfo
    -> Set BlockRef
    -> Set BlockRef
    -> [ExportedFun]
    -> IO (Map Module LocatedBlockInfo, Set BlockRef)
    traverse_funs Map Module LocatedBlockInfo
    init_infos Set BlockRef
    forall a. Set a
    S.empty Set BlockRef
    root_blocks (Set ExportedFun -> [ExportedFun]
    forall a. Set a -> [a]
    S.toList Set ExportedFun
    root_funs)
      where
        -- A block may depend on:
        --  1. other blocks from the same module
        --  2. exported functions from another module
        --
        -- Process:
        --  1. We use the BlockInfos to find the block corresponding to every
        --  exported root functions.
        --
        --  2. We had these blocks to the set of root_blocks if they aren't already
        --  added to the result.
        --
        --  3. Then we traverse the root_blocks to find their dependencies and we
        --  add them to root_blocks (if they aren't already added to the result) and
        --  to root_funs.
        --
        --  4. back to 1

        lookup_info :: Map Module LocatedBlockInfo
    -> Module -> IO (Map Module LocatedBlockInfo, BlockInfo)
    lookup_info Map Module LocatedBlockInfo
    infos Module
    mod = case Module -> Map Module LocatedBlockInfo -> Maybe LocatedBlockInfo
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Module
    mod Map Module LocatedBlockInfo
    infos of
          Just LocatedBlockInfo
    info -> (Map Module LocatedBlockInfo, BlockInfo)
    -> IO (Map Module LocatedBlockInfo, BlockInfo)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map Module LocatedBlockInfo
    infos, LocatedBlockInfo -> BlockInfo
    lbi_info LocatedBlockInfo
    info)
          Maybe LocatedBlockInfo
    Nothing   -> do
            -- load info and update cache with it
            info <- Module -> IO LocatedBlockInfo
    load_info Module
    mod
            pure (M.insert mod info infos, lbi_info info)

        traverse_blocks
          :: Map Module LocatedBlockInfo
          -> Set BlockRef
          -> Set BlockRef
          -> IO (Map Module LocatedBlockInfo, Set BlockRef)
        traverse_blocks :: Map Module LocatedBlockInfo
    -> Set BlockRef
    -> Set BlockRef
    -> IO (Map Module LocatedBlockInfo, Set BlockRef)
    traverse_blocks Map Module LocatedBlockInfo
    infos Set BlockRef
    result Set BlockRef
    open = case Set BlockRef -> Maybe (BlockRef, Set BlockRef)
    forall a. Set a -> Maybe (a, Set a)
    S.minView Set BlockRef
    open of
          Maybe (BlockRef, Set BlockRef)
    Nothing -> (Map Module LocatedBlockInfo, Set BlockRef)
    -> IO (Map Module LocatedBlockInfo, Set BlockRef)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Module LocatedBlockInfo
    infos, Set BlockRef
    result)
          Just (BlockRef
    ref, Set BlockRef
    open') -> do
              let mod :: Module
    mod = BlockRef -> Module
    block_ref_mod BlockRef
    ref
              !(infos',info) <- Map Module LocatedBlockInfo
    -> Module -> IO (Map Module LocatedBlockInfo, BlockInfo)
    lookup_info Map Module LocatedBlockInfo
    infos Module
    mod
              let block =  BlockInfo -> Array BlockId BlockDeps
    bi_block_deps BlockInfo
    info Array BlockId BlockDeps -> BlockId -> BlockDeps
    forall i e. Ix i => Array i e -> i -> e
    ! BlockRef -> BlockId
    block_ref_idx BlockRef
    ref
                  result' = BlockRef -> Set BlockRef -> Set BlockRef
    forall a. Ord a => a -> Set a -> Set a
    S.insert BlockRef
    ref Set BlockRef
    result
                  to_block_ref BlockId
    i = BlockRef
                                    { block_ref_mod :: Module
    block_ref_mod = Module
    mod
                                    , block_ref_idx :: BlockId
    block_ref_idx = BlockId
    i
                                    }
              traverse_funs infos' result'
                 (addOpen result' open' $
                   map to_block_ref (blockBlockDeps block)) (blockFunDeps block)

        traverse_funs
          :: Map Module LocatedBlockInfo
          -> Set BlockRef
          -> Set BlockRef
          -> [ExportedFun]
          -> IO (Map Module LocatedBlockInfo, Set BlockRef)
        traverse_funs :: Map Module LocatedBlockInfo
    -> Set BlockRef
    -> Set BlockRef
    -> [ExportedFun]
    -> IO (Map Module LocatedBlockInfo, Set BlockRef)
    traverse_funs Map Module LocatedBlockInfo
    infos Set BlockRef
    result Set BlockRef
    open = \case
          []     -> Map Module LocatedBlockInfo
    -> Set BlockRef
    -> Set BlockRef
    -> IO (Map Module LocatedBlockInfo, Set BlockRef)
    traverse_blocks Map Module LocatedBlockInfo
    infos Set BlockRef
    result Set BlockRef
    open
          (ExportedFun
    f:[ExportedFun]
    fs) -> do
            let mod :: Module
    mod = ExportedFun -> Module
    funModule ExportedFun
    f
            -- lookup module block info for the module that exports the function
            !(infos',info) <- Map Module LocatedBlockInfo
    -> Module -> IO (Map Module LocatedBlockInfo, BlockInfo)
    lookup_info Map Module LocatedBlockInfo
    infos Module
    mod
            -- lookup block index associated to the function in the block info
            case M.lookup f (bi_exports info) of
              Maybe BlockId
    Nothing  -> FilePath -> SDoc -> IO (Map Module LocatedBlockInfo, Set BlockRef)
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "exported function not found: " (SDoc -> IO (Map Module LocatedBlockInfo, Set BlockRef))
    -> SDoc -> IO (Map Module LocatedBlockInfo, Set BlockRef)
    forall a b. (a -> b) -> a -> b
    $ ExportedFun -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExportedFun
    f
              Just BlockId
    idx -> do
                let fun_block_ref :: BlockRef
    fun_block_ref = BlockRef
                       { block_ref_mod :: Module
    block_ref_mod = Module
    mod
                       , block_ref_idx :: BlockId
    block_ref_idx = BlockId
    idx
                       }
                -- always add the module "global block" when we link a module
                let global_block_ref :: BlockRef
    global_block_ref = BlockRef
                       { block_ref_mod :: Module
    block_ref_mod = Module
    mod
                       , block_ref_idx :: BlockId
    block_ref_idx = BlockId
    0
                       }
                Map Module LocatedBlockInfo
    -> Set BlockRef
    -> Set BlockRef
    -> [ExportedFun]
    -> IO (Map Module LocatedBlockInfo, Set BlockRef)
    traverse_funs Map Module LocatedBlockInfo
    infos' Set BlockRef
    result (Set BlockRef -> Set BlockRef -> [BlockRef] -> Set BlockRef
    addOpen Set BlockRef
    result Set BlockRef
    open [BlockRef
    fun_block_ref,BlockRef
    global_block_ref]) [ExportedFun]
    fs

        -- extend the open block set with new blocks that are not already in the
        -- result block set nor in the open block set.
        addOpen
          :: Set BlockRef
          -> Set BlockRef
          -> [BlockRef]
          -> Set BlockRef
        addOpen :: Set BlockRef -> Set BlockRef -> [BlockRef] -> Set BlockRef
    addOpen Set BlockRef
    result Set BlockRef
    open [BlockRef]
    new_blocks =
          let alreadyLinked :: BlockRef -> Bool
    alreadyLinked BlockRef
    s = BlockRef -> Set BlockRef -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member BlockRef
    s Set BlockRef
    result Bool -> Bool -> Bool
    || BlockRef -> Set BlockRef -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member BlockRef
    s Set BlockRef
    open
          in  Set BlockRef
    open Set BlockRef -> Set BlockRef -> Set BlockRef
    forall a. Ord a => Set a -> Set a -> Set a
    `S.union` [BlockRef] -> Set BlockRef
    forall a. Ord a => [a] -> Set a
    S.fromList ((BlockRef -> Bool) -> [BlockRef] -> [BlockRef]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (BlockRef -> Bool) -> BlockRef -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlockRef -> Bool
    alreadyLinked) [BlockRef]
    new_blocks)

    -- | collect dependencies for a set of roots
    collectModuleCodes :: ArchiveCache -> LinkPlan -> IO [ModuleCode]
    collectModuleCodes :: ArchiveCache -> LinkPlan -> IO [ModuleCode]
    collectModuleCodes ArchiveCache
    ar_cache LinkPlan
    link_plan = do

      let block_info :: Map Module LocatedBlockInfo
    block_info = LinkPlan -> Map Module LocatedBlockInfo
    lkp_block_info LinkPlan
    link_plan
      let blocks :: Set BlockRef
    blocks     = LinkPlan -> Set BlockRef
    lkp_dep_blocks LinkPlan
    link_plan

      -- we're going to load all the blocks. Instead of doing this randomly, we
      -- group them by module first.
      let module_blocks :: Map Module BlockIds
          module_blocks :: Map Module BlockIds
    module_blocks = (BlockIds -> BlockIds -> BlockIds)
    -> [(Module, BlockIds)] -> Map Module BlockIds
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    M.fromListWith BlockIds -> BlockIds -> BlockIds
    IS.union ([(Module, BlockIds)] -> Map Module BlockIds)
    -> [(Module, BlockIds)] -> Map Module BlockIds
    forall a b. (a -> b) -> a -> b
    $
                          (BlockRef -> (Module, BlockIds))
    -> [BlockRef] -> [(Module, BlockIds)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\BlockRef
    ref -> (BlockRef -> Module
    block_ref_mod BlockRef
    ref, BlockId -> BlockIds
    IS.singleton (BlockRef -> BlockId
    block_ref_idx BlockRef
    ref))) (Set BlockRef -> [BlockRef]
    forall a. Set a -> [a]
    S.toList Set BlockRef
    blocks)

      -- GHCJS had this comment: "read ghc-prim first, since we depend on that for
      -- static initialization". Not sure if it's still true as we haven't ported
      -- the compactor yet. Still we sort to read ghc-prim blocks first just in
      -- case.
      let pred :: (Module, b) -> Bool
    pred (Module, b)
    x = Module -> UnitId
    moduleUnitId ((Module, b) -> Module
    forall a b. (a, b) -> a
    fst (Module, b)
    x) UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == UnitId
    primUnitId
          cmp :: (Module, b) -> (Module, b) -> Ordering
    cmp (Module, b)
    x (Module, b)
    y = case ((Module, b) -> Bool
    forall {b}. (Module, b) -> Bool
    pred (Module, b)
    x, (Module, b) -> Bool
    forall {b}. (Module, b) -> Bool
    pred (Module, b)
    y) of
            (Bool
    True,Bool
    False)  -> Ordering
    LT
            (Bool
    False,Bool
    True)  -> Ordering
    GT
            (Bool
    True,Bool
    True)   -> Ordering
    EQ
            (Bool
    False,Bool
    False) -> Ordering
    EQ

          sorted_module_blocks :: [(Module,BlockIds)]
          sorted_module_blocks :: [(Module, BlockIds)]
    sorted_module_blocks = ((Module, BlockIds) -> (Module, BlockIds) -> Ordering)
    -> [(Module, BlockIds)] -> [(Module, BlockIds)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Module, BlockIds) -> (Module, BlockIds) -> Ordering
    forall {b} {b}. (Module, b) -> (Module, b) -> Ordering
    cmp (Map Module BlockIds -> [(Module, BlockIds)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Module BlockIds
    module_blocks)

      -- load blocks
      [(Module, BlockIds)]
    -> ((Module, BlockIds) -> IO ModuleCode) -> IO [ModuleCode]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Module, BlockIds)]
    sorted_module_blocks (((Module, BlockIds) -> IO ModuleCode) -> IO [ModuleCode])
    -> ((Module, BlockIds) -> IO ModuleCode) -> IO [ModuleCode]
    forall a b. (a -> b) -> a -> b
    $ \(Module
    mod,BlockIds
    bids) -> do
        case Module -> Map Module LocatedBlockInfo -> Maybe LocatedBlockInfo
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Module
    mod Map Module LocatedBlockInfo
    block_info of
          Maybe LocatedBlockInfo
    Nothing  -> FilePath -> SDoc -> IO ModuleCode
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "collectModuleCodes: couldn't find block info for module" (Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    mod)
          Just LocatedBlockInfo
    lbi -> ArchiveCache -> LocatedBlockInfo -> BlockIds -> IO ModuleCode
    extractBlocks ArchiveCache
    ar_cache LocatedBlockInfo
    lbi BlockIds
    bids

    extractBlocks :: ArchiveCache -> LocatedBlockInfo -> BlockIds -> IO ModuleCode
    extractBlocks :: ArchiveCache -> LocatedBlockInfo -> BlockIds -> IO ModuleCode
    extractBlocks ArchiveCache
    ar_state LocatedBlockInfo
    lbi BlockIds
    blocks = do
      case LocatedBlockInfo -> BlockLocation
    lbi_loc LocatedBlockInfo
    lbi of
        ObjectFile FilePath
    fp -> do
          us <- FilePath -> BlockIds -> IO [ObjBlock]
    readObjectBlocks FilePath
    fp BlockIds
    blocks
          pure (collectCode us)
        ArchiveFile FilePath
    a -> do
          obj <- ArchiveCache -> Module -> FilePath -> IO Object
    readArObject ArchiveCache
    ar_state Module
    mod FilePath
    a
          us <- getObjectBlocks obj blocks
          pure (collectCode us)
        InMemory FilePath
    _n Object
    obj -> do
          us <- Object -> BlockIds -> IO [ObjBlock]
    getObjectBlocks Object
    obj BlockIds
    blocks
          pure (collectCode us)
      where
        mod :: Module
    mod           = BlockInfo -> Module
    bi_module (LocatedBlockInfo -> BlockInfo
    lbi_info LocatedBlockInfo
    lbi)
        newline :: ByteString
    newline       = FilePath -> ByteString
    BC.pack FilePath
    "\n"
        mk_exports :: [ObjBlock] -> ByteString
    mk_exports    = [ByteString] -> ByteString
    forall a. Monoid a => [a] -> a
    mconcat ([ByteString] -> ByteString)
    -> ([ObjBlock] -> [ByteString]) -> [ObjBlock] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    intersperse ByteString
    newline ([ByteString] -> [ByteString])
    -> ([ObjBlock] -> [ByteString]) -> [ObjBlock] -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> Bool) -> [ByteString] -> [ByteString]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Bool
    BS.null) ([ByteString] -> [ByteString])
    -> ([ObjBlock] -> [ByteString]) -> [ObjBlock] -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ObjBlock -> ByteString) -> [ObjBlock] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map ObjBlock -> ByteString
    oiRaw
        mk_js_code :: [ObjBlock] -> JStat
    mk_js_code    = [JStat] -> JStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStat] -> JStat)
    -> ([ObjBlock] -> [JStat]) -> [ObjBlock] -> JStat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ObjBlock -> JStat) -> [ObjBlock] -> [JStat]
    forall a b. (a -> b) -> [a] -> [b]
    map ObjBlock -> JStat
    oiStat
        collectCode :: [ObjBlock] -> ModuleCode
    collectCode [ObjBlock]
    l = ModuleCode
                          { mc_module :: Module
    mc_module   = Module
    mod
                          , mc_js_code :: JStat
    mc_js_code  = [ObjBlock] -> JStat
    mk_js_code [ObjBlock]
    l
                          , mc_exports :: ByteString
    mc_exports  = [ObjBlock] -> ByteString
    mk_exports [ObjBlock]
    l
                          , mc_closures :: [ClosureInfo]
    mc_closures = (ObjBlock -> [ClosureInfo]) -> [ObjBlock] -> [ClosureInfo]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ObjBlock -> [ClosureInfo]
    oiClInfo [ObjBlock]
    l
                          , mc_statics :: [StaticInfo]
    mc_statics  = (ObjBlock -> [StaticInfo]) -> [ObjBlock] -> [StaticInfo]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ObjBlock -> [StaticInfo]
    oiStatic [ObjBlock]
    l
                          , mc_frefs :: [ForeignJSRef]
    mc_frefs    = (ObjBlock -> [ForeignJSRef]) -> [ObjBlock] -> [ForeignJSRef]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ObjBlock -> [ForeignJSRef]
    oiFImports [ObjBlock]
    l
                          }

    -- | Load an archive in memory and store it in the cache for future loads.
    loadArchive :: ArchiveCache -> FilePath -> IO Ar.Archive
    loadArchive :: ArchiveCache -> FilePath -> IO Archive
    loadArchive ArchiveCache
    ar_cache FilePath
    ar_file = do
      loaded_ars <- IORef (Map FilePath Archive) -> IO (Map FilePath Archive)
    forall a. IORef a -> IO a
    readIORef (ArchiveCache -> IORef (Map FilePath Archive)
    loadedArchives ArchiveCache
    ar_cache)
      case M.lookup ar_file loaded_ars of
        Just Archive
    a -> Archive -> IO Archive
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Archive
    a
        Maybe Archive
    Nothing -> do
          a <- FilePath -> IO Archive
    Ar.loadAr FilePath
    ar_file
          modifyIORef (loadedArchives ar_cache) (M.insert ar_file a)
          pure a

    readArObject :: ArchiveCache -> Module -> FilePath -> IO Object
    readArObject :: ArchiveCache -> Module -> FilePath -> IO Object
    readArObject ArchiveCache
    ar_cache Module
    mod FilePath
    ar_file = do
      Ar.Archive entries <- ArchiveCache -> FilePath -> IO Archive
    loadArchive ArchiveCache
    ar_cache FilePath
    ar_file

      -- look for the right object in archive
      let go_entries = \case
            -- XXX this shouldn't be an exception probably
            [] -> FilePath -> IO Object
    forall a. HasCallStack => FilePath -> a
    panic (FilePath -> IO Object) -> FilePath -> IO Object
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "could not find object for module "
                          FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ModuleName -> FilePath
    moduleNameString (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod)
                          FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " in "
                          FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ar_file

            (ArchiveEntry
    e:[ArchiveEntry]
    es) -> do
              let bs :: ByteString
    bs = ArchiveEntry -> ByteString
    Ar.filedata ArchiveEntry
    e
              bh <- ByteString -> IO BinHandle
    unsafeUnpackBinBuffer ByteString
    bs
              getObjectHeader bh >>= \case
                Left FilePath
    _         -> [ArchiveEntry] -> IO Object
    go_entries [ArchiveEntry]
    es -- not a valid object entry
                Right ModuleName
    mod_name
                  | ModuleName
    mod_name ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod
                  -> [ArchiveEntry] -> IO Object
    go_entries [ArchiveEntry]
    es -- not the module we're looking for
                  | Bool
    otherwise
                  -> BinHandle -> ModuleName -> IO Object
    getObjectBody BinHandle
    bh ModuleName
    mod_name -- found it

      go_entries entries

    -- | dependencies for the RTS, these need to be always linked
    rtsDeps :: ([UnitId], Set ExportedFun)
    rtsDeps :: ([UnitId], Set ExportedFun)
    rtsDeps =
      ( [UnitId
    ghcInternalUnitId, UnitId
    primUnitId]
      , [ExportedFun] -> Set ExportedFun
    forall a. Ord a => [a] -> Set a
    S.fromList ([ExportedFun] -> Set ExportedFun)
    -> [ExportedFun] -> Set ExportedFun
    forall a b. (a -> b) -> a -> b
    $ [[ExportedFun]] -> [ExportedFun]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
          [ FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns FastString
    "GHC.Internal.Conc.Sync"
              [FastString
    "reportError"]
          , FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns FastString
    "GHC.Internal.Control.Exception.Base"
              [FastString
    "nonTermination"]
          , FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns FastString
    "GHC.Internal.Exception.Type"
              [ FastString
    "SomeException"
              , FastString
    "underflowException"
              , FastString
    "overflowException"
              , FastString
    "divZeroException"
              ]
          , FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns FastString
    "GHC.Internal.TopHandler"
              [ FastString
    "runMainIO"
              , FastString
    "topHandler"
              ]
          , FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns FastString
    "GHC.Internal.Base"
              [FastString
    "$fMonadIO"]
          , FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns FastString
    "GHC.Internal.Maybe"
              [ FastString
    "Nothing"
              , FastString
    "Just"
              ]
          , FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns FastString
    "GHC.Internal.Ptr"
              [FastString
    "Ptr"]
          , FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns FastString
    "GHC.Internal.JS.Prim"
              [ FastString
    "JSVal"
              , FastString
    "JSException"
              , FastString
    "$fShowJSException"
              , FastString
    "$fExceptionJSException"
              , FastString
    "resolve"
              , FastString
    "resolveIO"
              , FastString
    "toIO"
              ]
          , FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns FastString
    "GHC.Internal.JS.Prim.Internal"
              [ FastString
    "wouldBlock"
              , FastString
    "blockedIndefinitelyOnMVar"
              , FastString
    "blockedIndefinitelyOnSTM"
              , FastString
    "ignoreException"
              , FastString
    "setCurrentThreadResultException"
              , FastString
    "setCurrentThreadResultValue"
              ]
          , FastString -> [FastString] -> [ExportedFun]
    mkPrimFuns FastString
    "GHC.Types"
              [ FastString
    ":"
              , FastString
    "[]"
              ]
          , FastString -> [FastString] -> [ExportedFun]
    mkPrimFuns FastString
    "GHC.Tuple"
              [ FastString
    "(,)"
              , FastString
    "(,,)"
              , FastString
    "(,,,)"
              , FastString
    "(,,,,)"
              , FastString
    "(,,,,,)"
              , FastString
    "(,,,,,,)"
              , FastString
    "(,,,,,,,)"
              , FastString
    "(,,,,,,,,)"
              , FastString
    "(,,,,,,,,,)"
              ]
          ]
      )

    -- | Export the functions in @ghc-internal@
    mkInternalFuns :: FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns :: FastString -> [FastString] -> [ExportedFun]
    mkInternalFuns = UnitId -> FastString -> [FastString] -> [ExportedFun]
    mkExportedFuns UnitId
    ghcInternalUnitId

    -- | Export the Prim functions
    mkPrimFuns :: FastString -> [FastString] -> [ExportedFun]
    mkPrimFuns :: FastString -> [FastString] -> [ExportedFun]
    mkPrimFuns = UnitId -> FastString -> [FastString] -> [ExportedFun]
    mkExportedFuns UnitId
    primUnitId

    -- | Given a @UnitId@, a module name, and a set of symbols in the module,
    -- package these into an @ExportedFun@.
    mkExportedFuns :: UnitId -> FastString -> [FastString] -> [ExportedFun]
    mkExportedFuns :: UnitId -> FastString -> [FastString] -> [ExportedFun]
    mkExportedFuns UnitId
    uid FastString
    mod_name [FastString]
    symbols = Module -> [FastString] -> [ExportedFun]
    mkExportedModFuns Module
    mod [FastString]
    names
      where
        mod :: Module
    mod        = GenUnit UnitId -> ModuleName -> Module
    forall u. u -> ModuleName -> GenModule u
    mkModule (Definite UnitId -> GenUnit UnitId
    forall uid. Definite uid -> GenUnit uid
    RealUnit (UnitId -> Definite UnitId
    forall unit. unit -> Definite unit
    Definite UnitId
    uid)) (FastString -> ModuleName
    mkModuleNameFS FastString
    mod_name)
        names :: [FastString]
    names      = (FastString -> FastString) -> [FastString] -> [FastString]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> Module -> FastString -> FastString
    mkJsSymbol Bool
    True Module
    mod) [FastString]
    symbols

    -- | Given a @Module@ and a set of symbols in the module, package these into an
    -- @ExportedFun@.
    mkExportedModFuns :: Module -> [FastString] -> [ExportedFun]
    mkExportedModFuns :: Module -> [FastString] -> [ExportedFun]
    mkExportedModFuns Module
    mod [FastString]
    symbols = (FastString -> ExportedFun) -> [FastString] -> [ExportedFun]
    forall a b. (a -> b) -> [a] -> [b]
    map FastString -> ExportedFun
    mk_fun [FastString]
    symbols
      where
        mk_fun :: FastString -> ExportedFun
    mk_fun FastString
    sym = Module -> LexicalFastString -> ExportedFun
    ExportedFun Module
    mod (FastString -> LexicalFastString
    LexicalFastString FastString
    sym)

    -- | read all dependency data from the to-be-linked files
    loadObjBlockInfo
      :: [FilePath] -- ^ object files to link
      -> IO (Map Module LocatedBlockInfo, [BlockRef])
    loadObjBlockInfo :: [FilePath] -> IO (Map Module LocatedBlockInfo, [BlockRef])
    loadObjBlockInfo [FilePath]
    objs = ([LocatedBlockInfo] -> (Map Module LocatedBlockInfo, [BlockRef])
    prepareLoadedDeps ([LocatedBlockInfo] -> (Map Module LocatedBlockInfo, [BlockRef]))
    -> ([Maybe LocatedBlockInfo] -> [LocatedBlockInfo])
    -> [Maybe LocatedBlockInfo]
    -> (Map Module LocatedBlockInfo, [BlockRef])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe LocatedBlockInfo] -> [LocatedBlockInfo]
    forall a. [Maybe a] -> [a]
    catMaybes) ([Maybe LocatedBlockInfo]
     -> (Map Module LocatedBlockInfo, [BlockRef]))
    -> IO [Maybe LocatedBlockInfo]
    -> IO (Map Module LocatedBlockInfo, [BlockRef])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FilePath -> IO (Maybe LocatedBlockInfo))
    -> [FilePath] -> IO [Maybe LocatedBlockInfo]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM FilePath -> IO (Maybe LocatedBlockInfo)
    readBlockInfoFromObj [FilePath]
    objs

    -- | Load dependencies for the Linker from Ar
    loadArchiveBlockInfo :: ArchiveCache -> [FilePath] -> IO (Map Module LocatedBlockInfo, [BlockRef])
    loadArchiveBlockInfo :: ArchiveCache
    -> [FilePath] -> IO (Map Module LocatedBlockInfo, [BlockRef])
    loadArchiveBlockInfo ArchiveCache
    ar_cache [FilePath]
    archives = do
      archDeps <- [FilePath]
    -> (FilePath -> IO [LocatedBlockInfo]) -> IO [[LocatedBlockInfo]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [FilePath]
    archives ((FilePath -> IO [LocatedBlockInfo]) -> IO [[LocatedBlockInfo]])
    -> (FilePath -> IO [LocatedBlockInfo]) -> IO [[LocatedBlockInfo]]
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    file -> do
        (Ar.Archive entries) <- ArchiveCache -> FilePath -> IO Archive
    loadArchive ArchiveCache
    ar_cache FilePath
    file
        catMaybes <$> mapM (readEntry file) entries
      return (prepareLoadedDeps $ concat archDeps)
        where
          readEntry :: FilePath -> Ar.ArchiveEntry -> IO (Maybe LocatedBlockInfo)
          readEntry :: FilePath -> ArchiveEntry -> IO (Maybe LocatedBlockInfo)
    readEntry FilePath
    ar_file ArchiveEntry
    ar_entry = do
              let bs :: ByteString
    bs = ArchiveEntry -> ByteString
    Ar.filedata ArchiveEntry
    ar_entry
              bh <- ByteString -> IO BinHandle
    unsafeUnpackBinBuffer ByteString
    bs
              getObjectHeader bh >>= \case
                Left FilePath
    _         -> Maybe LocatedBlockInfo -> IO (Maybe LocatedBlockInfo)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe LocatedBlockInfo
    forall a. Maybe a
    Nothing -- not a valid object entry
                Right ModuleName
    mod_name -> do
                  obj <- BinHandle -> ModuleName -> IO Object
    getObjectBody BinHandle
    bh ModuleName
    mod_name
                  let !info = Object -> BlockInfo
    objBlockInfo Object
    obj
                  pure $ Just (LocatedBlockInfo (ArchiveFile ar_file) info)

    prepareLoadedDeps :: [LocatedBlockInfo]
                      -> (Map Module LocatedBlockInfo, [BlockRef])
    prepareLoadedDeps :: [LocatedBlockInfo] -> (Map Module LocatedBlockInfo, [BlockRef])
    prepareLoadedDeps [LocatedBlockInfo]
    lbis = (Map Module LocatedBlockInfo
    module_blocks, [BlockRef]
    must_link)
      where
        must_link :: [BlockRef]
    must_link     = (LocatedBlockInfo -> [BlockRef])
    -> [LocatedBlockInfo] -> [BlockRef]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (BlockInfo -> [BlockRef]
    requiredBlocks (BlockInfo -> [BlockRef])
    -> (LocatedBlockInfo -> BlockInfo)
    -> LocatedBlockInfo
    -> [BlockRef]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LocatedBlockInfo -> BlockInfo
    lbi_info) [LocatedBlockInfo]
    lbis
        module_blocks :: Map Module LocatedBlockInfo
    module_blocks = [(Module, LocatedBlockInfo)] -> Map Module LocatedBlockInfo
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Module, LocatedBlockInfo)] -> Map Module LocatedBlockInfo)
    -> [(Module, LocatedBlockInfo)] -> Map Module LocatedBlockInfo
    forall a b. (a -> b) -> a -> b
    $ (LocatedBlockInfo -> (Module, LocatedBlockInfo))
    -> [LocatedBlockInfo] -> [(Module, LocatedBlockInfo)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\LocatedBlockInfo
    d -> (BlockInfo -> Module
    bi_module (LocatedBlockInfo -> BlockInfo
    lbi_info LocatedBlockInfo
    d), LocatedBlockInfo
    d)) [LocatedBlockInfo]
    lbis

    requiredBlocks :: BlockInfo -> [BlockRef]
    requiredBlocks :: BlockInfo -> [BlockRef]
    requiredBlocks BlockInfo
    d = (BlockId -> BlockRef) -> [BlockId] -> [BlockRef]
    forall a b. (a -> b) -> [a] -> [b]
    map BlockId -> BlockRef
    mk_block_ref (BlockIds -> [BlockId]
    IS.toList (BlockIds -> [BlockId]) -> BlockIds -> [BlockId]
    forall a b. (a -> b) -> a -> b
    $ BlockInfo -> BlockIds
    bi_must_link BlockInfo
    d)
      where
        mk_block_ref :: BlockId -> BlockRef
    mk_block_ref BlockId
    i = BlockRef
                          { block_ref_mod :: Module
    block_ref_mod = BlockInfo -> Module
    bi_module BlockInfo
    d
                          , block_ref_idx :: BlockId
    block_ref_idx = BlockId
    i
                          }

    -- | read block info from an object that might have already been into memory
    -- pulls in all Deps from an archive
    readBlockInfoFromObj :: FilePath -> IO (Maybe LocatedBlockInfo)
    readBlockInfoFromObj :: FilePath -> IO (Maybe LocatedBlockInfo)
    readBlockInfoFromObj FilePath
    file = do
      FilePath -> IO (Maybe BlockInfo)
    readObjectBlockInfo FilePath
    file IO (Maybe BlockInfo)
    -> (Maybe BlockInfo -> IO (Maybe LocatedBlockInfo))
    -> IO (Maybe LocatedBlockInfo)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Maybe BlockInfo
    Nothing   -> Maybe LocatedBlockInfo -> IO (Maybe LocatedBlockInfo)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe LocatedBlockInfo
    forall a. Maybe a
    Nothing
        Just BlockInfo
    info -> Maybe LocatedBlockInfo -> IO (Maybe LocatedBlockInfo)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe LocatedBlockInfo -> IO (Maybe LocatedBlockInfo))
    -> Maybe LocatedBlockInfo -> IO (Maybe LocatedBlockInfo)
    forall a b. (a -> b) -> a -> b
    $ LocatedBlockInfo -> Maybe LocatedBlockInfo
    forall a. a -> Maybe a
    Just (BlockLocation -> BlockInfo -> LocatedBlockInfo
    LocatedBlockInfo (FilePath -> BlockLocation
    ObjectFile FilePath
    file) BlockInfo
    info)

    -- | Embed a JS file into a JS object .o file
    --
    -- JS files may contain option pragmas of the form: //#OPTIONS:
    -- One of those is //#OPTIONS:CPP. When it is set, we append some common CPP
    -- definitions to the file and call cpp on it.
    --
    -- Other options (e.g. EMCC additional flags for link time) are stored in the
    -- JS object header. See JSOptions.
    embedJsFile :: Logger -> DynFlags -> TmpFs -> UnitEnv -> FilePath -> FilePath -> IO ()
    embedJsFile :: Logger
    -> DynFlags -> TmpFs -> UnitEnv -> FilePath -> FilePath -> IO ()
    embedJsFile Logger
    logger DynFlags
    dflags TmpFs
    tmpfs UnitEnv
    unit_env FilePath
    input_fn FilePath
    output_fn = do
      let profiling :: Bool
    profiling  = Bool
    False -- FIXME: add support for profiling way

      Bool -> FilePath -> IO ()
    createDirectoryIfMissing Bool
    True (FilePath -> FilePath
    takeDirectory FilePath
    output_fn)

      -- the header lets the linker recognize processed JavaScript files
      -- But don't add JavaScript header to object files!

      -- read pragmas from JS file
      -- we need to store them explicitly as they can be removed by CPP.
      opts <- FilePath -> IO JSOptions
    getOptionsFromJsFile FilePath
    input_fn

      -- run CPP if needed
      cpp_fn <- case enableCPP opts of
        Bool
    False -> FilePath -> IO FilePath
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FilePath
    input_fn
        Bool
    True  -> do
          -- append common CPP definitions to the .js file.
          -- They define macros that avoid directly wiring zencoded names
          -- in RTS JS files
          pp_fn <- Logger
    -> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
    newTempName Logger
    logger TmpFs
    tmpfs (DynFlags -> TempDir
    tmpDir DynFlags
    dflags) TempFileLifetime
    TFL_CurrentModule FilePath
    "js"
          payload <- B.readFile input_fn
          B.writeFile pp_fn (commonCppDefs profiling <> payload)

          -- run CPP on the input JS file
          js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js"
          let
            cpp_opts = CppOpts
              { useHsCpp :: Bool
    useHsCpp       = Bool
    False
              , cppLinePragmas :: Bool
    cppLinePragmas = Bool
    False -- LINE pragmas aren't JS compatible
              }
          doCpp logger
                  tmpfs
                  dflags
                  unit_env
                  cpp_opts
                  pp_fn
                  js_fn
          pure js_fn

      -- write JS object
      cpp_bs <- B.readFile cpp_fn
      writeJSObject opts cpp_bs output_fn

    -- | Link module codes.
    --
    -- Performs link time optimizations and produces one JStat per module plus some
    -- commoned up initialization code.
    linkModules :: [ModuleCode] -> ([CompactedModuleCode], JS.JStat)
    linkModules :: [ModuleCode] -> ([CompactedModuleCode], JStat)
    linkModules [ModuleCode]
    mods = ([CompactedModuleCode]
    compact_mods, JStat
    meta)
      where
        compact_mods :: [CompactedModuleCode]
    compact_mods = (ModuleCode -> CompactedModuleCode)
    -> [ModuleCode] -> [CompactedModuleCode]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleCode -> CompactedModuleCode
    compact [ModuleCode]
    mods

        -- here GHCJS used to:
        --  - deduplicate declarations
        --  - rename local variables into shorter ones
        --  - compress initialization data
        -- but we haven't ported it (yet).
        compact :: ModuleCode -> CompactedModuleCode
    compact ModuleCode
    m = CompactedModuleCode
          { cmc_js_code :: JStat
    cmc_js_code = ModuleCode -> JStat
    mc_js_code ModuleCode
    m
          , cmc_module :: Module
    cmc_module  = ModuleCode -> Module
    mc_module ModuleCode
    m
          , cmc_exports :: ByteString
    cmc_exports = ModuleCode -> ByteString
    mc_exports ModuleCode
    m
          }

        -- common up statics: different bindings may reference the same statics, we
        -- filter them here to initialize them once
        statics :: [StaticInfo]
    statics = [StaticInfo] -> [StaticInfo]
    nubStaticInfo ((ModuleCode -> [StaticInfo]) -> [ModuleCode] -> [StaticInfo]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ModuleCode -> [StaticInfo]
    mc_statics [ModuleCode]
    mods)

        infos :: [ClosureInfo]
    infos   = (ModuleCode -> [ClosureInfo]) -> [ModuleCode] -> [ClosureInfo]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ModuleCode -> [ClosureInfo]
    mc_closures [ModuleCode]
    mods
        debug :: Bool
    debug   = Bool
    False -- TODO: this could be enabled in a debug build.
                        -- It adds debug info to heap objects
        meta :: JStat
    meta = [JStat] -> JStat
    forall a. Monoid a => [a] -> a
    mconcat
                -- render metadata as individual statements
                [ [JStat] -> JStat
    forall a. Monoid a => [a] -> a
    mconcat ((StaticInfo -> JStat) -> [StaticInfo] -> [JStat]
    forall a b. (a -> b) -> [a] -> [b]
    map StaticInfo -> JStat
    staticDeclStat [StaticInfo]
    statics)
                , [JStat] -> JStat
    forall a. Monoid a => [a] -> a
    mconcat ((StaticInfo -> JStat) -> [StaticInfo] -> [JStat]
    forall a b. (a -> b) -> [a] -> [b]
    map StaticInfo -> JStat
    staticInitStat [StaticInfo]
    statics)
                , JStgStat -> JStat
    jStgStatToJS (JStgStat -> JStat) -> JStgStat -> JStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ((ClosureInfo -> JStgStat) -> [ClosureInfo] -> [JStgStat]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> ClosureInfo -> JStgStat
    closureInfoStat Bool
    debug) [ClosureInfo]
    infos)
                ]

    -- | Only keep a single StaticInfo with a given name
    nubStaticInfo :: [StaticInfo] -> [StaticInfo]
    nubStaticInfo :: [StaticInfo] -> [StaticInfo]
    nubStaticInfo = UniqSet FastString -> [StaticInfo] -> [StaticInfo]
    go UniqSet FastString
    forall a. UniqSet a
    emptyUniqSet
      where
        go :: UniqSet FastString -> [StaticInfo] -> [StaticInfo]
    go UniqSet FastString
    us = \case
          []     -> []
          (StaticInfo
    x:[StaticInfo]
    xs) ->
            -- only match on siVar. There is no reason for the initializing value to
            -- be different for the same global name.
            let name :: FastString
    name = StaticInfo -> FastString
    siVar StaticInfo
    x
            in if FastString -> UniqSet FastString -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet FastString
    name UniqSet FastString
    us
              then UniqSet FastString -> [StaticInfo] -> [StaticInfo]
    go UniqSet FastString
    us [StaticInfo]
    xs
              else StaticInfo
    x StaticInfo -> [StaticInfo] -> [StaticInfo]
    forall a. a -> [a] -> [a]
    : UniqSet FastString -> [StaticInfo] -> [StaticInfo]
    go (UniqSet FastString -> FastString -> UniqSet FastString
    forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    addOneToUniqSet UniqSet FastString
    us FastString
    name) [StaticInfo]
    xs

    -- | Initialize a global object.
    --
    -- All global objects have to be declared (staticInfoDecl) first.
    staticInitStat :: StaticInfo -> JS.JStat
    staticInitStat :: StaticInfo -> JStat
    staticInitStat (StaticInfo FastString
    i StaticVal
    sv Maybe Ident
    mcc) =
      JStgStat -> JStat
    jStgStatToJS (JStgStat -> JStat) -> JStgStat -> JStat
    forall a b. (a -> b) -> a -> b
    $
      case StaticVal
    sv of
        StaticData FastString
    con [StaticArg]
    args         -> FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$sti" ([JStgExpr] -> JStgStat) -> [JStgExpr] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgExpr] -> [JStgExpr]
    add_cc_arg
                                        [ FastString -> JStgExpr
    var FastString
    i
                                        , FastString -> JStgExpr
    var FastString
    con
                                        , [StaticArg] -> JStgExpr
    jsStaticArgs [StaticArg]
    args
                                        ]
        StaticFun  FastString
    f   [StaticArg]
    args         -> FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$sti" ([JStgExpr] -> JStgStat) -> [JStgExpr] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgExpr] -> [JStgExpr]
    add_cc_arg
                                        [ FastString -> JStgExpr
    var FastString
    i
                                        , FastString -> JStgExpr
    var FastString
    f
                                        , [StaticArg] -> JStgExpr
    jsStaticArgs [StaticArg]
    args
                                        ]
        StaticList [StaticArg]
    args Maybe FastString
    mt          -> FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$stl" ([JStgExpr] -> JStgStat) -> [JStgExpr] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgExpr] -> [JStgExpr]
    add_cc_arg
                                        [ FastString -> JStgExpr
    var FastString
    i
                                        , [StaticArg] -> JStgExpr
    jsStaticArgs [StaticArg]
    args
                                        , JStgExpr -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (JStgExpr -> JStgExpr) -> JStgExpr -> JStgExpr
    forall a b. (a -> b) -> a -> b
    $ JStgExpr
    -> (FastString -> JStgExpr) -> Maybe FastString -> JStgExpr
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe JStgExpr
    null_ (Ident -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (Ident -> JStgExpr)
    -> (FastString -> Ident) -> FastString -> JStgExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FastString -> Ident
    TxtI) Maybe FastString
    mt
                                        ]
        StaticThunk (Just (FastString
    f,[StaticArg]
    args)) -> FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$stc" ([JStgExpr] -> JStgStat) -> [JStgExpr] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgExpr] -> [JStgExpr]
    add_cc_arg
                                        [ FastString -> JStgExpr
    var FastString
    i
                                        , FastString -> JStgExpr
    var FastString
    f
                                        , [StaticArg] -> JStgExpr
    jsStaticArgs [StaticArg]
    args
                                        ]
        StaticVal
    _                           -> JStgStat
    forall a. Monoid a => a
    mempty
      where
        -- add optional cost-center argument
        add_cc_arg :: [JStgExpr] -> [JStgExpr]
    add_cc_arg [JStgExpr]
    as = case Maybe Ident
    mcc of
          Maybe Ident
    Nothing -> [JStgExpr]
    as
          Just Ident
    cc -> [JStgExpr]
    as [JStgExpr] -> [JStgExpr] -> [JStgExpr]
    forall a. [a] -> [a] -> [a]
    ++ [Ident -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr Ident
    cc]

    -- | declare and do first-pass init of a global object (create JS object for heap objects)
    staticDeclStat :: StaticInfo -> JS.JStat
    staticDeclStat :: StaticInfo -> JStat
    staticDeclStat (StaticInfo FastString
    global_name StaticVal
    static_value Maybe Ident
    _) = JStgStat -> JStat
    jStgStatToJS JStgStat
    decl
      where
        global_ident :: Ident
    global_ident = FastString -> Ident
    global FastString
    global_name
        decl_init :: JStgExpr -> JStgStat
    decl_init JStgExpr
    v  = Ident
    global_ident Ident -> JStgExpr -> JStgStat
    ||= JStgExpr
    v
        decl_no_init :: JStgStat
    decl_no_init = FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$di" [Ident -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr Ident
    global_ident]

        decl :: JStgStat
    decl = case StaticVal
    static_value of
          StaticUnboxed StaticUnboxed
    u     -> JStgExpr -> JStgStat
    decl_init (StaticUnboxed -> JStgExpr
    unboxed_expr StaticUnboxed
    u)
          StaticThunk Maybe (FastString, [StaticArg])
    Nothing -> JStgStat
    decl_no_init -- CAF initialized in an alternative way
          StaticVal
    _                   -> JStgExpr -> JStgStat
    decl_init (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$d" [])

        unboxed_expr :: StaticUnboxed -> JStgExpr
    unboxed_expr = \case
          StaticUnboxedBool Bool
    b          -> FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$p" [Bool -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr Bool
    b]
          StaticUnboxedInt Integer
    i           -> FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$p" [Integer -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr Integer
    i]
          StaticUnboxedDouble SaneDouble
    d        -> FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$p" [Double -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (SaneDouble -> Double
    unSaneDouble SaneDouble
    d)]
          StaticUnboxedString ByteString
    str      -> FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$rawStringData" [JVal -> JStgExpr
    ValExpr (ByteString -> JVal
    to_byte_list ByteString
    str)]
          StaticUnboxedStringOffset {} -> JStgExpr
    0

        to_byte_list :: ByteString -> JVal
    to_byte_list = [JStgExpr] -> JVal
    JList ([JStgExpr] -> JVal)
    -> (ByteString -> [JStgExpr]) -> ByteString -> JVal
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word8 -> JStgExpr) -> [Word8] -> [JStgExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (Integer -> JStgExpr
    Int (Integer -> JStgExpr) -> (Word8 -> Integer) -> Word8 -> JStgExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) ([Word8] -> [JStgExpr])
    -> (ByteString -> [Word8]) -> ByteString -> [JStgExpr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [Word8]
    BS.unpack