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

    -- | JavaScript code generator
    module GHC.StgToJS.CodeGen
      ( stgToJS
      )
    where

    import GHC.Prelude

    import GHC.Driver.Flags (DumpFlag (Opt_D_dump_js, Opt_D_dump_stg_from_js_sinker))

    import GHC.JS.Ppr
    import GHC.JS.JStg.Syntax
    import GHC.JS.Ident
    import GHC.JS.Make
    import GHC.JS.Transform
    import GHC.JS.Optimizer

    import GHC.StgToJS.Arg
    import GHC.StgToJS.Sinker.Sinker
    import GHC.StgToJS.Types
    import qualified GHC.StgToJS.Object as Object
    import GHC.StgToJS.Utils
    import GHC.StgToJS.Deps
    import GHC.StgToJS.Expr
    import GHC.StgToJS.ExprCtx
    import GHC.StgToJS.Monad
    import GHC.StgToJS.Profiling
    import GHC.StgToJS.Regs
    import GHC.StgToJS.StaticPtr
    import GHC.StgToJS.Symbols
    import GHC.StgToJS.Stack
    import GHC.StgToJS.Ids

    import GHC.Stg.Syntax
    import GHC.Core.DataCon
    import GHC.Core.TyCo.Rep (scaledThing)

    import GHC.Unit.Module
    import GHC.Linker.Types (SptEntry (..))

    import GHC.Types.CostCentre
    import GHC.Types.ForeignStubs (ForeignStubs (..), getCHeader, getCStub)
    import GHC.Types.RepType
    import GHC.Types.Id
    import GHC.Types.Unique
    import GHC.Types.Unique.FM (nonDetEltsUFM)

    import GHC.Data.FastString
    import GHC.Utils.Encoding
    import GHC.Utils.Logger
    import GHC.Utils.Panic
    import GHC.Utils.Misc
    import GHC.Utils.Binary
    import qualified Control.Monad.Trans.State.Strict as State
    import GHC.Utils.Outputable hiding ((<>))

    import qualified Data.Set as S
    import Data.Monoid
    import Data.List (sortBy)
    import Control.Monad
    import System.Directory
    import System.FilePath

    -- | Code generator for JavaScript
    stgToJS
      :: Logger
      -> StgToJSConfig
      -> [CgStgTopBinding]
      -> Module
      -> [SptEntry]
      -> ForeignStubs
      -> CollectedCCs
      -> FilePath -- ^ Output file name
      -> IO ()
    stgToJS :: Logger
    -> StgToJSConfig
    -> [CgStgTopBinding]
    -> Module
    -> [SptEntry]
    -> ForeignStubs
    -> CollectedCCs
    -> FilePath
    -> IO ()
    stgToJS Logger
    logger StgToJSConfig
    config [CgStgTopBinding]
    stg_binds0 Module
    this_mod [SptEntry]
    spt_entries ForeignStubs
    foreign_stubs CollectedCCs
    cccs FilePath
    output_fn = do

      let (UniqFM Id CgStgExpr
    unfloated_binds, [CgStgTopBinding]
    stg_binds) = Module
    -> [CgStgTopBinding] -> (UniqFM Id CgStgExpr, [CgStgTopBinding])
    sinkPgm Module
    this_mod [CgStgTopBinding]
    stg_binds0
        -- TODO: avoid top level lifting in core-2-core when the JS backend is
        -- enabled instead of undoing it here

      Logger -> DumpFlag -> FilePath -> DumpFormat -> SDoc -> IO ()
    putDumpFileMaybe Logger
    logger DumpFlag
    Opt_D_dump_stg_from_js_sinker FilePath
    "STG Optimized JS Sinker:" DumpFormat
    FormatSTG
        (StgPprOpts -> [CgStgTopBinding] -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    StgPprOpts -> [GenStgTopBinding pass] -> SDoc
    pprGenStgTopBindings (Bool -> StgPprOpts
    StgPprOpts Bool
    False) [CgStgTopBinding]
    stg_binds)

      (deps,lus) <- StgToJSConfig
    -> Module
    -> UniqFM Id CgStgExpr
    -> G (BlockInfo, [LinkableUnit])
    -> IO (BlockInfo, [LinkableUnit])
    forall a.
    StgToJSConfig -> Module -> UniqFM Id CgStgExpr -> G a -> IO a
    runG StgToJSConfig
    config Module
    this_mod UniqFM Id CgStgExpr
    unfloated_binds (G (BlockInfo, [LinkableUnit]) -> IO (BlockInfo, [LinkableUnit]))
    -> G (BlockInfo, [LinkableUnit]) -> IO (BlockInfo, [LinkableUnit])
    forall a b. (a -> b) -> a -> b
    $ do
        G () -> G ()
    forall m. Monoid m => G m -> G m
    ifProfilingM (G () -> G ()) -> G () -> G ()
    forall a b. (a -> b) -> a -> b
    $ CollectedCCs -> G ()
    initCostCentres CollectedCCs
    cccs
        lus  <- HasDebugCallStack =>
    Module
    -> [CgStgTopBinding]
    -> [SptEntry]
    -> ForeignStubs
    -> G [LinkableUnit]
    Module
    -> [CgStgTopBinding]
    -> [SptEntry]
    -> ForeignStubs
    -> G [LinkableUnit]
    genUnits Module
    this_mod [CgStgTopBinding]
    stg_binds [SptEntry]
    spt_entries ForeignStubs
    foreign_stubs
        deps <- genDependencyData this_mod lus
        pure (deps,lus)

      -- Doc to dump when -ddump-js is enabled
      when (logHasDumpFlag logger Opt_D_dump_js) $ do
        putDumpFileMaybe logger Opt_D_dump_js "JavaScript code" FormatJS
          $ vcat (fmap (jsToDoc . oiStat . luObjBlock) lus)

      -- Write the object file
      bh <- openBinMem (4 * 1000) -- a bit less than 4kB
      Object.putObject bh (moduleName this_mod) deps (map luObjBlock lus)

      createDirectoryIfMissing True (takeDirectory output_fn)
      writeBinMem bh output_fn

    -- | Generate the ingredients for the linkable units for this module
    genUnits :: HasDebugCallStack
             => Module
             -> [CgStgTopBinding]
             -> [SptEntry]
             -> ForeignStubs
             -> G [LinkableUnit] -- ^ the linkable units
    genUnits :: HasDebugCallStack =>
    Module
    -> [CgStgTopBinding]
    -> [SptEntry]
    -> ForeignStubs
    -> G [LinkableUnit]
    genUnits Module
    m [CgStgTopBinding]
    ss [SptEntry]
    spt_entries ForeignStubs
    foreign_stubs = do
        gbl     <- G LinkableUnit
    HasDebugCallStack => G LinkableUnit
    generateGlobalBlock
        exports <- generateExportsBlock
        others  <- go 2 ss
        pure (gbl:exports:others)
        where
          go :: HasDebugCallStack
             => Int                 -- the block we're generating (block 0 is the global unit for the module)
             -> [CgStgTopBinding]
             -> G [LinkableUnit]
          go :: HasDebugCallStack => Int -> [CgStgTopBinding] -> G [LinkableUnit]
    go !Int
    n = \case
            []     -> [LinkableUnit] -> G [LinkableUnit]
    forall a. a -> StateT GenState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
            (CgStgTopBinding
    x:[CgStgTopBinding]
    xs) -> do
              mlu <- HasDebugCallStack =>
    CgStgTopBinding -> Int -> G (Maybe LinkableUnit)
    CgStgTopBinding -> Int -> G (Maybe LinkableUnit)
    generateBlock CgStgTopBinding
    x Int
    n
              lus <- go (n+1) xs
              return (maybe lus (:lus) mlu)

          --   Generate the global unit that all other blocks in the module depend on
          --   used for cost centres and static initializers
          --   the global unit has no dependencies, exports the moduleGlobalSymbol
          generateGlobalBlock :: HasDebugCallStack => G LinkableUnit
          generateGlobalBlock :: HasDebugCallStack => G LinkableUnit
    generateGlobalBlock = do
            glbl <- (GenState -> [JStgStat]) -> StateT GenState IO [JStgStat]
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    State.gets GenState -> [JStgStat]
    gsGlobal
            staticInit <-
              initStaticPtrs spt_entries
            let stat = ( JStgStat -> JStat
    jStgStatToJS
                       (JStgStat -> JStat) -> JStgStat -> JStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> [JStgStat]
    forall a. [a] -> [a]
    reverse [JStgStat]
    glbl) JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgStat
    staticInit)
            let opt_stat = JStat -> JStat
    jsOptimize JStat
    stat
            let syms = [Module -> FastString
    moduleGlobalSymbol Module
    m]
            let oi = ObjBlock
                      { oiSymbols :: [FastString]
    oiSymbols  = [FastString]
    syms
                      , oiClInfo :: [ClosureInfo]
    oiClInfo   = []
                      , oiStatic :: [StaticInfo]
    oiStatic   = []
                      , oiStat :: JStat
    oiStat     = JStat
    opt_stat
                      , oiRaw :: ByteString
    oiRaw      = ByteString
    forall a. Monoid a => a
    mempty
                      , oiFExports :: [ExpFun]
    oiFExports = []
                      , oiFImports :: [ForeignJSRef]
    oiFImports = []
                      }
            let lu = LinkableUnit
                      { luObjBlock :: ObjBlock
    luObjBlock     = ObjBlock
    oi
                      , luIdExports :: [Id]
    luIdExports    = []
                      , luOtherExports :: [FastString]
    luOtherExports = [FastString]
    syms
                      , luIdDeps :: [Id]
    luIdDeps       = []
                      , luPseudoIdDeps :: [Unique]
    luPseudoIdDeps = []
                      , luOtherDeps :: [OtherSymb]
    luOtherDeps    = []
                      , luRequired :: Bool
    luRequired     = Bool
    False
                      , luForeignRefs :: [ForeignJSRef]
    luForeignRefs  = []
                      }
            pure lu

          generateExportsBlock :: HasDebugCallStack => G LinkableUnit
          generateExportsBlock :: HasDebugCallStack => G LinkableUnit
    generateExportsBlock = do
            let (SDoc
    f_hdr, SDoc
    f_c) = case ForeignStubs
    foreign_stubs of
                                      ForeignStubs
    NoStubs            -> (SDoc
    forall doc. IsOutput doc => doc
    empty, SDoc
    forall doc. IsOutput doc => doc
    empty)
                                      ForeignStubs CHeader
    hdr CStub
    c -> (CHeader -> SDoc
    getCHeader CHeader
    hdr, CStub -> SDoc
    getCStub CStub
    c)
                unique_deps :: [Unique]
    unique_deps = (FilePath -> Unique) -> [FilePath] -> [Unique]
    forall a b. (a -> b) -> [a] -> [b]
    map FilePath -> Unique
    mkUniqueDep (FilePath -> [FilePath]
    lines (FilePath -> [FilePath]) -> FilePath -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ SDocContext -> SDoc -> FilePath
    renderWithContext SDocContext
    defaultSDocContext SDoc
    f_hdr)
                mkUniqueDep :: FilePath -> Unique
    mkUniqueDep (Char
    tag:FilePath
    xs) = Char -> Word64 -> Unique
    mkUnique Char
    tag (FilePath -> Word64
    forall a. Read a => FilePath -> a
    read FilePath
    xs)
                mkUniqueDep []       = FilePath -> Unique
    forall a. HasCallStack => FilePath -> a
    panic FilePath
    "mkUniqueDep"

            let syms :: [FastString]
    syms = [Module -> FastString
    moduleExportsSymbol Module
    m]
            let raw :: ByteString
    raw  = FilePath -> ByteString
    utf8EncodeByteString (FilePath -> ByteString) -> FilePath -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SDocContext -> SDoc -> FilePath
    renderWithContext SDocContext
    defaultSDocContext SDoc
    f_c
            let oi :: ObjBlock
    oi = ObjBlock
                      { oiSymbols :: [FastString]
    oiSymbols  = [FastString]
    syms
                      , oiClInfo :: [ClosureInfo]
    oiClInfo   = []
                      , oiStatic :: [StaticInfo]
    oiStatic   = []
                      , oiStat :: JStat
    oiStat     = JStat
    forall a. Monoid a => a
    mempty
                      , oiRaw :: ByteString
    oiRaw      = ByteString
    raw
                      , oiFExports :: [ExpFun]
    oiFExports = []
                      , oiFImports :: [ForeignJSRef]
    oiFImports = []
                      }
            let lu :: LinkableUnit
    lu = LinkableUnit
                      { luObjBlock :: ObjBlock
    luObjBlock     = ObjBlock
    oi
                      , luIdExports :: [Id]
    luIdExports    = []
                      , luOtherExports :: [FastString]
    luOtherExports = [FastString]
    syms
                      , luIdDeps :: [Id]
    luIdDeps       = []
                      , luPseudoIdDeps :: [Unique]
    luPseudoIdDeps = [Unique]
    unique_deps
                      , luOtherDeps :: [OtherSymb]
    luOtherDeps    = []
                      , luRequired :: Bool
    luRequired     = Bool
    True
                      , luForeignRefs :: [ForeignJSRef]
    luForeignRefs  = []
                      }
            LinkableUnit -> G LinkableUnit
    forall a. a -> StateT GenState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure LinkableUnit
    lu

          --   Generate the linkable unit for one binding or group of
          --   mutually recursive bindings
          generateBlock :: HasDebugCallStack
                        => CgStgTopBinding
                        -> Int
                        -> G (Maybe LinkableUnit)
          generateBlock :: HasDebugCallStack =>
    CgStgTopBinding -> Int -> G (Maybe LinkableUnit)
    generateBlock CgStgTopBinding
    top_bind Int
    _n = case CgStgTopBinding
    top_bind of
            StgTopStringLit Id
    bnd ByteString
    str -> do
              bids <- Id -> G [Ident]
    identsForId Id
    bnd
              case bids of
                [(Ident -> FastString
    identFS -> FastString
    b1t),(Ident -> FastString
    identFS -> FastString
    b2t)] -> do
                  FastString -> StaticVal -> Maybe Ident -> G ()
    emitStatic FastString
    b1t (StaticUnboxed -> StaticVal
    StaticUnboxed (ByteString -> StaticUnboxed
    StaticUnboxedString ByteString
    str)) Maybe Ident
    forall a. Maybe a
    Nothing
                  FastString -> StaticVal -> Maybe Ident -> G ()
    emitStatic FastString
    b2t (StaticUnboxed -> StaticVal
    StaticUnboxed (ByteString -> StaticUnboxed
    StaticUnboxedStringOffset ByteString
    str)) Maybe Ident
    forall a. Maybe a
    Nothing
                  si        <- (GenState -> [StaticInfo]) -> StateT GenState IO [StaticInfo]
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    State.gets (GenGroupState -> [StaticInfo]
    ggsStatic (GenGroupState -> [StaticInfo])
    -> (GenState -> GenGroupState) -> GenState -> [StaticInfo]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenState -> GenGroupState
    gsGroup)
                  let ids = [Id
    bnd]
                  syms <- (\(Ident -> FastString
    identFS -> FastString
    i) -> [FastString
    i]) <$> identForId bnd
                  let oi = ObjBlock
                            { oiSymbols :: [FastString]
    oiSymbols  = [FastString]
    syms
                            , oiClInfo :: [ClosureInfo]
    oiClInfo   = []
                            , oiStatic :: [StaticInfo]
    oiStatic   = [StaticInfo]
    si
                            , oiStat :: JStat
    oiStat     = JStat
    forall a. Monoid a => a
    mempty
                            , oiRaw :: ByteString
    oiRaw      = ByteString
    ""
                            , oiFExports :: [ExpFun]
    oiFExports = []
                            , oiFImports :: [ForeignJSRef]
    oiFImports = []
                            }
                  let lu = LinkableUnit
                            { luObjBlock :: ObjBlock
    luObjBlock     = ObjBlock
    oi
                            , luIdExports :: [Id]
    luIdExports    = [Id]
    ids
                            , luOtherExports :: [FastString]
    luOtherExports = []
                            , luIdDeps :: [Id]
    luIdDeps       = []
                            , luPseudoIdDeps :: [Unique]
    luPseudoIdDeps = []
                            , luOtherDeps :: [OtherSymb]
    luOtherDeps    = []
                            , luRequired :: Bool
    luRequired     = Bool
    False
                            , luForeignRefs :: [ForeignJSRef]
    luForeignRefs  = []
                            }
                  pure (Just lu)
                [Ident]
    _ -> FilePath -> G (Maybe LinkableUnit)
    forall a. HasCallStack => FilePath -> a
    panic FilePath
    "generateBlock: invalid size"

            StgTopLifted GenStgBinding 'CodeGen
    decl -> do
              tl        <- GenStgBinding 'CodeGen -> G JStgStat
    genToplevel GenStgBinding 'CodeGen
    decl
              extraTl   <- State.gets (ggsToplevelStats . gsGroup)
              ci        <- State.gets (ggsClosureInfo . gsGroup)
              si        <- State.gets (ggsStatic . gsGroup)
              unf       <- State.gets gsUnfloated
              extraDeps <- State.gets (ggsExtraDeps . gsGroup)
              fRefs     <- State.gets (ggsForeignRefs . gsGroup)
              resetGroup
              let allDeps  = UniqFM Id CgStgExpr -> GenStgBinding 'CodeGen -> [Id]
    collectIds UniqFM Id CgStgExpr
    unf GenStgBinding 'CodeGen
    decl
                  topDeps  = GenStgBinding 'CodeGen -> [Id]
    collectTopIds GenStgBinding 'CodeGen
    decl
                  required = GenStgBinding 'CodeGen -> Bool
    hasExport GenStgBinding 'CodeGen
    decl
                  stat     = JStgStat -> JStat
    jStgStatToJS
                             (JStgStat -> JStat) -> JStgStat -> JStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> [JStgStat]
    forall a. [a] -> [a]
    reverse [JStgStat]
    extraTl) JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgStat
    tl
              let opt_stat = JStat -> JStat
    jsOptimize JStat
    stat
              syms <- mapM (fmap (\(Ident -> FastString
    identFS -> FastString
    i) -> FastString
    i) . identForId) topDeps
              let oi = ObjBlock
                        { oiSymbols :: [FastString]
    oiSymbols  = [FastString]
    syms
                        , oiClInfo :: [ClosureInfo]
    oiClInfo   = [ClosureInfo]
    ci
                        , oiStatic :: [StaticInfo]
    oiStatic   = [StaticInfo]
    si
                        , oiStat :: JStat
    oiStat     = JStat
    opt_stat
                        , oiRaw :: ByteString
    oiRaw      = ByteString
    ""
                        , oiFExports :: [ExpFun]
    oiFExports = []
                        , oiFImports :: [ForeignJSRef]
    oiFImports = [ForeignJSRef]
    fRefs
                        }
              let lu = LinkableUnit
                        { luObjBlock :: ObjBlock
    luObjBlock     = ObjBlock
    oi
                        , luIdExports :: [Id]
    luIdExports    = [Id]
    topDeps
                        , luOtherExports :: [FastString]
    luOtherExports = []
                        , luIdDeps :: [Id]
    luIdDeps       = [Id]
    allDeps
                        , luPseudoIdDeps :: [Unique]
    luPseudoIdDeps = []
                        , luOtherDeps :: [OtherSymb]
    luOtherDeps    = Set OtherSymb -> [OtherSymb]
    forall a. Set a -> [a]
    S.toList Set OtherSymb
    extraDeps
                        , luRequired :: Bool
    luRequired     = Bool
    required
                        , luForeignRefs :: [ForeignJSRef]
    luForeignRefs  = [ForeignJSRef]
    fRefs
                        }
              pure $! seqList topDeps `seq` seqList allDeps `seq` Just lu

    -- | variable prefix for the nth block in module

    genToplevel :: CgStgBinding -> G JStgStat
    genToplevel :: GenStgBinding 'CodeGen -> G JStgStat
    genToplevel (StgNonRec BinderP 'CodeGen
    bndr GenStgRhs 'CodeGen
    rhs) = Id -> GenStgRhs 'CodeGen -> G JStgStat
    genToplevelDecl Id
    BinderP 'CodeGen
    bndr GenStgRhs 'CodeGen
    rhs
    genToplevel (StgRec [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs)          =
      [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat)
    -> StateT GenState IO [JStgStat] -> G JStgStat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Id, GenStgRhs 'CodeGen) -> G JStgStat)
    -> [(Id, GenStgRhs 'CodeGen)] -> StateT GenState IO [JStgStat]
    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 (\(Id
    bndr, GenStgRhs 'CodeGen
    rhs) -> Id -> GenStgRhs 'CodeGen -> G JStgStat
    genToplevelDecl Id
    bndr GenStgRhs 'CodeGen
    rhs) [(Id, GenStgRhs 'CodeGen)]
    [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs

    genToplevelDecl :: Id -> CgStgRhs -> G JStgStat
    genToplevelDecl :: Id -> GenStgRhs 'CodeGen -> G JStgStat
    genToplevelDecl Id
    i GenStgRhs 'CodeGen
    rhs = do
      G () -> G ()
    forall a. G a -> G a
    resetSlots (Id -> GenStgRhs 'CodeGen -> G ()
    genToplevelConEntry Id
    i GenStgRhs 'CodeGen
    rhs)
      G JStgStat -> G JStgStat
    forall a. G a -> G a
    resetSlots (Id -> GenStgRhs 'CodeGen -> G JStgStat
    genToplevelRhs Id
    i GenStgRhs 'CodeGen
    rhs)

    genToplevelConEntry :: Id -> CgStgRhs -> G ()
    genToplevelConEntry :: Id -> GenStgRhs 'CodeGen -> G ()
    genToplevelConEntry Id
    i GenStgRhs 'CodeGen
    rhs = case GenStgRhs 'CodeGen
    rhs of
       StgRhsCon CostCentreStack
    _cc DataCon
    con ConstructorNumber
    _mu [StgTickish]
    _ts [StgArg]
    _args Type
    _typ
         | Id -> Bool
    isDataConWorkId Id
    i
           -> HasDebugCallStack => Id -> DataCon -> DIdSet -> G ()
    Id -> DataCon -> DIdSet -> G ()
    genSetConInfo Id
    i DataCon
    con (GenStgRhs 'CodeGen -> DIdSet
    stgRhsLive GenStgRhs 'CodeGen
    rhs) -- NoSRT
       StgRhsClosure XRhsClosure 'CodeGen
    _ CostCentreStack
    _cc UpdateFlag
    _upd_flag [BinderP 'CodeGen]
    _args CgStgExpr
    _body Type
    _typ
         | Just DataCon
    dc <- Id -> Maybe DataCon
    isDataConWorkId_maybe Id
    i
           -> HasDebugCallStack => Id -> DataCon -> DIdSet -> G ()
    Id -> DataCon -> DIdSet -> G ()
    genSetConInfo Id
    i DataCon
    dc (GenStgRhs 'CodeGen -> DIdSet
    stgRhsLive GenStgRhs 'CodeGen
    rhs) -- srt
       GenStgRhs 'CodeGen
    _ -> () -> G ()
    forall a. a -> StateT GenState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    genSetConInfo :: HasDebugCallStack => Id -> DataCon -> LiveVars -> G ()
    genSetConInfo :: HasDebugCallStack => Id -> DataCon -> DIdSet -> G ()
    genSetConInfo Id
    i DataCon
    d DIdSet
    l {- srt -} = do
      ei <- Id -> StateT GenState IO Ident
    identForDataConEntryId Id
    i
      sr <- genStaticRefs l
      let fields = (Scaled Type -> [JSRep]) -> [Scaled Type] -> [JSRep]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (HasDebugCallStack => Type -> [JSRep]
    Type -> [JSRep]
    typeJSRep (Type -> [JSRep])
    -> (Scaled Type -> Type) -> Scaled Type -> [JSRep]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Type
    unwrapType (Type -> Type) -> (Scaled Type -> Type) -> Scaled Type -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Scaled Type -> Type
    forall a. Scaled a -> a
    scaledThing)
                             (DataCon -> [Scaled Type]
    dataConRepArgTys DataCon
    d)
      emitClosureInfo $ ClosureInfo
        { ciVar = ei
        , ciRegs = CIRegs 0 [PtrV]
        , ciName = mkFastString $ renderWithContext defaultSDocContext (ppr d)
        , ciLayout = fixedLayout fields
        , ciType = CICon $ dataConTag d
        , ciStatic = sr
        }
      emitToplevel (mkDataEntry ei)

    mkDataEntry :: Ident -> JStgStat
    mkDataEntry :: Ident -> JStgStat
    mkDataEntry Ident
    i = Ident -> [Ident] -> JStgStat -> JStgStat
    FuncStat Ident
    i [] JStgStat
    returnStack

    genToplevelRhs :: Id -> CgStgRhs -> G JStgStat
    -- general cases:
    genToplevelRhs :: Id -> GenStgRhs 'CodeGen -> G JStgStat
    genToplevelRhs Id
    i GenStgRhs 'CodeGen
    rhs = case GenStgRhs 'CodeGen
    rhs of
      StgRhsCon CostCentreStack
    cc DataCon
    con ConstructorNumber
    _mu [StgTickish]
    _tys [StgArg]
    args Type
    _typ -> do
        ii <- Id -> StateT GenState IO Ident
    identForId Id
    i
        allocConStatic ii cc con args
        return mempty
      StgRhsClosure XRhsClosure 'CodeGen
    _ext CostCentreStack
    cc UpdateFlag
    _upd_flag {- srt -} [BinderP 'CodeGen]
    args CgStgExpr
    body Type
    typ -> do
        {-
          algorithm:
           - collect all Id refs that are in the global id cache
           - count usage in body for each ref
           - order by increasing use
           - prepend loading lives var to body: body can stay the same
        -}
        eid  <- Id -> StateT GenState IO Ident
    identForEntryId Id
    i
        idt  <- identFS <$> identForId i
        body <- genBody (initExprCtx i) R2 args body typ
        occs <- globalOccs body
        let lids = GlobalOcc -> Id
    global_id (GlobalOcc -> Id) -> [GlobalOcc] -> [Id]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((GlobalOcc -> GlobalOcc -> Ordering) -> [GlobalOcc] -> [GlobalOcc]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy GlobalOcc -> GlobalOcc -> Ordering
    cmp_cnt ([GlobalOcc] -> [GlobalOcc]) -> [GlobalOcc] -> [GlobalOcc]
    forall a b. (a -> b) -> a -> b
    $ UniqFM Id GlobalOcc -> [GlobalOcc]
    forall {k} (key :: k) elt. UniqFM key elt -> [elt]
    nonDetEltsUFM UniqFM Id GlobalOcc
    occs)
        -- Regenerate idents from lids to restore right order of representatives.
        -- Representatives have occurrence order which can be mixed.
        lidents <- concat <$> traverse identsForId lids
        let eidt = Ident -> FastString
    identFS Ident
    eid
        let lidents' = (Ident -> FastString) -> [Ident] -> [FastString]
    forall a b. (a -> b) -> [a] -> [b]
    map Ident -> FastString
    identFS [Ident]
    lidents
        CIStaticRefs sr0 <- genStaticRefsRhs rhs
        let sri = (FastString -> Bool) -> [FastString] -> [FastString]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (FastString -> [FastString] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [FastString]
    lidents') [FastString]
    sr0
            sr   = [FastString] -> CIStatic
    CIStaticRefs [FastString]
    sri
        et <- genEntryType args
        ll <- loadLiveFun lids
        (appK, regs, upd) <-
          if et == CIThunk
            then do
              r <- updateThunk
              pure (SAKThunk, CIRegs 0 [PtrV], r)
            else
              let regs = if [Ident] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Ident]
    lidents then Int -> [JSRep] -> CIRegs
    CIRegs Int
    1 ((Id -> [JSRep]) -> [Id] -> [JSRep]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap HasDebugCallStack => Id -> [JSRep]
    Id -> [JSRep]
    idJSRep [Id]
    [BinderP 'CodeGen]
    args)
                                         else Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 (JSRep
    PtrV JSRep -> [JSRep] -> [JSRep]
    forall a. a -> [a] -> [a]
    : (Id -> [JSRep]) -> [Id] -> [JSRep]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap HasDebugCallStack => Id -> [JSRep]
    Id -> [JSRep]
    idJSRep [Id]
    [BinderP 'CodeGen]
    args)
              in pure (SAKFun, regs, mempty)
        setcc <- ifProfiling $
                   if et == CIThunk
                     then enterCostCentreThunk
                     else enterCostCentreFun cc
        emitClosureInfo $ ClosureInfo
          { ciVar = eid
          , ciRegs = regs
          , ciName = idt
          , ciLayout = fixedLayout $ map (unaryTypeJSRep . idType) lids
          , ciType = et
          , ciStatic = sr
          }
        ccId <- costCentreStackLbl cc
        emitStatic idt (StaticApp appK eidt $ map StaticObjArg lidents') ccId
        return $ (FuncStat eid [] (ll <> upd <> setcc <> body))
        where
          cmp_cnt :: GlobalOcc -> GlobalOcc -> Ordering
          cmp_cnt :: GlobalOcc -> GlobalOcc -> Ordering
    cmp_cnt GlobalOcc
    g1 GlobalOcc
    g2 = Word -> Word -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (GlobalOcc -> Word
    global_count GlobalOcc
    g1) (GlobalOcc -> Word
    global_count GlobalOcc
    g2)