{-# 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.JStg.Syntax
import GHC.JS.Make

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

initStaticPtrs :: [SptEntry] -> G JStgStat
initStaticPtrs :: [SptEntry] -> G JStgStat
initStaticPtrs [SptEntry]
ptrs = [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat ([JStgStat] -> JStgStat)
-> StateT GenState IO [JStgStat] -> G JStgStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SptEntry -> G JStgStat)
-> [SptEntry] -> StateT GenState IO [JStgStat]
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 JStgStat
initStatic [SptEntry]
ptrs
  where
    initStatic :: SptEntry -> G JStgStat
initStatic (SptEntry Id
sp_id (Fingerprint Word64
w1 Word64
w2)) = do
      JStgExpr
i <- Id -> G JStgExpr
varForId Id
sp_id
      [JStgExpr]
fpa <- [[JStgExpr]] -> [JStgExpr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[JStgExpr]] -> [JStgExpr])
-> StateT GenState IO [[JStgExpr]] -> StateT GenState IO [JStgExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> StateT GenState IO [JStgExpr])
-> [Word64] -> StateT GenState IO [[JStgExpr]]
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 (HasDebugCallStack => Literal -> StateT GenState IO [JStgExpr]
Literal -> StateT GenState IO [JStgExpr]
genLit (Literal -> StateT GenState IO [JStgExpr])
-> (Word64 -> Literal) -> Word64 -> StateT GenState IO [JStgExpr]
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 :: JStgStat
sptInsert = JStgExpr -> [JStgExpr] -> JStgStat
ApplStat (FastString -> JStgExpr
var FastString
"h$hs_spt_insert") ([JStgExpr]
fpa [JStgExpr] -> [JStgExpr] -> [JStgExpr]
forall a. [a] -> [a] -> [a]
++ [JStgExpr
i])
      JStgStat -> G JStgStat
forall a. a -> StateT GenState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (JStgStat -> G JStgStat) -> JStgStat -> G JStgStat
forall a b. (a -> b) -> a -> b
$ (FastString -> JStgExpr
var FastString
"h$initStatic" JStgExpr -> FastString -> JStgExpr
.^ FastString
"push") JStgExpr -> [JStgExpr] -> JStgStat
`ApplStat` [[Ident] -> JStgStat -> JStgExpr
Func [] JStgStat
sptInsert]