    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE LambdaCase        #-}

    module GHC.StgToJS.Utils
      ( assignCoerce1
      , assignToExprCtx
      , fixedLayout
      , assocIdExprs
      -- * Unboxable datacon
      , isUnboxableCon
      , isUnboxable
      , isBoolDataCon
      -- * JSRep
      , slotCount
      , varSize
      , typeSize
      , isVoid
      , isMultiVar
      , idJSRep
      , typeJSRep
      , unaryTypeJSRep
      , primRepToJSRep
      , primOrVoidRepToJSRep
      , stackSlotType
      , primRepSize
      , mkArityTag
      -- * References and Ids
      , exprRefs
      , hasExport
      , collectTopIds
      , collectIds
      -- * Live variables
      , LiveVars
      , liveStatic
      , liveVars
      , stgRhsLive
      , stgExprLive
      , isUpdatableRhs
      , stgLneLive'
      , stgLneLiveExpr
      , isInlineExpr
      )
    where

    import GHC.Prelude

    import GHC.StgToJS.Types
    import GHC.StgToJS.ExprCtx

    import GHC.JS.JStg.Syntax
    import GHC.JS.Make
    import GHC.JS.Transform

    import GHC.Core.DataCon
    import GHC.Core.TyCo.Rep hiding (typeSize)
    import GHC.Core.TyCon
    import GHC.Core.Type hiding (typeSize)

    import GHC.Stg.Syntax

    import GHC.Tc.Utils.TcType

    import GHC.Builtin.Names
    import GHC.Builtin.PrimOps (PrimOp(SeqOp), primOpIsReallyInline)

    import GHC.Types.RepType
    import GHC.Types.Var
    import GHC.Types.Var.Set
    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Types.Unique.FM
    import GHC.Types.ForeignCall
    import GHC.Types.TyThing
    import GHC.Types.Name

    import GHC.Utils.Misc
    import GHC.Utils.Outputable hiding ((<>))
    import GHC.Utils.Panic

    import qualified Data.Bits as Bits
    import qualified Data.Foldable as F
    import qualified Data.Set      as S
    import qualified Data.List     as L
    import Data.Set (Set)
    import Data.Monoid

    assignToTypedExprs :: [TypedExpr] -> [JStgExpr] -> JStgStat
    assignToTypedExprs :: [TypedExpr] -> [JStgExpr] -> JStgStat
    assignToTypedExprs [TypedExpr]
    tes [JStgExpr]
    es =
      [JStgExpr] -> [JStgExpr] -> JStgStat
    HasDebugCallStack => [JStgExpr] -> [JStgExpr] -> JStgStat
    assignAllEqual ((TypedExpr -> [JStgExpr]) -> [TypedExpr] -> [JStgExpr]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap TypedExpr -> [JStgExpr]
    typex_expr [TypedExpr]
    tes) [JStgExpr]
    es

    assignTypedExprs :: [TypedExpr] -> [TypedExpr] -> JStgStat
    assignTypedExprs :: [TypedExpr] -> [TypedExpr] -> JStgStat
    assignTypedExprs [TypedExpr]
    tes [TypedExpr]
    es =
      let prim_tes :: [JStgExpr]
    prim_tes = (TypedExpr -> [JStgExpr]) -> [TypedExpr] -> [JStgExpr]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap TypedExpr -> [JStgExpr]
    typex_expr [TypedExpr]
    tes
          prim_es :: [JStgExpr]
    prim_es  = (TypedExpr -> [JStgExpr]) -> [TypedExpr] -> [JStgExpr]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap TypedExpr -> [JStgExpr]
    typex_expr [TypedExpr]
    es
            -- extract the JExprs, effectively unarising a RuntimeRep thing to
            -- multiple VarType-repped things (e.g., AddrRep takes two VarType-regs)
      in Bool -> SDoc -> JStgStat -> JStgStat
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr ([JStgExpr] -> [JStgExpr] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [JStgExpr]
    prim_tes [JStgExpr]
    prim_es)
                   ([PrimRep] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((TypedExpr -> PrimRep) -> [TypedExpr] -> [PrimRep]
    forall a b. (a -> b) -> [a] -> [b]
    map TypedExpr -> PrimRep
    typex_typ [TypedExpr]
    tes) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [PrimRep] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((TypedExpr -> PrimRep) -> [TypedExpr] -> [PrimRep]
    forall a b. (a -> b) -> [a] -> [b]
    map TypedExpr -> PrimRep
    typex_typ [TypedExpr]
    es))
                   ([JStgExpr] -> [JStgExpr] -> JStgStat
    HasDebugCallStack => [JStgExpr] -> [JStgExpr] -> JStgStat
    assignAllEqual [JStgExpr]
    prim_tes [JStgExpr]
    prim_es)

    assignToExprCtx :: ExprCtx -> [JStgExpr] -> JStgStat
    assignToExprCtx :: ExprCtx -> [JStgExpr] -> JStgStat
    assignToExprCtx ExprCtx
    ctx [JStgExpr]
    es = [TypedExpr] -> [JStgExpr] -> JStgStat
    assignToTypedExprs (ExprCtx -> [TypedExpr]
    ctxTarget ExprCtx
    ctx) [JStgExpr]
    es

    -- | Assign first expr only (if it exists), performing coercions between some
    -- PrimReps (e.g. StablePtr# and Addr#).
    assignCoerce1 :: [TypedExpr] -> [TypedExpr] -> JStgStat
    assignCoerce1 :: [TypedExpr] -> [TypedExpr] -> JStgStat
    assignCoerce1 [TypedExpr
    x] [TypedExpr
    y] = TypedExpr -> TypedExpr -> JStgStat
    assignCoerce TypedExpr
    x TypedExpr
    y
    assignCoerce1 []  []  = JStgStat
    forall a. Monoid a => a
    mempty
    -- We silently ignore the case of an empty list on the first argument. It denotes
    -- "assign nothing to n empty slots on the right". Usually this case shouldn't come
    -- up, but rare cases where the earlier code can't correctly guess the size of type
    -- classes causes slots to be allocated when they aren't needed.
    assignCoerce1 []  [TypedExpr]
    _   = JStgStat
    forall a. Monoid a => a
    mempty
    assignCoerce1 [TypedExpr]
    x [TypedExpr]
    y     = String -> SDoc -> JStgStat
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "assignCoerce1"
                              ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "lengths do not match"
                                    -- FIXME: Outputable instance removed until JStg replaces JStat
                                    , [TypedExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TypedExpr]
    x
                                    , [TypedExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TypedExpr]
    y
                                    ])

    -- | Assign p2 to p1 with optional coercion
    assignCoerce :: TypedExpr -> TypedExpr -> JStgStat
    -- Coercion between StablePtr# and Addr#
    assignCoerce :: TypedExpr -> TypedExpr -> JStgStat
    assignCoerce (TypedExpr PrimRep
    AddrRep [JStgExpr
    a_val, JStgExpr
    a_off]) (TypedExpr (BoxedRep (Just Levity
    Unlifted)) [JStgExpr
    sptr]) = [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat
        [ JStgExpr
    a_val JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$stablePtrBuf"
        , JStgExpr
    a_off JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    sptr
        ]
    assignCoerce (TypedExpr (BoxedRep (Just Levity
    Unlifted)) [JStgExpr
    sptr]) (TypedExpr PrimRep
    AddrRep [JStgExpr
    _a_val, JStgExpr
    a_off]) =
      JStgExpr
    sptr JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    a_off
    assignCoerce TypedExpr
    p1 TypedExpr
    p2 = [TypedExpr] -> [TypedExpr] -> JStgStat
    assignTypedExprs [TypedExpr
    p1] [TypedExpr
    p2]

    --------------------------------------------------------------------------------
    --                        Core Utils
    --------------------------------------------------------------------------------

    -- | can we unbox C x to x, only if x is represented as a Number
    isUnboxableCon :: DataCon -> Bool
    isUnboxableCon :: DataCon -> Bool
    isUnboxableCon DataCon
    dc
      | [Scaled Type
    t] <- DataCon -> [Scaled Type]
    dataConRepArgTys DataCon
    dc
      , [JSRep
    t1] <- HasDebugCallStack => Type -> [JSRep]
    Type -> [JSRep]
    typeJSRep (Scaled Type -> Type
    forall a. Scaled a -> a
    scaledThing Scaled Type
    t)
      = JSRep -> Bool
    isUnboxable JSRep
    t1 Bool -> Bool -> Bool
    &&
        DataCon -> Int
    dataConTag DataCon
    dc Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 Bool -> Bool -> Bool
    &&
        [DataCon] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (TyCon -> [DataCon]
    tyConDataCons (TyCon -> [DataCon]) -> TyCon -> [DataCon]
    forall a b. (a -> b) -> a -> b
    $ DataCon -> TyCon
    dataConTyCon DataCon
    dc) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1
      | Bool
    otherwise = Bool
    False

    -- | one-constructor types with one primitive field represented as a JS Number
    -- can be unboxed
    isUnboxable :: JSRep -> Bool
    isUnboxable :: JSRep -> Bool
    isUnboxable JSRep
    DoubleV = Bool
    True
    isUnboxable JSRep
    IntV    = Bool
    True -- includes Char#
    isUnboxable JSRep
    _       = Bool
    False

    -- | Number of slots occupied by a PrimRep
    data SlotCount
      = NoSlot
      | OneSlot
      | TwoSlots
      deriving (Int -> SlotCount -> ShowS
    [SlotCount] -> ShowS
    SlotCount -> String
    (Int -> SlotCount -> ShowS)
    -> (SlotCount -> String)
    -> ([SlotCount] -> ShowS)
    -> Show SlotCount
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SlotCount -> ShowS
    showsPrec :: Int -> SlotCount -> ShowS
    $cshow :: SlotCount -> String
    show :: SlotCount -> String
    $cshowList :: [SlotCount] -> ShowS
    showList :: [SlotCount] -> ShowS
    Show,SlotCount -> SlotCount -> Bool
    (SlotCount -> SlotCount -> Bool)
    -> (SlotCount -> SlotCount -> Bool) -> Eq SlotCount
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SlotCount -> SlotCount -> Bool
    == :: SlotCount -> SlotCount -> Bool
    $c/= :: SlotCount -> SlotCount -> Bool
    /= :: SlotCount -> SlotCount -> Bool
    Eq,Eq SlotCount
    Eq SlotCount =>
    (SlotCount -> SlotCount -> Ordering)
    -> (SlotCount -> SlotCount -> Bool)
    -> (SlotCount -> SlotCount -> Bool)
    -> (SlotCount -> SlotCount -> Bool)
    -> (SlotCount -> SlotCount -> Bool)
    -> (SlotCount -> SlotCount -> SlotCount)
    -> (SlotCount -> SlotCount -> SlotCount)
    -> Ord SlotCount
    SlotCount -> SlotCount -> Bool
    SlotCount -> SlotCount -> Ordering
    SlotCount -> SlotCount -> SlotCount
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: SlotCount -> SlotCount -> Ordering
    compare :: SlotCount -> SlotCount -> Ordering
    $c< :: SlotCount -> SlotCount -> Bool
    < :: SlotCount -> SlotCount -> Bool
    $c<= :: SlotCount -> SlotCount -> Bool
    <= :: SlotCount -> SlotCount -> Bool
    $c> :: SlotCount -> SlotCount -> Bool
    > :: SlotCount -> SlotCount -> Bool
    $c>= :: SlotCount -> SlotCount -> Bool
    >= :: SlotCount -> SlotCount -> Bool
    $cmax :: SlotCount -> SlotCount -> SlotCount
    max :: SlotCount -> SlotCount -> SlotCount
    $cmin :: SlotCount -> SlotCount -> SlotCount
    min :: SlotCount -> SlotCount -> SlotCount
    Ord)

    instance Outputable SlotCount where
      ppr :: SlotCount -> SDoc
    ppr = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc) -> (SlotCount -> String) -> SlotCount -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SlotCount -> String
    forall a. Show a => a -> String
    show

    -- | Return SlotCount as an Int
    slotCount :: SlotCount -> Int
    slotCount :: SlotCount -> Int
    slotCount = \case
      SlotCount
    NoSlot   -> Int
    0
      SlotCount
    OneSlot  -> Int
    1
      SlotCount
    TwoSlots -> Int
    2

    -- | Number of slots occupied by a value with the given JSRep
    varSize :: JSRep -> Int
    varSize :: JSRep -> Int
    varSize = SlotCount -> Int
    slotCount (SlotCount -> Int) -> (JSRep -> SlotCount) -> JSRep -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . JSRep -> SlotCount
    jsRepSlots

    jsRepSlots :: JSRep -> SlotCount
    jsRepSlots :: JSRep -> SlotCount
    jsRepSlots JSRep
    VoidV = SlotCount
    NoSlot
    jsRepSlots JSRep
    LongV = SlotCount
    TwoSlots -- hi, low
    jsRepSlots JSRep
    AddrV = SlotCount
    TwoSlots -- obj/array, offset
    jsRepSlots JSRep
    _     = SlotCount
    OneSlot

    typeSize :: Type -> Int
    typeSize :: Type -> Int
    typeSize Type
    t = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> (Type -> [Int]) -> Type -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (JSRep -> Int) -> [JSRep] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map JSRep -> Int
    varSize ([JSRep] -> [Int]) -> (Type -> [JSRep]) -> Type -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => Type -> [JSRep]
    Type -> [JSRep]
    typeJSRep (Type -> Int) -> Type -> Int
    forall a b. (a -> b) -> a -> b
    $ Type
    t

    isVoid :: JSRep -> Bool
    isVoid :: JSRep -> Bool
    isVoid JSRep
    VoidV = Bool
    True
    isVoid JSRep
    _     = Bool
    False

    isMultiVar :: JSRep -> Bool
    isMultiVar :: JSRep -> Bool
    isMultiVar JSRep
    v = case JSRep -> SlotCount
    jsRepSlots JSRep
    v of
      SlotCount
    NoSlot   -> Bool
    False
      SlotCount
    OneSlot  -> Bool
    False
      SlotCount
    TwoSlots -> Bool
    True

    idJSRep :: HasDebugCallStack => Id -> [JSRep]
    idJSRep :: HasDebugCallStack => Id -> [JSRep]
    idJSRep = HasDebugCallStack => Type -> [JSRep]
    Type -> [JSRep]
    typeJSRep (Type -> [JSRep]) -> (Id -> Type) -> Id -> [JSRep]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    idType

    typeJSRep :: HasDebugCallStack => Type -> [JSRep]
    typeJSRep :: HasDebugCallStack => Type -> [JSRep]
    typeJSRep Type
    t = (PrimRep -> JSRep) -> [PrimRep] -> [JSRep]
    forall a b. (a -> b) -> [a] -> [b]
    map HasDebugCallStack => PrimRep -> JSRep
    PrimRep -> JSRep
    primRepToJSRep (HasDebugCallStack => Type -> [PrimRep]
    Type -> [PrimRep]
    typePrimRep Type
    t)

    -- only use if you know it's not an unboxed tuple
    unaryTypeJSRep :: HasDebugCallStack => UnaryType -> JSRep
    unaryTypeJSRep :: HasDebugCallStack => Type -> JSRep
    unaryTypeJSRep Type
    ut = HasDebugCallStack => PrimOrVoidRep -> JSRep
    PrimOrVoidRep -> JSRep
    primOrVoidRepToJSRep (HasDebugCallStack => Type -> PrimOrVoidRep
    Type -> PrimOrVoidRep
    typePrimRep1 Type
    ut)

    primRepToJSRep :: HasDebugCallStack => PrimRep -> JSRep
    primRepToJSRep :: HasDebugCallStack => PrimRep -> JSRep
    primRepToJSRep (BoxedRep Maybe Levity
    _) = JSRep
    PtrV
    primRepToJSRep PrimRep
    IntRep       = JSRep
    IntV
    primRepToJSRep PrimRep
    Int8Rep      = JSRep
    IntV
    primRepToJSRep PrimRep
    Int16Rep     = JSRep
    IntV
    primRepToJSRep PrimRep
    Int32Rep     = JSRep
    IntV
    primRepToJSRep PrimRep
    WordRep      = JSRep
    IntV
    primRepToJSRep PrimRep
    Word8Rep     = JSRep
    IntV
    primRepToJSRep PrimRep
    Word16Rep    = JSRep
    IntV
    primRepToJSRep PrimRep
    Word32Rep    = JSRep
    IntV
    primRepToJSRep PrimRep
    Int64Rep     = JSRep
    LongV
    primRepToJSRep PrimRep
    Word64Rep    = JSRep
    LongV
    primRepToJSRep PrimRep
    AddrRep      = JSRep
    AddrV
    primRepToJSRep PrimRep
    FloatRep     = JSRep
    DoubleV
    primRepToJSRep PrimRep
    DoubleRep    = JSRep
    DoubleV
    primRepToJSRep (VecRep{})   = String -> JSRep
    forall a. HasCallStack => String -> a
    error String
    "primRepToJSRep: vector types are unsupported"

    primOrVoidRepToJSRep :: HasDebugCallStack => PrimOrVoidRep -> JSRep
    primOrVoidRepToJSRep :: HasDebugCallStack => PrimOrVoidRep -> JSRep
    primOrVoidRepToJSRep PrimOrVoidRep
    VoidRep = JSRep
    VoidV
    primOrVoidRepToJSRep (NVRep PrimRep
    rep) = HasDebugCallStack => PrimRep -> JSRep
    PrimRep -> JSRep
    primRepToJSRep PrimRep
    rep

    dataConType :: DataCon -> Type
    dataConType :: DataCon -> Type
    dataConType DataCon
    dc = Id -> Type
    idType (DataCon -> Id
    dataConWrapId DataCon
    dc)

    isBoolDataCon :: DataCon -> Bool
    isBoolDataCon :: DataCon -> Bool
    isBoolDataCon DataCon
    dc = Type -> Bool
    isBoolTy (DataCon -> Type
    dataConType DataCon
    dc)

    -- standard fixed layout: payload types
    -- payload starts at .d1 for heap objects, entry closest to Sp for stack frames
    fixedLayout :: [JSRep] -> CILayout
    fixedLayout :: [JSRep] -> CILayout
    fixedLayout [JSRep]
    vts = Int -> [JSRep] -> CILayout
    CILayoutFixed ([Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((JSRep -> Int) -> [JSRep] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map JSRep -> Int
    varSize [JSRep]
    vts)) [JSRep]
    vts

    -- 2-var values might have been moved around separately, use DoubleV as substitute
    -- ObjV is 1 var, so this is no problem for implicit metadata
    stackSlotType :: Id -> JSRep
    stackSlotType :: Id -> JSRep
    stackSlotType Id
    i
      | SlotCount
    OneSlot <- JSRep -> SlotCount
    jsRepSlots JSRep
    otype = JSRep
    otype
      | Bool
    otherwise                   = JSRep
    DoubleV
      where otype :: JSRep
    otype = HasDebugCallStack => Type -> JSRep
    Type -> JSRep
    unaryTypeJSRep (Id -> Type
    idType Id
    i)

    idPrimReps :: Id -> [PrimRep]
    idPrimReps :: Id -> [PrimRep]
    idPrimReps = Type -> [PrimRep]
    typePrimReps (Type -> [PrimRep]) -> (Id -> Type) -> Id -> [PrimRep]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    idType

    typePrimReps :: Type -> [PrimRep]
    typePrimReps :: Type -> [PrimRep]
    typePrimReps = HasDebugCallStack => Type -> [PrimRep]
    Type -> [PrimRep]
    typePrimRep (Type -> [PrimRep]) -> (Type -> Type) -> Type -> [PrimRep]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Type
    unwrapType

    primRepSize :: PrimRep -> SlotCount
    primRepSize :: PrimRep -> SlotCount
    primRepSize PrimRep
    p = JSRep -> SlotCount
    jsRepSlots (HasDebugCallStack => PrimRep -> JSRep
    PrimRep -> JSRep
    primRepToJSRep PrimRep
    p)

    -- | Associate the given values to each RrimRep in the given order, taking into
    -- account the number of slots per PrimRep
    assocPrimReps :: [PrimRep] -> [JStgExpr] -> [(PrimRep, [JStgExpr])]
    assocPrimReps :: [PrimRep] -> [JStgExpr] -> [(PrimRep, [JStgExpr])]
    assocPrimReps []     [JStgExpr]
    _  = []
    assocPrimReps (PrimRep
    r:[PrimRep]
    rs) [JStgExpr]
    vs = case (PrimRep -> SlotCount
    primRepSize PrimRep
    r,[JStgExpr]
    vs) of
      (SlotCount
    NoSlot,   [JStgExpr]
    xs)     -> (PrimRep
    r,[])    (PrimRep, [JStgExpr])
    -> [(PrimRep, [JStgExpr])] -> [(PrimRep, [JStgExpr])]
    forall a. a -> [a] -> [a]
    : [PrimRep] -> [JStgExpr] -> [(PrimRep, [JStgExpr])]
    assocPrimReps [PrimRep]
    rs [JStgExpr]
    xs
      (SlotCount
    OneSlot,  JStgExpr
    x:[JStgExpr]
    xs)   -> (PrimRep
    r,[JStgExpr
    x])   (PrimRep, [JStgExpr])
    -> [(PrimRep, [JStgExpr])] -> [(PrimRep, [JStgExpr])]
    forall a. a -> [a] -> [a]
    : [PrimRep] -> [JStgExpr] -> [(PrimRep, [JStgExpr])]
    assocPrimReps [PrimRep]
    rs [JStgExpr]
    xs
      (SlotCount
    TwoSlots, JStgExpr
    x:JStgExpr
    y:[JStgExpr]
    xs) -> (PrimRep
    r,[JStgExpr
    x,JStgExpr
    y]) (PrimRep, [JStgExpr])
    -> [(PrimRep, [JStgExpr])] -> [(PrimRep, [JStgExpr])]
    forall a. a -> [a] -> [a]
    : [PrimRep] -> [JStgExpr] -> [(PrimRep, [JStgExpr])]
    assocPrimReps [PrimRep]
    rs [JStgExpr]
    xs
      (SlotCount, [JStgExpr])
    err                -> String -> SDoc -> [(PrimRep, [JStgExpr])]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "assocPrimReps" ((SlotCount, [JExpr]) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((SlotCount, [JExpr]) -> SDoc) -> (SlotCount, [JExpr]) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (JStgExpr -> JExpr) -> [JStgExpr] -> [JExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map JStgExpr -> JExpr
    jStgExprToJS ([JStgExpr] -> [JExpr])
    -> (SlotCount, [JStgExpr]) -> (SlotCount, [JExpr])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (SlotCount, [JStgExpr])
    err)

    -- | Associate the given values to the Id's PrimReps, taking into account the
    -- number of slots per PrimRep
    assocIdPrimReps :: Id -> [JStgExpr] -> [(PrimRep, [JStgExpr])]
    assocIdPrimReps :: Id -> [JStgExpr] -> [(PrimRep, [JStgExpr])]
    assocIdPrimReps Id
    i = [PrimRep] -> [JStgExpr] -> [(PrimRep, [JStgExpr])]
    assocPrimReps (Id -> [PrimRep]
    idPrimReps Id
    i)

    -- | Associate the given JExpr to the Id's PrimReps, taking into account the
    -- number of slots per PrimRep
    assocIdExprs :: Id -> [JStgExpr] -> [TypedExpr]
    assocIdExprs :: Id -> [JStgExpr] -> [TypedExpr]
    assocIdExprs Id
    i [JStgExpr]
    es = ((PrimRep, [JStgExpr]) -> TypedExpr)
    -> [(PrimRep, [JStgExpr])] -> [TypedExpr]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((PrimRep -> [JStgExpr] -> TypedExpr)
    -> (PrimRep, [JStgExpr]) -> TypedExpr
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry PrimRep -> [JStgExpr] -> TypedExpr
    TypedExpr) (Id -> [JStgExpr] -> [(PrimRep, [JStgExpr])]
    assocIdPrimReps Id
    i [JStgExpr]
    es)

    mkArityTag :: Int -> Int -> Int
    mkArityTag :: Int -> Int -> Int
    mkArityTag Int
    arity Int
    registers = Int
    arity Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    Bits..|. (Int
    registers Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `Bits.shiftL` Int
    8)

    --------------------------------------------------------------------------------
    --                        Stg Utils
    --------------------------------------------------------------------------------

    s :: a -> Set a
    s :: forall a. a -> Set a
    s = a -> Set a
    forall a. a -> Set a
    S.singleton

    l :: (a -> Set Id) -> [a] -> Set Id
    l :: forall a. (a -> Set Id) -> [a] -> Set Id
    l = (a -> Set Id) -> [a] -> Set Id
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap

    -- | collect Ids that this binding refers to
    --   (does not include the bindees themselves)
    -- first argument is Id -> StgExpr map for unfloated arguments
    bindingRefs :: UniqFM Id CgStgExpr -> CgStgBinding -> Set Id
    bindingRefs :: UniqFM Id CgStgExpr -> CgStgBinding -> Set Id
    bindingRefs UniqFM Id CgStgExpr
    u = \case
      StgNonRec BinderP 'CodeGen
    _ GenStgRhs 'CodeGen
    rhs -> UniqFM Id CgStgExpr -> GenStgRhs 'CodeGen -> Set Id
    rhsRefs UniqFM Id CgStgExpr
    u GenStgRhs 'CodeGen
    rhs
      StgRec [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs       -> ((Id, GenStgRhs 'CodeGen) -> Set Id)
    -> [(Id, GenStgRhs 'CodeGen)] -> Set Id
    forall a. (a -> Set Id) -> [a] -> Set Id
    l (UniqFM Id CgStgExpr -> GenStgRhs 'CodeGen -> Set Id
    rhsRefs UniqFM Id CgStgExpr
    u (GenStgRhs 'CodeGen -> Set Id)
    -> ((Id, GenStgRhs 'CodeGen) -> GenStgRhs 'CodeGen)
    -> (Id, GenStgRhs 'CodeGen)
    -> Set Id
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Id, GenStgRhs 'CodeGen) -> GenStgRhs 'CodeGen
    forall a b. (a, b) -> b
    snd) [(Id, GenStgRhs 'CodeGen)]
    [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs

    rhsRefs :: UniqFM Id CgStgExpr -> CgStgRhs -> Set Id
    rhsRefs :: UniqFM Id CgStgExpr -> GenStgRhs 'CodeGen -> Set Id
    rhsRefs UniqFM Id CgStgExpr
    u = \case
      StgRhsClosure XRhsClosure 'CodeGen
    _ CostCentreStack
    _ UpdateFlag
    _ [BinderP 'CodeGen]
    _ CgStgExpr
    body Type
    _       -> UniqFM Id CgStgExpr -> CgStgExpr -> Set Id
    exprRefs UniqFM Id CgStgExpr
    u CgStgExpr
    body
      StgRhsCon CostCentreStack
    _ccs DataCon
    d ConstructorNumber
    _mu [StgTickish]
    _ticks [StgArg]
    args Type
    _ -> (Id -> Set Id) -> [Id] -> Set Id
    forall a. (a -> Set Id) -> [a] -> Set Id
    l Id -> Set Id
    forall a. a -> Set a
    s [ Id
    i | AnId Id
    i <- DataCon -> [TyThing]
    dataConImplicitTyThings DataCon
    d] Set Id -> Set Id -> Set Id
    forall a. Semigroup a => a -> a -> a
    <> (StgArg -> Set Id) -> [StgArg] -> Set Id
    forall a. (a -> Set Id) -> [a] -> Set Id
    l (UniqFM Id CgStgExpr -> StgArg -> Set Id
    argRefs UniqFM Id CgStgExpr
    u) [StgArg]
    args

    exprRefs :: UniqFM Id CgStgExpr -> CgStgExpr -> Set Id
    exprRefs :: UniqFM Id CgStgExpr -> CgStgExpr -> Set Id
    exprRefs UniqFM Id CgStgExpr
    u = \case
      StgApp Id
    f [StgArg]
    args             -> Id -> Set Id
    forall a. a -> Set a
    s Id
    f Set Id -> Set Id -> Set Id
    forall a. Semigroup a => a -> a -> a
    <> (StgArg -> Set Id) -> [StgArg] -> Set Id
    forall a. (a -> Set Id) -> [a] -> Set Id
    l (UniqFM Id CgStgExpr -> StgArg -> Set Id
    argRefs UniqFM Id CgStgExpr
    u) [StgArg]
    args
      StgConApp DataCon
    d ConstructorNumber
    _n [StgArg]
    args [[PrimRep]]
    _     -> (Id -> Set Id) -> [Id] -> Set Id
    forall a. (a -> Set Id) -> [a] -> Set Id
    l Id -> Set Id
    forall a. a -> Set a
    s [ Id
    i | AnId Id
    i <- DataCon -> [TyThing]
    dataConImplicitTyThings DataCon
    d] Set Id -> Set Id -> Set Id
    forall a. Semigroup a => a -> a -> a
    <> (StgArg -> Set Id) -> [StgArg] -> Set Id
    forall a. (a -> Set Id) -> [a] -> Set Id
    l (UniqFM Id CgStgExpr -> StgArg -> Set Id
    argRefs UniqFM Id CgStgExpr
    u) [StgArg]
    args
      StgOpApp StgOp
    _ [StgArg]
    args Type
    _         -> (StgArg -> Set Id) -> [StgArg] -> Set Id
    forall a. (a -> Set Id) -> [a] -> Set Id
    l (UniqFM Id CgStgExpr -> StgArg -> Set Id
    argRefs UniqFM Id CgStgExpr
    u) [StgArg]
    args
      StgLit {}                 -> Set Id
    forall a. Monoid a => a
    mempty
      StgCase CgStgExpr
    expr BinderP 'CodeGen
    _ AltType
    _ [GenStgAlt 'CodeGen]
    alts     -> UniqFM Id CgStgExpr -> CgStgExpr -> Set Id
    exprRefs UniqFM Id CgStgExpr
    u CgStgExpr
    expr Set Id -> Set Id -> Set Id
    forall a. Semigroup a => a -> a -> a
    <> [Set Id] -> Set Id
    forall a. Monoid a => [a] -> a
    mconcat ((GenStgAlt 'CodeGen -> Set Id) -> [GenStgAlt 'CodeGen] -> [Set Id]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (UniqFM Id CgStgExpr -> GenStgAlt 'CodeGen -> Set Id
    altRefs UniqFM Id CgStgExpr
    u) [GenStgAlt 'CodeGen]
    alts)
      StgLet XLet 'CodeGen
    _ CgStgBinding
    bnd CgStgExpr
    expr         -> UniqFM Id CgStgExpr -> CgStgBinding -> Set Id
    bindingRefs UniqFM Id CgStgExpr
    u CgStgBinding
    bnd Set Id -> Set Id -> Set Id
    forall a. Semigroup a => a -> a -> a
    <> UniqFM Id CgStgExpr -> CgStgExpr -> Set Id
    exprRefs UniqFM Id CgStgExpr
    u CgStgExpr
    expr
      StgLetNoEscape XLetNoEscape 'CodeGen
    _ CgStgBinding
    bnd CgStgExpr
    expr -> UniqFM Id CgStgExpr -> CgStgBinding -> Set Id
    bindingRefs UniqFM Id CgStgExpr
    u CgStgBinding
    bnd Set Id -> Set Id -> Set Id
    forall a. Semigroup a => a -> a -> a
    <> UniqFM Id CgStgExpr -> CgStgExpr -> Set Id
    exprRefs UniqFM Id CgStgExpr
    u CgStgExpr
    expr
      StgTick StgTickish
    _ CgStgExpr
    expr            -> UniqFM Id CgStgExpr -> CgStgExpr -> Set Id
    exprRefs UniqFM Id CgStgExpr
    u CgStgExpr
    expr

    altRefs :: UniqFM Id CgStgExpr -> CgStgAlt -> Set Id
    altRefs :: UniqFM Id CgStgExpr -> GenStgAlt 'CodeGen -> Set Id
    altRefs UniqFM Id CgStgExpr
    u GenStgAlt 'CodeGen
    alt = UniqFM Id CgStgExpr -> CgStgExpr -> Set Id
    exprRefs UniqFM Id CgStgExpr
    u (GenStgAlt 'CodeGen -> CgStgExpr
    forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs GenStgAlt 'CodeGen
    alt)

    argRefs :: UniqFM Id CgStgExpr -> StgArg -> Set Id
    argRefs :: UniqFM Id CgStgExpr -> StgArg -> Set Id
    argRefs UniqFM Id CgStgExpr
    u = \case
      StgVarArg Id
    id
        | Just CgStgExpr
    e <- UniqFM Id CgStgExpr -> Id -> Maybe CgStgExpr
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM Id CgStgExpr
    u Id
    id -> UniqFM Id CgStgExpr -> CgStgExpr -> Set Id
    exprRefs UniqFM Id CgStgExpr
    u CgStgExpr
    e
        | Bool
    otherwise                -> Id -> Set Id
    forall a. a -> Set a
    s Id
    id
      StgArg
    _ -> Set Id
    forall a. Monoid a => a
    mempty

    hasExport :: CgStgBinding -> Bool
    hasExport :: CgStgBinding -> Bool
    hasExport CgStgBinding
    bnd =
      case CgStgBinding
    bnd of
        StgNonRec BinderP 'CodeGen
    b GenStgRhs 'CodeGen
    e -> Id -> GenStgRhs 'CodeGen -> Bool
    forall {p} {pass :: StgPass}. p -> GenStgRhs pass -> Bool
    isExportedBind Id
    BinderP 'CodeGen
    b GenStgRhs 'CodeGen
    e
        StgRec [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs     -> ((Id, GenStgRhs 'CodeGen) -> Bool)
    -> [(Id, GenStgRhs 'CodeGen)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ((Id -> GenStgRhs 'CodeGen -> Bool)
    -> (Id, GenStgRhs 'CodeGen) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Id -> GenStgRhs 'CodeGen -> Bool
    forall {p} {pass :: StgPass}. p -> GenStgRhs pass -> Bool
    isExportedBind) [(Id, GenStgRhs 'CodeGen)]
    [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs
      where
        isExportedBind :: p -> GenStgRhs pass -> Bool
    isExportedBind p
    _i (StgRhsCon CostCentreStack
    _cc DataCon
    con ConstructorNumber
    _ [StgTickish]
    _ [StgArg]
    _ Type
    _) =
          DataCon -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique DataCon
    con Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique
    staticPtrDataConKey
        isExportedBind p
    _ GenStgRhs pass
    _ = Bool
    False

    collectTopIds :: CgStgBinding -> [Id]
    collectTopIds :: CgStgBinding -> [Id]
    collectTopIds (StgNonRec BinderP 'CodeGen
    b GenStgRhs 'CodeGen
    _) = [Id
    BinderP 'CodeGen
    b]
    collectTopIds (StgRec [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs) = let xs :: [Id]
    xs = ((Id, GenStgRhs 'CodeGen) -> Id)
    -> [(Id, GenStgRhs 'CodeGen)] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id -> Id
    zapFragileIdInfo (Id -> Id)
    -> ((Id, GenStgRhs 'CodeGen) -> Id)
    -> (Id, GenStgRhs 'CodeGen)
    -> Id
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Id, GenStgRhs 'CodeGen) -> Id
    forall a b. (a, b) -> a
    fst) [(Id, GenStgRhs 'CodeGen)]
    [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs
                                in  [Id] -> ZonkAny 0 -> ZonkAny 0
    forall a b. [a] -> b -> b
    seqList [Id]
    xs (ZonkAny 0 -> ZonkAny 0) -> [Id] -> [Id]
    forall a b. a -> b -> b
    `seq` [Id]
    xs

    collectIds :: UniqFM Id CgStgExpr -> CgStgBinding -> [Id]
    collectIds :: UniqFM Id CgStgExpr -> CgStgBinding -> [Id]
    collectIds UniqFM Id CgStgExpr
    unfloated CgStgBinding
    b =
      let xs :: [Id]
    xs = (Id -> Id) -> [Id] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Id
    zapFragileIdInfo ([Id] -> [Id]) -> ([Id] -> [Id]) -> [Id] -> [Id]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
               (Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Id -> Bool
    forall {p}. NamedThing p => p -> Bool
    acceptId ([Id] -> [Id]) -> [Id] -> [Id]
    forall a b. (a -> b) -> a -> b
    $ Set Id -> [Id]
    forall a. Set a -> [a]
    S.toList (UniqFM Id CgStgExpr -> CgStgBinding -> Set Id
    bindingRefs UniqFM Id CgStgExpr
    unfloated CgStgBinding
    b)
      in  [Id] -> ZonkAny 1 -> ZonkAny 1
    forall a b. [a] -> b -> b
    seqList [Id]
    xs (ZonkAny 1 -> ZonkAny 1) -> [Id] -> [Id]
    forall a b. a -> b -> b
    `seq` [Id]
    xs
      where
        acceptId :: p -> Bool
    acceptId p
    i = ((p -> Bool) -> Bool) -> [p -> Bool] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ((p -> Bool) -> p -> Bool
    forall a b. (a -> b) -> a -> b
    $ p
    i) [Bool -> Bool
    not (Bool -> Bool) -> (p -> Bool) -> p -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p -> Bool
    forall {p}. NamedThing p => p -> Bool
    isForbidden] -- fixme test this: [isExported[isGlobalId, not.isForbidden]
        isForbidden :: a -> Bool
    isForbidden a
    i
          -- the GHC.Prim module has no js source file
          | Just Module
    m <- Name -> Maybe Module
    nameModule_maybe (a -> Name
    forall a. NamedThing a => a -> Name
    getName a
    i)
          , Module
    m Module -> Module -> Bool
    forall a. Eq a => a -> a -> Bool
    == Module
    gHC_PRIM
          = Bool
    True
          -- unboxed tuples have no definition
          | Name -> Bool
    isUnboxedTupleDataConLikeName (a -> Name
    forall a. NamedThing a => a -> Name
    getName a
    i)
          = Bool
    True
          | Bool
    otherwise
          = Bool
    False

    -----------------------------------------------------
    -- Live vars
    --
    -- TODO: should probably be moved into GHC.Stg.LiveVars

    type LiveVars = DVarSet

    liveStatic :: LiveVars -> LiveVars
    liveStatic :: LiveVars -> LiveVars
    liveStatic = (Id -> Bool) -> LiveVars -> LiveVars
    filterDVarSet Id -> Bool
    isGlobalId

    liveVars :: LiveVars -> LiveVars
    liveVars :: LiveVars -> LiveVars
    liveVars = (Id -> Bool) -> LiveVars -> LiveVars
    filterDVarSet (Bool -> Bool
    not (Bool -> Bool) -> (Id -> Bool) -> Id -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Bool
    isGlobalId)

    stgBindLive :: CgStgBinding -> [(Id, LiveVars)]
    stgBindLive :: CgStgBinding -> [(Id, LiveVars)]
    stgBindLive = \case
      StgNonRec BinderP 'CodeGen
    b GenStgRhs 'CodeGen
    rhs -> [(Id
    BinderP 'CodeGen
    b, GenStgRhs 'CodeGen -> LiveVars
    stgRhsLive GenStgRhs 'CodeGen
    rhs)]
      StgRec [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs       -> ((Id, GenStgRhs 'CodeGen) -> (Id, LiveVars))
    -> [(Id, GenStgRhs 'CodeGen)] -> [(Id, LiveVars)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Id
    b,GenStgRhs 'CodeGen
    rhs) -> (Id
    b, GenStgRhs 'CodeGen -> LiveVars
    stgRhsLive GenStgRhs 'CodeGen
    rhs)) [(Id, GenStgRhs 'CodeGen)]
    [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs

    stgBindRhsLive :: CgStgBinding -> LiveVars
    stgBindRhsLive :: CgStgBinding -> LiveVars
    stgBindRhsLive CgStgBinding
    b =
      let ([Id]
    bs, [LiveVars]
    ls) = [(Id, LiveVars)] -> ([Id], [LiveVars])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (CgStgBinding -> [(Id, LiveVars)]
    stgBindLive CgStgBinding
    b)
      in  LiveVars -> [Id] -> LiveVars
    delDVarSetList ([LiveVars] -> LiveVars
    unionDVarSets [LiveVars]
    ls) [Id]
    bs

    stgRhsLive :: CgStgRhs -> LiveVars
    stgRhsLive :: GenStgRhs 'CodeGen -> LiveVars
    stgRhsLive = \case
      StgRhsClosure XRhsClosure 'CodeGen
    _ CostCentreStack
    _ UpdateFlag
    _ [BinderP 'CodeGen]
    args CgStgExpr
    e Type
    _ -> LiveVars -> [Id] -> LiveVars
    delDVarSetList (Bool -> CgStgExpr -> LiveVars
    stgExprLive Bool
    True CgStgExpr
    e) [Id]
    [BinderP 'CodeGen]
    args
      StgRhsCon CostCentreStack
    _ DataCon
    _ ConstructorNumber
    _ [StgTickish]
    _ [StgArg]
    args Type
    _     -> [LiveVars] -> LiveVars
    unionDVarSets ((StgArg -> LiveVars) -> [StgArg] -> [LiveVars]
    forall a b. (a -> b) -> [a] -> [b]
    map StgArg -> LiveVars
    stgArgLive [StgArg]
    args)

    stgArgLive :: StgArg -> LiveVars
    stgArgLive :: StgArg -> LiveVars
    stgArgLive = \case
      StgVarArg Id
    occ -> Id -> LiveVars
    unitDVarSet Id
    occ
      StgLitArg {}  -> LiveVars
    emptyDVarSet

    stgExprLive :: Bool -> CgStgExpr -> LiveVars
    stgExprLive :: Bool -> CgStgExpr -> LiveVars
    stgExprLive Bool
    includeLHS = \case
      StgApp Id
    occ [StgArg]
    args -> [LiveVars] -> LiveVars
    unionDVarSets (Id -> LiveVars
    unitDVarSet Id
    occ LiveVars -> [LiveVars] -> [LiveVars]
    forall a. a -> [a] -> [a]
    : (StgArg -> LiveVars) -> [StgArg] -> [LiveVars]
    forall a b. (a -> b) -> [a] -> [b]
    map StgArg -> LiveVars
    stgArgLive [StgArg]
    args)
      StgLit {}       -> LiveVars
    emptyDVarSet
      StgConApp DataCon
    _dc ConstructorNumber
    _n [StgArg]
    args [[PrimRep]]
    _tys -> [LiveVars] -> LiveVars
    unionDVarSets ((StgArg -> LiveVars) -> [StgArg] -> [LiveVars]
    forall a b. (a -> b) -> [a] -> [b]
    map StgArg -> LiveVars
    stgArgLive [StgArg]
    args)
      StgOpApp StgOp
    _op [StgArg]
    args Type
    _ty      -> [LiveVars] -> LiveVars
    unionDVarSets ((StgArg -> LiveVars) -> [StgArg] -> [LiveVars]
    forall a b. (a -> b) -> [a] -> [b]
    map StgArg -> LiveVars
    stgArgLive [StgArg]
    args)
      StgCase CgStgExpr
    e BinderP 'CodeGen
    b AltType
    _at [GenStgAlt 'CodeGen]
    alts
        | Bool
    includeLHS -> LiveVars
    el LiveVars -> LiveVars -> LiveVars
    `unionDVarSet` LiveVars -> Id -> LiveVars
    delDVarSet LiveVars
    al Id
    BinderP 'CodeGen
    b
        | Bool
    otherwise  -> LiveVars -> Id -> LiveVars
    delDVarSet LiveVars
    al Id
    BinderP 'CodeGen
    b
        where
          al :: LiveVars
    al = [LiveVars] -> LiveVars
    unionDVarSets ((GenStgAlt 'CodeGen -> LiveVars)
    -> [GenStgAlt 'CodeGen] -> [LiveVars]
    forall a b. (a -> b) -> [a] -> [b]
    map GenStgAlt 'CodeGen -> LiveVars
    stgAltLive [GenStgAlt 'CodeGen]
    alts)
          el :: LiveVars
    el = Bool -> CgStgExpr -> LiveVars
    stgExprLive Bool
    True CgStgExpr
    e
      StgLet XLet 'CodeGen
    _ CgStgBinding
    b CgStgExpr
    e         -> LiveVars -> [Id] -> LiveVars
    delDVarSetList (CgStgBinding -> LiveVars
    stgBindRhsLive CgStgBinding
    b LiveVars -> LiveVars -> LiveVars
    `unionDVarSet` Bool -> CgStgExpr -> LiveVars
    stgExprLive Bool
    True CgStgExpr
    e) (CgStgBinding -> [Id]
    bindees CgStgBinding
    b)
      StgLetNoEscape XLetNoEscape 'CodeGen
    _ CgStgBinding
    b CgStgExpr
    e -> LiveVars -> [Id] -> LiveVars
    delDVarSetList (CgStgBinding -> LiveVars
    stgBindRhsLive CgStgBinding
    b LiveVars -> LiveVars -> LiveVars
    `unionDVarSet` Bool -> CgStgExpr -> LiveVars
    stgExprLive Bool
    True CgStgExpr
    e) (CgStgBinding -> [Id]
    bindees CgStgBinding
    b)
      StgTick StgTickish
    _ti CgStgExpr
    e        -> Bool -> CgStgExpr -> LiveVars
    stgExprLive Bool
    True CgStgExpr
    e

    stgAltLive :: CgStgAlt -> LiveVars
    stgAltLive :: GenStgAlt 'CodeGen -> LiveVars
    stgAltLive GenStgAlt 'CodeGen
    alt =
      LiveVars -> [Id] -> LiveVars
    delDVarSetList (Bool -> CgStgExpr -> LiveVars
    stgExprLive Bool
    True (GenStgAlt 'CodeGen -> CgStgExpr
    forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs GenStgAlt 'CodeGen
    alt)) (GenStgAlt 'CodeGen -> [BinderP 'CodeGen]
    forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs GenStgAlt 'CodeGen
    alt)

    bindees :: CgStgBinding -> [Id]
    bindees :: CgStgBinding -> [Id]
    bindees = \case
      StgNonRec BinderP 'CodeGen
    b GenStgRhs 'CodeGen
    _e -> [Id
    BinderP 'CodeGen
    b]
      StgRec [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs      -> ((Id, GenStgRhs 'CodeGen) -> Id)
    -> [(Id, GenStgRhs 'CodeGen)] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id, GenStgRhs 'CodeGen) -> Id
    forall a b. (a, b) -> a
    fst [(Id, GenStgRhs 'CodeGen)]
    [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs

    isUpdatableRhs :: CgStgRhs -> Bool
    isUpdatableRhs :: GenStgRhs 'CodeGen -> Bool
    isUpdatableRhs (StgRhsClosure XRhsClosure 'CodeGen
    _ CostCentreStack
    _ UpdateFlag
    u [BinderP 'CodeGen]
    _ CgStgExpr
    _ Type
    _) = UpdateFlag -> Bool
    isUpdatable UpdateFlag
    u
    isUpdatableRhs GenStgRhs 'CodeGen
    _                           = Bool
    False

    stgLneLive' :: CgStgBinding -> [Id]
    stgLneLive' :: CgStgBinding -> [Id]
    stgLneLive' CgStgBinding
    b = (Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Id -> [Id] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` CgStgBinding -> [Id]
    bindees CgStgBinding
    b) (CgStgBinding -> [Id]
    stgLneLive CgStgBinding
    b)

    stgLneLive :: CgStgBinding -> [Id]
    stgLneLive :: CgStgBinding -> [Id]
    stgLneLive (StgNonRec BinderP 'CodeGen
    _b GenStgRhs 'CodeGen
    e) = GenStgRhs 'CodeGen -> [Id]
    stgLneLiveExpr GenStgRhs 'CodeGen
    e
    stgLneLive (StgRec [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs)      = [Id] -> [Id]
    forall a. Eq a => [a] -> [a]
    L.nub ([Id] -> [Id]) -> [Id] -> [Id]
    forall a b. (a -> b) -> a -> b
    $ ((Id, GenStgRhs 'CodeGen) -> [Id])
    -> [(Id, GenStgRhs 'CodeGen)] -> [Id]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (GenStgRhs 'CodeGen -> [Id]
    stgLneLiveExpr (GenStgRhs 'CodeGen -> [Id])
    -> ((Id, GenStgRhs 'CodeGen) -> GenStgRhs 'CodeGen)
    -> (Id, GenStgRhs 'CodeGen)
    -> [Id]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Id, GenStgRhs 'CodeGen) -> GenStgRhs 'CodeGen
    forall a b. (a, b) -> b
    snd) [(Id, GenStgRhs 'CodeGen)]
    [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    bs

    stgLneLiveExpr :: CgStgRhs -> [Id]
    stgLneLiveExpr :: GenStgRhs 'CodeGen -> [Id]
    stgLneLiveExpr GenStgRhs 'CodeGen
    rhs = LiveVars -> [Id]
    dVarSetElems (LiveVars -> LiveVars
    liveVars (LiveVars -> LiveVars) -> LiveVars -> LiveVars
    forall a b. (a -> b) -> a -> b
    $ GenStgRhs 'CodeGen -> LiveVars
    stgRhsLive GenStgRhs 'CodeGen
    rhs)
    -- stgLneLiveExpr (StgRhsClosure _ _ _ _ e) = dVarSetElems (liveVars (stgExprLive e))
    -- stgLneLiveExpr StgRhsCon {}              = []

    -- | returns True if the expression is definitely inline
    isInlineExpr :: CgStgExpr -> Bool
    isInlineExpr :: CgStgExpr -> Bool
    isInlineExpr = \case
      StgApp Id
    i [StgArg]
    args
        -> Id -> [StgArg] -> Bool
    isInlineApp Id
    i [StgArg]
    args
      StgLit{}
        -> Bool
    True
      StgConApp{}
        -> Bool
    True
      StgOpApp (StgFCallOp ForeignCall
    f Type
    _) [StgArg]
    _ Type
    _
        -> ForeignCall -> Bool
    isInlineForeignCall ForeignCall
    f
      StgOpApp (StgPrimOp PrimOp
    SeqOp) [StgVarArg Id
    e] Type
    t
        -> Id -> Bool
    ctxIsEvaluated Id
    e Bool -> Bool -> Bool
    || HasDebugCallStack => Type -> Bool
    Type -> Bool
    isStrictType Type
    t
      StgOpApp (StgPrimOp PrimOp
    op) [StgArg]
    _ Type
    _
        -> PrimOp -> Bool
    primOpIsReallyInline PrimOp
    op
      StgOpApp (StgPrimCallOp PrimCall
    _c) [StgArg]
    _ Type
    _
        -> Bool
    True
      StgCase CgStgExpr
    e BinderP 'CodeGen
    _ AltType
    _ [GenStgAlt 'CodeGen]
    alts
        ->let ie :: Bool
    ie   = CgStgExpr -> Bool
    isInlineExpr CgStgExpr
    e
              ias :: [Bool]
    ias  = (CgStgExpr -> Bool) -> [CgStgExpr] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map CgStgExpr -> Bool
    isInlineExpr ((GenStgAlt 'CodeGen -> CgStgExpr)
    -> [GenStgAlt 'CodeGen] -> [CgStgExpr]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GenStgAlt 'CodeGen -> CgStgExpr
    forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs [GenStgAlt 'CodeGen]
    alts)
          in Bool
    ie Bool -> Bool -> Bool
    && [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [Bool]
    ias
      StgLet XLet 'CodeGen
    _ CgStgBinding
    _ CgStgExpr
    e
        -> CgStgExpr -> Bool
    isInlineExpr CgStgExpr
    e
      StgLetNoEscape XLetNoEscape 'CodeGen
    _ CgStgBinding
    _ CgStgExpr
    e
        -> CgStgExpr -> Bool
    isInlineExpr CgStgExpr
    e
      StgTick StgTickish
    _ CgStgExpr
    e
        -> CgStgExpr -> Bool
    isInlineExpr CgStgExpr
    e

    isInlineForeignCall :: ForeignCall -> Bool
    isInlineForeignCall :: ForeignCall -> Bool
    isInlineForeignCall (CCall (CCallSpec CCallTarget
    _ CCallConv
    cconv Safety
    safety)) =
      Bool -> Bool
    not (Safety -> Bool
    playInterruptible Safety
    safety) Bool -> Bool -> Bool
    &&
      Bool -> Bool
    not (CCallConv
    cconv CCallConv -> CCallConv -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CCallConv
    JavaScriptCallConv Bool -> Bool -> Bool
    && Safety -> Bool
    playSafe Safety
    safety)

    isInlineApp :: Id -> [StgArg] -> Bool
    isInlineApp :: Id -> [StgArg] -> Bool
    isInlineApp Id
    i = \case
      [StgArg]
    _ | Id -> Bool
    isJoinId Id
    i -> Bool
    False
      [] -> Type -> Bool
    isUnboxedTupleType (Id -> Type
    idType Id
    i) Bool -> Bool -> Bool
    ||
                         HasDebugCallStack => Type -> Bool
    Type -> Bool
    isStrictType (Id -> Type
    idType Id
    i) Bool -> Bool -> Bool
    ||
                         Id -> Bool
    ctxIsEvaluated Id
    i

      [StgVarArg Id
    a]
        | DataConWrapId DataCon
    dc <- Id -> IdDetails
    idDetails Id
    i
        , TyCon -> Bool
    isNewTyCon (DataCon -> TyCon
    dataConTyCon DataCon
    dc)
        , HasDebugCallStack => Type -> Bool
    Type -> Bool
    isStrictType (Id -> Type
    idType Id
    a) Bool -> Bool -> Bool
    || Id -> Bool
    ctxIsEvaluated Id
    a Bool -> Bool -> Bool
    || Id -> Bool
    isStrictId Id
    a
        -> Bool
    True
      [StgArg]
    _ -> Bool
    False