Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
39b2e382 by Cheng Shao at 2025-08-20T11:50:40-04:00
compiler: only use `Name` instead of `Id` in `SptEntry`
As a part of #26298, this patch refactors `SptEntry` to only carry a
`Name` instead of `Id`: we do not care about extra information like
caffyness or type at all in any static pointer related codegen logic.
This is necessary to make `SptEntry` serializable, as a part of the
grand plan of serializable bytecode.
Co-authored-by: Codex
- - - - -
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
=====================================
@@ -2548,9 +2548,9 @@ hscAddSptEntries :: HscEnv -> [SptEntry] -> IO ()
hscAddSptEntries hsc_env entries = do
let interp = hscInterp hsc_env
let add_spt_entry :: SptEntry -> IO ()
- add_spt_entry (SptEntry i fpr) = do
+ add_spt_entry (SptEntry n fpr) = do
-- These are only names from the current module
- (val, _, _) <- loadName interp hsc_env (idName i)
+ (val, _, _) <- loadName interp hsc_env n
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 ( CafInfo(..) )
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)
@@ -256,12 +257,18 @@ sptModuleInitCode platform this_mod entries
init_fn_body = vcat
[ text "static StgWord64 k" <> int i <> text "[2] = "
<> pprFingerprint fp <> semi
+ -- Here we don't have access to IdInfo, so we make a
+ -- conservative assumption that the static closure might be
+ -- CAFfy, hence we pass MayHaveCafRefs when constructing a
+ -- CLabel. Regardless, MayHaveCafRefs/NoCafRefs wouldn't make
+ -- any difference here, they would pretty-print to the same
+ -- foreign stub content.
$$ 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
=====================================
@@ -9,20 +9,35 @@ 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.Ids
import GHC.StgToJS.Literal
import GHC.StgToJS.Types
+import GHC.Utils.Panic (panic)
initStaticPtrs :: [SptEntry] -> G JStgStat
initStaticPtrs ptrs = mconcat <$> mapM initStatic ptrs
where
- initStatic (SptEntry sp_id (Fingerprint w1 w2)) = do
- i <- varForId sp_id
+ -- 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 n = do
+ case nameModule_maybe n of
+ Just m -> do
+ let sym = mkJsSymbol True m (occNameMangledFS (nameOccName n))
+ pure (ValExpr (JVar (name sym)))
+ Nothing ->
+ -- Shouldn't happen for SPT entries
+ panic "varForName: non-external Name in SptEntry"
+
+ initStatic (SptEntry sp_name (Fingerprint w1 w2)) = do
+ i <- varForName sp_name
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,14 +3,13 @@ module GHC.Types.SptEntry
)
where
-import GHC.Types.Var ( Id )
+import GHC.Types.Name ( Name )
import GHC.Fingerprint.Type ( Fingerprint )
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
-
+ ppr (SptEntry n fpr) = ppr n <> colon <+> ppr fpr
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39b2e3823da3ab168aa2b7365f0f27e0...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39b2e3823da3ab168aa2b7365f0f27e0...
You're receiving this email because of your account on gitlab.haskell.org.
