{-# 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]