{-# 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 = [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ([JStat] -> JStat) -> StateT GenState IO [JStat] -> G JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SptEntry -> G JStat) -> [SptEntry] -> StateT GenState IO [JStat]
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 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 <- [[JExpr]] -> [JExpr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[JExpr]] -> [JExpr])
-> StateT GenState IO [[JExpr]] -> StateT GenState IO [JExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> StateT GenState IO [JExpr])
-> [Word64] -> StateT GenState IO [[JExpr]]
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 ((() :: Constraint) => Literal -> StateT GenState IO [JExpr]
Literal -> StateT GenState IO [JExpr]
genLit (Literal -> StateT GenState IO [JExpr])
-> (Word64 -> Literal) -> Word64 -> StateT GenState IO [JExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
mkLitWord64 (Integer -> Literal) -> (Word64 -> Integer) -> Word64 -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
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 [JExpr] -> [JExpr] -> [JExpr]
forall a. [a] -> [a] -> [a]
++ [JExpr
i])
      JStat -> G JStat
forall a. a -> StateT GenState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> G JStat) -> JStat -> G JStat
forall a b. (a -> b) -> a -> b
$ (FastString -> JExpr
var FastString
"h$initStatic" JExpr -> FastString -> JExpr
.^ FastString
"push") JExpr -> [JExpr] -> JStat
`ApplStat` [JExpr -> JExpr
forall a. ToSat a => a -> JExpr
jLam JExpr
sptInsert]