{-# LANGUAGE OverloadedStrings #-}

module GHC.StgToJS.StaticPtr
  ( initStaticPtrs
  )
where

import GHC.Prelude
import GHC.Linker.Types (SptEntry(..))
import GHC.Fingerprint.Type
import GHC.Types.Literal

import GHC.JS.Syntax
import GHC.JS.Make

import GHC.StgToJS.Types
import GHC.StgToJS.Literal
import GHC.StgToJS.Ids

initStaticPtrs :: [SptEntry] -> G JStat
initStaticPtrs :: [SptEntry] -> G JStat
initStaticPtrs [SptEntry]
ptrs = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SptEntry -> G JStat
initStatic [SptEntry]
ptrs
  where
    initStatic :: SptEntry -> G JStat
initStatic (SptEntry Id
sp_id (Fingerprint Word64
w1 Word64
w2)) = do
      JExpr
i <- Id -> G JExpr
varForId Id
sp_id
      [JExpr]
fpa <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HasDebugCallStack => Literal -> StateT GenState IO [JExpr]
genLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
mkLitWord64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Word64
w1,Word64
w2]
      let sptInsert :: JExpr
sptInsert = JExpr -> [JExpr] -> JExpr
ApplExpr (FastString -> JExpr
var FastString
"h$hs_spt_insert") ([JExpr]
fpa forall a. [a] -> [a] -> [a]
++ [JExpr
i])
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (FastString -> JExpr
var FastString
"h$initStatic" JExpr -> FastString -> JExpr
.^ FastString
"push") JExpr -> [JExpr] -> JStat
`ApplStat` [forall a. ToSat a => a -> JExpr
jLam JExpr
sptInsert]