[Git][ghc/ghc][wip/bytecode-serialize-clean] compiler: make SptEntry serializable

Cheng Shao (@TerrorJack) gitlab at gitlab.haskell.org
Fri Feb 14 23:59:29 UTC 2025



Cheng Shao pushed to branch wip/bytecode-serialize-clean at Glasgow Haskell Compiler / GHC


Commits:
da9504d3 by Cheng Shao at 2025-02-14T23:59:20+00:00
compiler: make SptEntry serializable

- - - - -


4 changed files:

- compiler/GHC/Driver/Main.hs
- compiler/GHC/Iface/Tidy/StaticPtrTable.hs
- compiler/GHC/StgToJS/StaticPtr.hs
- compiler/GHC/Types/SptEntry.hs


Changes:

=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -2567,7 +2567,7 @@ hscAddSptEntries hsc_env entries = do
     let add_spt_entry :: SptEntry -> IO ()
         add_spt_entry (SptEntry i fpr) = do
             -- These are only names from the current module
-            (val, _, _) <- loadName interp hsc_env (idName i)
+            (val, _, _) <- loadName interp hsc_env i
             addSptEntry interp fpr val
     mapM_ add_spt_entry entries
 


=====================================
compiler/GHC/Iface/Tidy/StaticPtrTable.hs
=====================================
@@ -144,6 +144,7 @@ import GHC.Utils.Outputable as Outputable
 import GHC.Linker.Types
 
 import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Types.ForeignStubs
 import GHC.Data.Maybe
 import GHC.Data.FastString
@@ -205,7 +206,7 @@ sptCreateStaticBinds opts this_mod binds = do
         Nothing      -> return (Nothing, (b, e))
         Just (_, t, info, arg) -> do
           (fp, e') <- mkStaticBind t info arg
-          return (Just (SptEntry b fp), (b, foldr Lam e' tvs))
+          return (Just (SptEntry (idName b) fp), (b, foldr Lam e' tvs))
 
     mkStaticBind :: Type -> CoreExpr -> CoreExpr
                  -> StateT Int IO (Fingerprint, CoreExpr)
@@ -257,11 +258,11 @@ sptModuleInitCode platform this_mod entries
         [  text "static StgWord64 k" <> int i <> text "[2] = "
            <> pprFingerprint fp <> semi
         $$ text "extern StgPtr "
-           <> (pprCLabel platform $ mkClosureLabel (idName n) (idCafInfo n)) <> semi
+           <> (pprCLabel platform $ mkClosureLabel n MayHaveCafRefs) <> semi
         $$ text "hs_spt_insert" <> parens
              (hcat $ punctuate comma
                 [ char 'k' <> int i
-                , char '&' <> pprCLabel platform (mkClosureLabel (idName n) (idCafInfo n))
+                , char '&' <> pprCLabel platform (mkClosureLabel n MayHaveCafRefs)
                 ]
              )
         <> semi


=====================================
compiler/GHC/StgToJS/StaticPtr.hs
=====================================
@@ -6,8 +6,10 @@ module GHC.StgToJS.StaticPtr
 where
 
 import GHC.Prelude
+import GHC.Builtin.Types
 import GHC.Linker.Types (SptEntry(..))
 import GHC.Fingerprint.Type
+import GHC.Types.Id
 import GHC.Types.Literal
 
 import GHC.JS.JStg.Syntax
@@ -21,8 +23,8 @@ import GHC.StgToJS.Types
 initStaticPtrs :: [SptEntry] -> G JStgStat
 initStaticPtrs ptrs = mconcat <$> mapM initStatic ptrs
   where
-    initStatic (SptEntry sp_id (Fingerprint w1 w2)) = do
-      i <- varForId sp_id
+    initStatic (SptEntry sp_nm (Fingerprint w1 w2)) = do
+      i <- varForId $ mkVanillaGlobal sp_nm anyTy
       fpa <- concat <$> mapM (genLit . mkLitWord64 . fromIntegral) [w1,w2]
       let sptInsert = ApplStat hdHsSptInsert (fpa ++ [i])
       return $ (hdInitStatic .^ "push") `ApplStat` [Func [] sptInsert]


=====================================
compiler/GHC/Types/SptEntry.hs
=====================================
@@ -3,15 +3,13 @@ module GHC.Types.SptEntry
   )
 where
 
-import GHC.Types.Var           ( Id )
 import GHC.Fingerprint.Type    ( Fingerprint )
+import GHC.Types.Name
 import GHC.Utils.Outputable
 
 -- | An entry to be inserted into a module's static pointer table.
 -- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable".
-data SptEntry = SptEntry Id Fingerprint
+data SptEntry = SptEntry !Name !Fingerprint
 
 instance Outputable SptEntry where
   ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr
-
-



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da9504d329624631fe1a65403ba15f910be18cdb

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da9504d329624631fe1a65403ba15f910be18cdb
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250214/57edb5ae/attachment-0001.html>


More information about the ghc-commits mailing list