    {-# LANGUAGE CPP,
                 FlexibleInstances,
                 OverloadedStrings #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.StgToJS.Rts.Apply
    -- 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
    --
    -- Types and utility functions used in the JS RTS.
    -----------------------------------------------------------------------------

    module GHC.StgToJS.Rts.Types where

    import GHC.Prelude

    import GHC.JS.Make
    import GHC.JS.JStg.Syntax
    import GHC.JS.JStg.Monad
    import GHC.StgToJS.Regs
    import GHC.StgToJS.Types

    --------------------------------------------------------------------------------
    -- Syntactic Sugar for some Utilities we want in JS land
    --------------------------------------------------------------------------------

    -- | Syntactic sugar, i.e., a Haskell function which generates useful JS code.
    -- Given a @JStgExpr@, 'ex', inject a trace statement on 'ex' in the compiled JS
    -- program
    traceRts :: StgToJSConfig -> JStgExpr -> JStgStat
    traceRts :: StgToJSConfig -> JStgExpr -> JStgStat
    traceRts StgToJSConfig
    s JStgExpr
    ex | (StgToJSConfig -> Bool
    csTraceRts StgToJSConfig
    s)  = FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$log" [JStgExpr
    ex]
                  | Bool
    otherwise       = JStgStat
    forall a. Monoid a => a
    mempty

    -- | Syntactic sugar. Given a @JStgExpr@, 'ex' which is assumed to be a predicate,
    -- and a message 'm', assert that 'not ex' is True, if not throw an exception in
    -- JS land with message 'm'.
    assertRts :: ToJExpr a => StgToJSConfig -> JStgExpr -> a -> JStgStat
    assertRts :: forall a. ToJExpr a => StgToJSConfig -> JStgExpr -> a -> JStgStat
    assertRts StgToJSConfig
    s JStgExpr
    ex a
    m | StgToJSConfig -> Bool
    csAssertRts StgToJSConfig
    s = JStgExpr -> JStgStat -> JStgStat
    jwhenS (UOp -> JStgExpr -> JStgExpr
    UOpExpr UOp
    NotOp JStgExpr
    ex) (FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "throw" [a -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr a
    m])
                     | Bool
    otherwise     = JStgStat
    forall a. Monoid a => a
    mempty

    -- | name of the closure 'c'
    clName :: JStgExpr -> JStgExpr
    clName :: JStgExpr -> JStgExpr
    clName JStgExpr
    c = JStgExpr
    c JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "n"

    -- | Type name of the closure 'c'
    clTypeName :: JStgExpr -> JStgExpr
    clTypeName :: JStgExpr -> JStgExpr
    clTypeName JStgExpr
    c = FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$closureTypeName" [JStgExpr
    c JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "t"]

    -- number of  arguments (arity & 0xff = arguments, arity >> 8 = number of registers)
    stackFrameSize :: JStgExpr -- ^ assign frame size to this
                   -> JStgExpr -- ^ stack frame header function
                   -> JSM JStgStat -- ^ size of the frame, including header
    stackFrameSize :: JStgExpr -> JStgExpr -> JSM JStgStat
    stackFrameSize JStgExpr
    tgt JStgExpr
    f =
      JStgExpr -> JSM JStgStat -> JSM JStgStat -> JSM JStgStat
    jIf (JStgExpr
    f JStgExpr -> JStgExpr -> JStgExpr
    .===. FastString -> JStgExpr
    var FastString
    "h$ap_gen") -- h$ap_gen is special
        (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgExpr
    tgt JStgExpr -> JStgExpr -> JStgStat
    |= (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1) JStgExpr -> JStgExpr -> JStgExpr
    .>>. JStgExpr
    8) JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr
    2)
        ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar (\JStgExpr
    tag ->
                  JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat
                  [JStgExpr
    tag JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    f JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "size"
                  , JStgExpr -> JStgStat -> JStgStat -> JStgStat
    ifS (JStgExpr
    tag JStgExpr -> JStgExpr -> JStgExpr
    .<. JStgExpr
    0)              -- if tag is less than 0
                    (JStgExpr
    tgt JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1))   -- set target to stack pointer - 1
                    (JStgExpr
    tgt JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    mask8 JStgExpr
    tag JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr
    1)       -- else set to mask'd tag + 1
                  ]
              ))

      --------------------------------------------------------------------------------
    -- Register utilities
    --------------------------------------------------------------------------------

    -- | Perform the computation 'f', on the range of registers bounded by 'start'
    -- and 'end'.
    withRegs :: StgReg -> StgReg -> (StgReg -> JStgStat) -> JStgStat
    withRegs :: StgReg -> StgReg -> (StgReg -> JStgStat) -> JStgStat
    withRegs StgReg
    start StgReg
    end StgReg -> JStgStat
    f = [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ (StgReg -> JStgStat) -> [StgReg] -> [JStgStat]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap StgReg -> JStgStat
    f [StgReg
    start..StgReg
    end]