[Git][ghc/ghc][wip/js-staging] Only initialize statics once!

[Sylvain Henry (@hsyl20)]

Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC


Commits:
2a95716a by Sylvain Henry at 2022-10-14T16:32:26+02:00
Only initialize statics once!

- - - - -


1 changed file:

- compiler/GHC/StgToJS/Linker/Linker.hs


Changes:

=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -66,6 +66,8 @@ import qualified GHC.Utils.Ppr as Ppr
 import GHC.Utils.Monad
 import GHC.Utils.TmpFs
 
+import GHC.Types.Unique.Set
+
 import qualified GHC.SysTools.Ar          as Ar
 
 import GHC.Data.FastString
@@ -877,14 +879,16 @@ linkModules mods = (compact_mods, meta)
     --  - rename local variables into shorter ones
     --  - compress initialization data
     -- but we haven't ported it (yet).
-
     compact m = CompactedModuleCode
       { cmc_js_code = mc_js_code m
       , cmc_module  = mc_module m
       , cmc_exports = mc_exports m
       }
 
-    statics = concatMap mc_statics  mods
+    -- common up statics: different bindings may reference the same statics, we
+    -- filter them here to initialize them once
+    statics = nubStaticInfo (concatMap mc_statics mods)
+
     infos   = concatMap mc_closures mods
     meta = mconcat
             -- render metadata as individual statements
@@ -893,6 +897,20 @@ linkModules mods = (compact_mods, meta)
             , mconcat (map (closureInfoStat True) infos)
             ]
 
+-- | Only keep a single StaticInfo with a given name
+nubStaticInfo :: [StaticInfo] -> [StaticInfo]
+nubStaticInfo = go emptyUniqSet
+  where
+    go us = \case
+      []     -> []
+      (x:xs) ->
+        -- only match on siVar. There is no reason for the initializing value to
+        -- be different for the same global name.
+        let name = siVar x
+        in if elementOfUniqSet name us
+          then go us xs
+          else x : go (addOneToUniqSet us name) xs
+
 -- | Initialize a global object.
 --
 -- All global objects have to be declared (staticInfoDecl) first.



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2a95716a5c4133e3fe6c9e1552295823c17e3b49
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/20221014/007bb5bb/attachment-0001.html>