{-# 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.Types.Name

import GHC.JS.JStg.Syntax
import GHC.JS.Make
import GHC.JS.Ident (name)

import GHC.StgToJS.Symbols
import GHC.StgToJS.Literal
import GHC.StgToJS.Types
import GHC.Utils.Panic (panic)

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
    -- Build a reference to the closure variable for a top-level Name.
    -- Static pointer bindings are exported, so we can construct the symbol
    -- directly from the Name's module and OccName.
    varForName :: Name -> G JStgExpr
    varForName :: Name -> G JStgExpr
varForName Name
n = do
      case Name -> Maybe Module
nameModule_maybe Name
n of
        Just Module
m  -> do
          let sym :: FastString
sym = Bool -> Module -> FastString -> FastString
mkJsSymbol Bool
True Module
m (OccName -> FastString
occNameMangledFS (Name -> OccName
nameOccName Name
n))
          JStgExpr -> G JStgExpr
forall a. a -> StateT GenState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JVal -> JStgExpr
ValExpr (Ident -> JVal
JVar (FastString -> Ident
name FastString
sym)))
        Maybe Module
Nothing ->
          -- Shouldn't happen for SPT entries
          String -> G JStgExpr
forall a. HasCallStack => String -> a
panic String
"varForName: non-external Name in SptEntry"

    initStatic :: SptEntry -> G JStgStat
initStatic (SptEntry Name
sp_name (Fingerprint Word64
w1 Word64
w2)) = do
      i <- Name -> G JStgExpr
varForName Name
sp_name
      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]