{-# 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.Symbols
import GHC.StgToJS.Ids
import GHC.StgToJS.Literal
import GHC.StgToJS.Types

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
      i <- Id -> G JStgExpr
varForId Id
sp_id
      fpa <- concat <$> mapM (genLit . mkLitWord64 . fromIntegral) [w1,w2]
      let sptInsert = JStgExpr -> [JStgExpr] -> JStgStat
ApplStat JStgExpr
hdHsSptInsert ([JStgExpr]
fpa [JStgExpr] -> [JStgExpr] -> [JStgExpr]
forall a. [a] -> [a] -> [a]
++ [JStgExpr
i])
      return $ (hdInitStatic .^ "push") `ApplStat` [Func [] sptInsert]