    {-# LANGUAGE OverloadedStrings #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.JS.Stack
    -- 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
    --
    -- Utilities and wrappers for Stack manipulation in JS Land.
    --
    -- In general, functions suffixed with a tick do the actual work, functions
    -- suffixed with an "I" are identical to the non-I versions but work on 'Ident's
    --
    -- The stack in JS land is held in the special JS array 'h$stack' and the stack
    -- pointer is held in 'h$sp'. The top of the stack thus exists at
    -- 'h$stack[h$sp]'. h$stack[h$sp + i] where i > 0, moves deeper into the stack
    -- into older entries, whereas h$stack[h$sp - i] moves towards the top of the
    -- stack.
    --
    -- The stack layout algorithm is slightly peculiar. It makes an effort to
    -- remember recently popped things so that if these values need to be pushed
    -- then they can be quickly. The implementation for this is storing these values
    -- above the stack pointer, and the pushing will skip slots that we know we will
    -- use and fill in slots marked as unknown. Thus, you may find that our push and
    -- pop functions do some non-traditional stack manipulation such as adding slots
    -- in pop or removing slots in push.
    -----------------------------------------------------------------------------

    module GHC.StgToJS.Stack
      ( resetSlots
      , isolateSlots
      , setSlots
      , getSlots
      , addSlots
      , dropSlots
      , addUnknownSlots
      , push
      , push'
      , adjSpN
      , adjSpN'
      , adjSp'
      , adjSp
      , pushNN
      , pushNN'
      , pushN'
      , pushN
      , pushOptimized'
      , pushOptimized
      , pushLneFrame
      , popN
      , popSkip
      , popSkipI
      , loadSkip
      -- * Thunk update
      , updateThunk
      , updateThunk'
      , bhStats
      )
    where

    import GHC.Prelude

    import GHC.JS.JStg.Syntax
    import GHC.JS.Make
    import GHC.JS.Ident

    import GHC.StgToJS.Types
    import GHC.StgToJS.Monad
    import GHC.StgToJS.Ids
    import GHC.StgToJS.ExprCtx
    import GHC.StgToJS.Heap
    import GHC.StgToJS.Regs

    import GHC.Types.Id
    import GHC.Utils.Misc
    import GHC.Data.FastString

    import qualified Data.Bits as Bits
    import qualified Data.List as L
    import qualified Control.Monad.Trans.State.Strict as State
    import Data.Array
    import Data.Monoid
    import Control.Monad

    -- | Run the action, 'm', with no stack info
    resetSlots :: G a -> G a
    resetSlots :: forall a. G a -> G a
    resetSlots G a
    m = do
      s <- G [StackSlot]
    getSlots
      d <- getStackDepth
      setSlots []
      a <- m
      setSlots s
      setStackDepth d
      return a

    -- | run the action, 'm', with current stack info, but don't let modifications
    -- propagate
    isolateSlots :: G a -> G a
    isolateSlots :: forall a. G a -> G a
    isolateSlots G a
    m = do
      s <- G [StackSlot]
    getSlots
      d <- getStackDepth
      a <- m
      setSlots s
      setStackDepth d
      pure a

    -- | Set stack depth
    setStackDepth :: Int -> G ()
    setStackDepth :: Int -> G ()
    setStackDepth Int
    d = (GenGroupState -> GenGroupState) -> G ()
    modifyGroup (\GenGroupState
    s -> GenGroupState
    s { ggsStackDepth = d})

    -- | Get stack depth
    getStackDepth :: G Int
    getStackDepth :: G Int
    getStackDepth = (GenState -> Int) -> G Int
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    State.gets (GenGroupState -> Int
    ggsStackDepth (GenGroupState -> Int)
    -> (GenState -> GenGroupState) -> GenState -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenState -> GenGroupState
    gsGroup)

    -- | Modify stack depth
    modifyStackDepth :: (Int -> Int) -> G ()
    modifyStackDepth :: (Int -> Int) -> G ()
    modifyStackDepth Int -> Int
    f = (GenGroupState -> GenGroupState) -> G ()
    modifyGroup (\GenGroupState
    s -> GenGroupState
    s { ggsStackDepth = f (ggsStackDepth s) })

    -- | overwrite our stack knowledge
    setSlots :: [StackSlot] -> G ()
    setSlots :: [StackSlot] -> G ()
    setSlots [StackSlot]
    xs = (GenGroupState -> GenGroupState) -> G ()
    modifyGroup (\GenGroupState
    g -> GenGroupState
    g { ggsStack = xs})

    -- | retrieve our current stack knowledge
    getSlots :: G [StackSlot]
    getSlots :: G [StackSlot]
    getSlots = (GenState -> [StackSlot]) -> G [StackSlot]
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    State.gets (GenGroupState -> [StackSlot]
    ggsStack (GenGroupState -> [StackSlot])
    -> (GenState -> GenGroupState) -> GenState -> [StackSlot]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenState -> GenGroupState
    gsGroup)

    -- | Modify stack slots
    modifySlots :: ([StackSlot] -> [StackSlot]) -> G ()
    modifySlots :: ([StackSlot] -> [StackSlot]) -> G ()
    modifySlots [StackSlot] -> [StackSlot]
    f = (GenGroupState -> GenGroupState) -> G ()
    modifyGroup (\GenGroupState
    g -> GenGroupState
    g { ggsStack = f (ggsStack g)})

    -- | add `n` unknown slots to our stack knowledge
    addUnknownSlots :: Int -> G ()
    addUnknownSlots :: Int -> G ()
    addUnknownSlots Int
    n = [StackSlot] -> G ()
    addSlots (Int -> StackSlot -> [StackSlot]
    forall a. Int -> a -> [a]
    replicate Int
    n StackSlot
    SlotUnknown)

    -- | add knowledge about the stack slots
    addSlots :: [StackSlot] -> G ()
    addSlots :: [StackSlot] -> G ()
    addSlots [StackSlot]
    xs = do
      s <- G [StackSlot]
    getSlots
      setSlots (xs ++ s)

    -- | drop 'n' slots from our stack knowledge
    dropSlots :: Int -> G ()
    dropSlots :: Int -> G ()
    dropSlots Int
    n = ([StackSlot] -> [StackSlot]) -> G ()
    modifySlots (Int -> [StackSlot] -> [StackSlot]
    forall a. Int -> [a] -> [a]
    drop Int
    n)

    push :: [JStgExpr] -> G JStgStat
    push :: [JStgExpr] -> G JStgStat
    push [JStgExpr]
    xs = do
      Int -> G ()
    dropSlots ([JStgExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [JStgExpr]
    xs)
      (Int -> Int) -> G ()
    modifyStackDepth (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ([JStgExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [JStgExpr]
    xs))
      (StgToJSConfig -> [JStgExpr] -> JStgStat)
    -> [JStgExpr] -> StgToJSConfig -> JStgStat
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StgToJSConfig -> [JStgExpr] -> JStgStat
    push' [JStgExpr]
    xs (StgToJSConfig -> JStgStat)
    -> StateT GenState IO StgToJSConfig -> G JStgStat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT GenState IO StgToJSConfig
    getSettings

    push' :: StgToJSConfig -> [JStgExpr] -> JStgStat
    push' :: StgToJSConfig -> [JStgExpr] -> JStgStat
    push' StgToJSConfig
    _ [] = JStgStat
    forall a. Monoid a => a
    mempty
    push' StgToJSConfig
    cs [JStgExpr]
    xs
       | StgToJSConfig -> Bool
    csInlinePush StgToJSConfig
    cs Bool -> Bool -> Bool
    || Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    32 Bool -> Bool -> Bool
    || Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    2 = Int -> JStgStat
    adjSp' Int
    l JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [JStgStat]
    items
       | Bool
    otherwise                          = JStgExpr -> [JStgExpr] -> JStgStat
    ApplStat (Ident -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (Ident -> JStgExpr) -> Ident -> JStgExpr
    forall a b. (a -> b) -> a -> b
    $ Array Int Ident
    pushN Array Int Ident -> Int -> Ident
    forall i e. Ix i => Array i e -> i -> e
    ! Int
    l) [JStgExpr]
    xs
      where
        items :: [JStgStat]
    items = (Int -> JStgExpr -> JStgStat) -> [Int] -> [JStgExpr] -> [JStgStat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> JStgExpr -> JStgStat
    f [(Int
    1::Int)..] [JStgExpr]
    xs
        offset :: Int -> JStgExpr
    offset Int
    i | Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    l    = JStgExpr
    sp
                 | Bool
    otherwise = Op -> JStgExpr -> JStgExpr -> JStgExpr
    InfixExpr Op
    SubOp JStgExpr
    sp (Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i))
        l :: Int
    l = [JStgExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [JStgExpr]
    xs
        f :: Int -> JStgExpr -> JStgStat
    f Int
    i JStgExpr
    e = JStgExpr -> AOp -> JStgExpr -> JStgStat
    AssignStat ((JStgExpr -> JStgExpr -> JStgExpr
    IdxExpr JStgExpr
    stack) (JStgExpr -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (Int -> JStgExpr
    offset Int
    i))) AOp
    AssignOp (JStgExpr -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr JStgExpr
    e)

    -- | Grow the stack pointer by 'n' without modifying the stack depth. The stack
    -- is just a JS array so we add to grow (instead of the traditional subtract)
    adjSp' :: Int -> JStgStat
    adjSp' :: Int -> JStgStat
    adjSp' Int
    0 = JStgStat
    forall a. Monoid a => a
    mempty
    adjSp' Int
    n = JStgExpr
    sp JStgExpr -> JStgExpr -> JStgStat
    |= Op -> JStgExpr -> JStgExpr -> JStgExpr
    InfixExpr Op
    AddOp JStgExpr
    sp (Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr Int
    n)

    -- | Shrink the stack pointer by 'n'. The stack grows downward so substract
    adjSpN' :: Int -> JStgStat
    adjSpN' :: Int -> JStgStat
    adjSpN' Int
    0 = JStgStat
    forall a. Monoid a => a
    mempty
    adjSpN' Int
    n = JStgExpr
    sp JStgExpr -> JStgExpr -> JStgStat
    |= Op -> JStgExpr -> JStgExpr -> JStgExpr
    InfixExpr Op
    SubOp JStgExpr
    sp (Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr Int
    n)

    -- | Wrapper which adjusts the stack pointer /and/ modifies the stack depth
    -- tracked in 'G'. See also 'adjSp'' which actually does the stack pointer
    -- manipulation.
    adjSp :: Int -> G JStgStat
    adjSp :: Int -> G JStgStat
    adjSp Int
    0 = JStgStat -> G JStgStat
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JStgStat
    forall a. Monoid a => a
    mempty
    adjSp Int
    n = do
      -- grow depth by n
      (Int -> Int) -> G ()
    modifyStackDepth (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n)
      JStgStat -> G JStgStat
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> JStgStat
    adjSp' Int
    n)

    -- | Shrink the stack and stack pointer. NB: This function is unsafe when the
    -- input 'n', is negative. This function wraps around 'adjSpN' which actually
    -- performs the work.
    adjSpN :: Int -> G JStgStat
    adjSpN :: Int -> G JStgStat
    adjSpN Int
    0 = JStgStat -> G JStgStat
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JStgStat
    forall a. Monoid a => a
    mempty
    adjSpN Int
    n = do
      (Int -> Int) -> G ()
    modifyStackDepth (\Int
    x -> Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n)
      JStgStat -> G JStgStat
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> JStgStat
    adjSpN' Int
    n)

    -- | A constant array that holds global function symbols which do N pushes onto
    -- the stack. For example:
    -- @
    -- function h$p1(x1) {
    --   ++h$sp;
    --   h$stack[(h$sp - 0)] = x1;
    -- };
    -- function h$p2(x1, x2) {
    --   h$sp += 2;
    --   h$stack[(h$sp - 1)] = x1;
    --   h$stack[(h$sp - 0)] = x2;
    -- };
    -- @
    --
    -- and so on up to 32.
    pushN :: Array Int Ident
    pushN :: Array Int Ident
    pushN = (Int, Int) -> [Ident] -> Array Int Ident
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    1,Int
    32) ([Ident] -> Array Int Ident) -> [Ident] -> Array Int Ident
    forall a b. (a -> b) -> a -> b
    $ (Int -> Ident) -> [Int] -> [Ident]
    forall a b. (a -> b) -> [a] -> [b]
    map (FastString -> Ident
    global (FastString -> Ident) -> (Int -> FastString) -> Int -> Ident
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> FastString
    mkFastString ([Char] -> FastString) -> (Int -> [Char]) -> Int -> FastString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char]
    "h$p"[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++) ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show) [(Int
    1::Int)..Int
    32]

    -- | Convert all function symbols in 'pushN' to global top-level functions. This
    -- is a hack which converts the function symbols to variables. This hack is
    -- caught in 'GHC.StgToJS.Printer.prettyBlock'' to turn these into global
    -- functions.
    pushN' :: Array Int JStgExpr
    pushN' :: Array Int JStgExpr
    pushN' = (Ident -> JStgExpr) -> Array Int Ident -> Array Int JStgExpr
    forall a b. (a -> b) -> Array Int a -> Array Int b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (JVal -> JStgExpr
    ValExpr (JVal -> JStgExpr) -> (Ident -> JVal) -> Ident -> JStgExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> JVal
    JVar) Array Int Ident
    pushN

    -- | Partial Push functions. Like 'pushN' except these push functions skip
    -- slots. For example,
    -- @
    -- function h$pp33(x1, x2) {
    --   h$sp += 6;
    --   h$stack[(h$sp - 5)] = x1;
    --   h$stack[(h$sp - 0)] = x2;
    -- };
    -- @
    --
    -- The 33rd entry skips slots 1-4 to bind the top of the stack and the 6th
    -- slot. See 'pushOptimized' and 'pushOptimized'' for use cases.
    pushNN :: Array Integer Ident
    pushNN :: Array Integer Ident
    pushNN = (Integer, Integer) -> [Ident] -> Array Integer Ident
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Integer
    1,Integer
    255) ([Ident] -> Array Integer Ident) -> [Ident] -> Array Integer Ident
    forall a b. (a -> b) -> a -> b
    $ (Int -> Ident) -> [Int] -> [Ident]
    forall a b. (a -> b) -> [a] -> [b]
    map (FastString -> Ident
    global (FastString -> Ident) -> (Int -> FastString) -> Int -> Ident
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> FastString
    mkFastString ([Char] -> FastString) -> (Int -> [Char]) -> Int -> FastString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char]
    "h$pp"[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++) ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show) [(Int
    1::Int)..Int
    255]

    -- | Like 'pushN'' but for the partial push functions
    pushNN' :: Array Integer JStgExpr
    pushNN' :: Array Integer JStgExpr
    pushNN' = (Ident -> JStgExpr)
    -> Array Integer Ident -> Array Integer JStgExpr
    forall a b. (a -> b) -> Array Integer a -> Array Integer b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (JVal -> JStgExpr
    ValExpr (JVal -> JStgExpr) -> (Ident -> JVal) -> Ident -> JStgExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> JVal
    JVar) Array Integer Ident
    pushNN

    pushOptimized' :: [(Id,Int)] -> G JStgStat
    pushOptimized' :: [(Id, Int)] -> G JStgStat
    pushOptimized' [(Id, Int)]
    xs = do
      slots  <- G [StackSlot]
    getSlots
      pushOptimized =<< (zipWithM f xs (slots++repeat SlotUnknown))
      where
        f :: (Id, Int) -> StackSlot -> StateT GenState IO (JStgExpr, Bool)
    f (Id
    i1,Int
    n1) StackSlot
    xs2 = do
          xs <- Id -> G [JStgExpr]
    varsForId Id
    i1
          let !id_n1 = [JStgExpr]
    xs [JStgExpr] -> Int -> JStgExpr
    forall a. HasCallStack => [a] -> Int -> a
    !! (Int
    n1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)

          case xs2 of
            SlotId Id
    i2 Int
    n2 -> (JStgExpr, Bool) -> StateT GenState IO (JStgExpr, Bool)
    forall a. a -> StateT GenState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (JStgExpr
    id_n1,Id
    i1Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Id
    i2Bool -> Bool -> Bool
    &&Int
    n1Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    n2)
            StackSlot
    _            -> (JStgExpr, Bool) -> StateT GenState IO (JStgExpr, Bool)
    forall a. a -> StateT GenState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (JStgExpr
    id_n1,Bool
    False)

    -- | optimized push that reuses existing values on stack automatically chooses
    -- an optimized partial push (h$ppN) function when possible.
    pushOptimized :: [(JStgExpr,Bool)] -- ^ contents of the slots, True if same value is already there
                  -> G JStgStat
    pushOptimized :: [(JStgExpr, Bool)] -> G JStgStat
    pushOptimized [] = JStgStat -> G JStgStat
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JStgStat
    forall a. Monoid a => a
    mempty
    pushOptimized [(JStgExpr, Bool)]
    xs = do
      Int -> G ()
    dropSlots Int
    l
      (Int -> Int) -> G ()
    modifyStackDepth (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [(JStgExpr, Bool)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(JStgExpr, Bool)]
    xs)
      Bool -> JStgStat
    go (Bool -> JStgStat)
    -> (StgToJSConfig -> Bool) -> StgToJSConfig -> JStgStat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .  StgToJSConfig -> Bool
    csInlinePush (StgToJSConfig -> JStgStat)
    -> StateT GenState IO StgToJSConfig -> G JStgStat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT GenState IO StgToJSConfig
    getSettings
      where
        go :: Bool -> JStgStat
    go Bool
    True = JStgStat
    inlinePush
        go Bool
    _
         | ((JStgExpr, Bool) -> Bool) -> [(JStgExpr, Bool)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (JStgExpr, Bool) -> Bool
    forall a b. (a, b) -> b
    snd [(JStgExpr, Bool)]
    xs                  = Int -> JStgStat
    adjSp' Int
    l
         | ((JStgExpr, Bool) -> Bool) -> [(JStgExpr, Bool)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not(Bool -> Bool)
    -> ((JStgExpr, Bool) -> Bool) -> (JStgExpr, Bool) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(JStgExpr, Bool) -> Bool
    forall a b. (a, b) -> b
    snd) [(JStgExpr, Bool)]
    xs Bool -> Bool -> Bool
    && Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    32 =
            JStgExpr -> [JStgExpr] -> JStgStat
    ApplStat (Array Int JStgExpr
    pushN' Array Int JStgExpr -> Int -> JStgExpr
    forall i e. Ix i => Array i e -> i -> e
    ! Int
    l) (((JStgExpr, Bool) -> JStgExpr) -> [(JStgExpr, Bool)] -> [JStgExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (JStgExpr, Bool) -> JStgExpr
    forall a b. (a, b) -> a
    fst [(JStgExpr, Bool)]
    xs)
         | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    8 Bool -> Bool -> Bool
    && Bool -> Bool
    not ((JStgExpr, Bool) -> Bool
    forall a b. (a, b) -> b
    snd ((JStgExpr, Bool) -> Bool) -> (JStgExpr, Bool) -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(JStgExpr, Bool)] -> (JStgExpr, Bool)
    forall a. HasCallStack => [a] -> a
    last [(JStgExpr, Bool)]
    xs) =
            JStgExpr -> [JStgExpr] -> JStgStat
    ApplStat (Array Integer JStgExpr
    pushNN' Array Integer JStgExpr -> Integer -> JStgExpr
    forall i e. Ix i => Array i e -> i -> e
    ! Integer
    sig) [ JStgExpr
    e | (JStgExpr
    e,Bool
    False) <- [(JStgExpr, Bool)]
    xs ]
         | Bool
    otherwise = JStgStat
    inlinePush
        l :: Int
    l   = [(JStgExpr, Bool)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(JStgExpr, Bool)]
    xs
        sig :: Integer
        sig :: Integer
    sig = (Integer -> Integer -> Integer) -> [Integer] -> Integer
    forall a. HasCallStack => (a -> a -> a) -> [a] -> a
    L.foldl1' Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    (Bits..|.) ([Integer] -> Integer) -> [Integer] -> Integer
    forall a b. (a -> b) -> a -> b
    $ ((JStgExpr, Bool) -> Int -> Integer)
    -> [(JStgExpr, Bool)] -> [Int] -> [Integer]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\(JStgExpr
    _e,Bool
    b) Int
    i -> if Bool -> Bool
    not Bool
    b then Int -> Integer
    forall a. Bits a => Int -> a
    Bits.bit Int
    i else Integer
    0) [(JStgExpr, Bool)]
    xs [Int
    0..]
        inlinePush :: JStgStat
    inlinePush = Int -> JStgStat
    adjSp' Int
    l JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ((Int -> (JStgExpr, Bool) -> JStgStat)
    -> [Int] -> [(JStgExpr, Bool)] -> [JStgStat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> (JStgExpr, Bool) -> JStgStat
    pushSlot [Int
    1..] [(JStgExpr, Bool)]
    xs)
        pushSlot :: Int -> (JStgExpr, Bool) -> JStgStat
    pushSlot Int
    i (JStgExpr
    ex, Bool
    False) = JStgExpr -> JStgExpr -> JStgExpr
    IdxExpr JStgExpr
    stack (Int -> JStgExpr
    offset Int
    i) JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    ex
        pushSlot Int
    _ (JStgExpr, Bool)
    _           = JStgStat
    forall a. Monoid a => a
    mempty
        offset :: Int -> JStgExpr
    offset Int
    i | Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    l    = JStgExpr
    sp
                 | Bool
    otherwise = Op -> JStgExpr -> JStgExpr -> JStgExpr
    InfixExpr Op
    SubOp JStgExpr
    sp (Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i))

    -- | push a let-no-escape frame onto the stack
    pushLneFrame :: HasDebugCallStack => Int -> ExprCtx -> G JStgStat
    pushLneFrame :: HasDebugCallStack => Int -> ExprCtx -> G JStgStat
    pushLneFrame Int
    size ExprCtx
    ctx =
      let ctx' :: ExprCtx
    ctx' = ExprCtx -> Int -> ExprCtx
    ctxLneShrinkStack ExprCtx
    ctx Int
    size
      in [(Id, Int)] -> G JStgStat
    pushOptimized' (ExprCtx -> [(Id, Int)]
    ctxLneFrameVars ExprCtx
    ctx')

    -- | Pop things, don't update the stack knowledge in 'G'
    popSkip :: Int      -- ^ number of slots to skip
             -> [JStgExpr] -- ^ assign stack slot values to these
             -> JStgStat
    popSkip :: Int -> [JStgExpr] -> JStgStat
    popSkip Int
    0 []  = JStgStat
    forall a. Monoid a => a
    mempty
    popSkip Int
    n []  = Int -> JStgStat
    adjSpN' Int
    n
    popSkip Int
    n [JStgExpr]
    tgt = Int -> [JStgExpr] -> JStgStat
    loadSkip Int
    n [JStgExpr]
    tgt JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> Int -> JStgStat
    adjSpN' ([JStgExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [JStgExpr]
    tgt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n)

    -- | Load 'length (xs :: [JStgExpr])' things from the stack at offset 'n :: Int'.
    -- This function does no stack pointer manipulation, it merely indexes into the
    -- stack and loads payloads into 'xs'.
    loadSkip :: Int -> [JStgExpr] -> JStgStat
    loadSkip :: Int -> [JStgExpr] -> JStgStat
    loadSkip = JStgExpr -> Int -> [JStgExpr] -> JStgStat
    loadSkipFrom JStgExpr
    sp
      where
        loadSkipFrom :: JStgExpr -> Int -> [JStgExpr] -> JStgStat
        loadSkipFrom :: JStgExpr -> Int -> [JStgExpr] -> JStgStat
    loadSkipFrom JStgExpr
    fr Int
    n [JStgExpr]
    xs = [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [JStgStat]
    items
          where
            items :: [JStgStat]
    items = [JStgStat] -> [JStgStat]
    forall a. [a] -> [a]
    reverse ([JStgStat] -> [JStgStat]) -> [JStgStat] -> [JStgStat]
    forall a b. (a -> b) -> a -> b
    $ (Int -> JStgExpr -> JStgStat) -> [Int] -> [JStgExpr] -> [JStgStat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> JStgExpr -> JStgStat
    f [(Int
    0::Int)..] ([JStgExpr] -> [JStgExpr]
    forall a. [a] -> [a]
    reverse [JStgExpr]
    xs)
            -- helper to generate sp - n offset to index with
            offset :: Int -> JStgExpr
    offset Int
    0 = JStgExpr
    fr
            offset Int
    n = Op -> JStgExpr -> JStgExpr -> JStgExpr
    InfixExpr Op
    SubOp JStgExpr
    fr  (Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr Int
    n)
            -- helper to load stack .! i into ex, e.g., ex = stack[i]
            f :: Int -> JStgExpr -> JStgStat
    f Int
    i JStgExpr
    ex   = JStgExpr
    ex JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr -> JStgExpr
    IdxExpr JStgExpr
    stack (JStgExpr -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (Int -> JStgExpr
    offset (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n)))

    -- | Pop but preserve the first N slots
    popSkipI :: Int -> [(Ident,StackSlot)] -> G JStgStat
    popSkipI :: Int -> [(Ident, StackSlot)] -> G JStgStat
    popSkipI Int
    0 [] = JStgStat -> G JStgStat
    forall a. a -> StateT GenState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JStgStat
    forall a. Monoid a => a
    mempty
    popSkipI Int
    n [] = Int -> G JStgStat
    popN Int
    n
    popSkipI Int
    n [(Ident, StackSlot)]
    xs = do
      -- add N unknown slots
      Int -> G ()
    addUnknownSlots Int
    n
      -- now add the slots from xs, after this line the stack should look like
      -- [xs] ++ [Unknown...] ++ old_stack
      [StackSlot] -> G ()
    addSlots (((Ident, StackSlot) -> StackSlot)
    -> [(Ident, StackSlot)] -> [StackSlot]
    forall a b. (a -> b) -> [a] -> [b]
    map (Ident, StackSlot) -> StackSlot
    forall a b. (a, b) -> b
    snd [(Ident, StackSlot)]
    xs)
      -- move stack pointer into the stack by (length xs + n), basically resetting
      -- the stack pointer
      a <- Int -> G JStgStat
    adjSpN ([(Ident, StackSlot)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Ident, StackSlot)]
    xs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n)
      -- now load skipping first N slots
      return (loadSkipI n (map fst xs) <> a)

    -- | Just like 'loadSkip' but operate on 'Ident's rather than 'JStgExpr'
    loadSkipI :: Int -> [Ident] -> JStgStat
    loadSkipI :: Int -> [Ident] -> JStgStat
    loadSkipI = JStgExpr -> Int -> [Ident] -> JStgStat
    loadSkipIFrom JStgExpr
    sp
      where loadSkipIFrom :: JStgExpr -> Int -> [Ident] -> JStgStat
            loadSkipIFrom :: JStgExpr -> Int -> [Ident] -> JStgStat
    loadSkipIFrom JStgExpr
    fr Int
    n [Ident]
    xs = [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [JStgStat]
    items
              where
                items :: [JStgStat]
    items = [JStgStat] -> [JStgStat]
    forall a. [a] -> [a]
    reverse ([JStgStat] -> [JStgStat]) -> [JStgStat] -> [JStgStat]
    forall a b. (a -> b) -> a -> b
    $ (Int -> Ident -> JStgStat) -> [Int] -> [Ident] -> [JStgStat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Ident -> JStgStat
    f [(Int
    0::Int)..] ([Ident] -> [Ident]
    forall a. [a] -> [a]
    reverse [Ident]
    xs)
                offset :: Int -> JStgExpr
    offset Int
    0 = JStgExpr
    fr
                offset Int
    n = Op -> JStgExpr -> JStgExpr -> JStgExpr
    InfixExpr Op
    SubOp JStgExpr
    fr (Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr Int
    n)
                f :: Int -> Ident -> JStgStat
    f Int
    i Ident
    ex   = Ident
    ex Ident -> JStgExpr -> JStgStat
    ||= JStgExpr -> JStgExpr -> JStgExpr
    IdxExpr JStgExpr
    stack (JStgExpr -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (Int -> JStgExpr
    offset (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n)))

    -- | Blindly pop N slots
    popN :: Int -> G JStgStat
    popN :: Int -> G JStgStat
    popN Int
    n = Int -> G ()
    addUnknownSlots Int
    n G () -> G JStgStat -> G JStgStat
    forall a b.
    StateT GenState IO a
    -> StateT GenState IO b -> StateT GenState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> G JStgStat
    adjSpN Int
    n

    -- | Generate statements to update the current node with a blackhole
    bhStats :: StgToJSConfig -> Bool -> JStgStat
    bhStats :: StgToJSConfig -> Bool -> JStgStat
    bhStats StgToJSConfig
    s Bool
    pushUpd = [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat
      [ if Bool
    pushUpd then StgToJSConfig -> [JStgExpr] -> JStgStat
    push' StgToJSConfig
    s [JStgExpr
    r1, FastString -> JStgExpr
    var FastString
    "h$upd_frame"] else JStgStat
    forall a. Monoid a => a
    mempty
      , StgReg -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr StgReg
    R1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    closureEntry_  JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$blackhole"
      , StgReg -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr StgReg
    R1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    closureField1_ JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$currentThread"
      , StgReg -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr StgReg
    R1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    closureField2_ JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    null_ -- will be filled with waiters array
      ]

    -- | Wrapper around 'updateThunk'', performs the stack manipulation before
    -- updating the Thunk.
    updateThunk :: G JStgStat
    updateThunk :: G JStgStat
    updateThunk = do
      settings <- StateT GenState IO StgToJSConfig
    getSettings
      -- update frame size
      let adjPushStack :: Int -> G ()
          adjPushStack Int
    n = do (Int -> Int) -> G ()
    modifyStackDepth (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n)
                              Int -> G ()
    dropSlots Int
    n
      adjPushStack 2
      return $ (updateThunk' settings)

    -- | Update a thunk by checking 'StgToJSConfig'. If the config inlines black
    -- holes then update inline, else make an explicit call to the black hole
    -- handler.
    updateThunk' :: StgToJSConfig -> JStgStat
    updateThunk' :: StgToJSConfig -> JStgStat
    updateThunk' StgToJSConfig
    settings =
      if StgToJSConfig -> Bool
    csInlineBlackhole StgToJSConfig
    settings
        then StgToJSConfig -> Bool -> JStgStat
    bhStats StgToJSConfig
    settings Bool
    True
        else JStgExpr -> [JStgExpr] -> JStgStat
    ApplStat (FastString -> JStgExpr
    var FastString
    "h$bh") []