GitLab

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 <codex@openai.com>

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