[Git][ghc/ghc][wip/T24744] JS: Specialize unpackCString# CAFs (fixes #24744)

Serge S. Gulin (@gulin.serge) gitlab at gitlab.haskell.org
Wed Nov 27 06:01:47 UTC 2024



Serge S. Gulin pushed to branch wip/T24744 at Glasgow Haskell Compiler / GHC


Commits:
a420e23f by Serge S. Gulin at 2024-11-27T09:01:25+03:00
JS: Specialize unpackCString# CAFs (fixes #24744)

Code analysis shown that such optimization would be possible out of the box if `cachedIdentForId` allowed to do that for Haskell `Id`s which are represented by few JavaScript `Ident`s. It is a usual for strings which are represented at JavaScript as a pair of 2 values: the string content and the offset where to start reading actual string from the full content. Usually offset is 0 but technically we need to allow such complex structures to be treated as "global".

Enabling it there shown that `genToplevelRhs` and `globalOccs` had inaccuracies in their implementations:
1. `globalOccs` operated over JavaScript's `Ident`s but for complex structures it didn't pay attention to the fact that different Idents actually could be pointed to same Id. Now the algo is changed to calculate occurencies for Ids.
2. `genToplevelRhs` didn't assume that different Idents pointed to same Id can have mixed order of occurence. But actually the order is important. Strings are encoded into 2 variables where first is content and second is offset and their order are not interchangeable. It is fixed by regeneration Idents from collected Ids which is fine because all Idents generation is passed through the Cache and they are quasi-stable.

- - - - -


10 changed files:

- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/CodeGen.hs
- compiler/GHC/StgToJS/Ids.hs
- compiler/GHC/StgToJS/Monad.hs
- testsuite/tests/javascript/Makefile
- testsuite/tests/javascript/T23479_1.hs → testsuite/tests/javascript/T23479.hs
- testsuite/tests/javascript/T23479_1.stdout → testsuite/tests/javascript/T23479.stdout
- testsuite/tests/javascript/T23479_2.hs → testsuite/tests/javascript/T24744.hs
- testsuite/tests/javascript/T23479_2.stdout → testsuite/tests/javascript/T24744.stdout
- testsuite/tests/javascript/all.T


Changes:

=====================================
compiler/GHC/StgToJS/Apply.hs
=====================================
@@ -100,7 +100,7 @@ genApp
   -> [StgArg]
   -> G (JStgStat, ExprResult)
 genApp ctx i args
-    -- Test case T23479_2
+    -- Test case moved to T24744
     -- See: https://github.com/ghcjs/ghcjs/blob/b7711fbca7c3f43a61f1dba526e6f2a2656ef44c/src/Gen2/Generator.hs#L876
     -- Comment by Luite Stegeman <luite.stegeman at iohk.io>
     -- Special cases for JSString literals.
@@ -119,7 +119,7 @@ genApp ctx i args
     , [top] <- concatMap typex_expr (ctxTarget ctx)
     = (,ExprInline) . (|=) top . app hdDecodeUtf8Z <$> varsForId v
 
-    -- Test case T23479_1
+    -- Test case T23479
     | [StgLitArg (LitString bs)] <- args
     , Just d <- decodeModifiedUTF8 bs
     , idName i == unsafeUnpackJSStringUtf8ShShName


=====================================
compiler/GHC/StgToJS/CodeGen.hs
=====================================
@@ -327,10 +327,11 @@ genToplevelRhs i rhs = case rhs of
     eid  <- identForEntryId i
     idt  <- identFS <$> identForId i
     body <- genBody (initExprCtx i) R2 args body typ
-    global_occs <- globalOccs body
+    lids <- globalOccs body
+    -- Regenerate idents from lids to restore right order of representatives.
+    -- Representatives have occurrence order which can be mixed.
+    lidents <- concat <$> traverse identsForId lids
     let eidt = identFS eid
-    let lidents = map global_ident global_occs
-    let lids    = map global_id    global_occs
     let lidents' = map identFS lidents
     CIStaticRefs sr0 <- genStaticRefsRhs rhs
     let sri = filter (`notElem` lidents') sr0


=====================================
compiler/GHC/StgToJS/Ids.hs
=====================================
@@ -155,7 +155,7 @@ cachedIdentForId i mi id_type = do
 
   -- Now update the GlobalId cache, if required
 
-  let update_global_cache = isGlobalId i && isNothing mi && id_type == IdPlain
+  let update_global_cache = isGlobalId i && id_type == IdPlain
       -- fixme also allow caching entries for lifting?
 
   when (update_global_cache) $ do


=====================================
compiler/GHC/StgToJS/Monad.hs
=====================================
@@ -153,29 +153,28 @@ getGlobalIdCache = State.gets (ggsGlobalIdCache . gsGroup)
 setGlobalIdCache :: GlobalIdCache -> G ()
 setGlobalIdCache v = State.modify (\s -> s { gsGroup = (gsGroup s) { ggsGlobalIdCache = v}})
 
-
 data GlobalOcc = GlobalOcc
-  { global_ident :: !Ident
-  , global_id    :: !Id
+  { global_id    :: !Id
   , global_count :: !Word
   }
 
 instance Outputable GlobalOcc where
   ppr g = hang (text "GlobalOcc") 2 $ vcat
-            [ hcat [text "Ident: ", ppr (global_ident g)]
-            , hcat [text "Id:", ppr (global_id g)]
+            [ hcat [text "Id:", ppr (global_id g)]
             , hcat [text "Count:", ppr (global_count g)]
             ]
 
--- | Return number of occurrences of every global id used in the given JStgStat.
+-- | Return occurrences of every global id used in the given JStgStat.
 -- Sort by increasing occurrence count.
-globalOccs :: JStgStat -> G [GlobalOcc]
+globalOccs :: JStgStat -> G [Id]
 globalOccs jst = do
   GlobalIdCache gidc <- getGlobalIdCache
-  -- build a map form Ident Unique to (Ident, Id, Count)
+  -- build a map form Ident Unique to (Id, Count)
   let
     cmp_cnt g1 g2 = compare (global_count g1) (global_count g2)
     inc g1 g2 = g1 { global_count = global_count g1 + global_count g2 }
+
+    go :: UniqFM Id GlobalOcc -> [Ident] -> [GlobalOcc]
     go gids = \case
         []     -> -- return global Ids used locally sorted by increased use
                   L.sortBy cmp_cnt $ nonDetEltsUFM gids
@@ -186,7 +185,7 @@ globalOccs jst = do
             Just (_k,gid) ->
               -- add it to the list of already found global ids. Increasing
               -- count by 1
-              let g = GlobalOcc i gid 1
-              in go (addToUFM_C inc gids i g) is
+              let g = GlobalOcc gid 1
+              in go (addToUFM_C inc gids gid g) is
 
-  pure $ go emptyUFM (identsS jst)
+  pure $ map global_id $ go emptyUFM $ identsS jst


=====================================
testsuite/tests/javascript/Makefile
=====================================
@@ -13,20 +13,21 @@ T24495:
 	# check that the optimization occurred for -02 1 time (1 for unfloated lits)
 	grep -c appendToHsStringA T24495.dump-js
 
-T23479_1:
-	'$(TEST_HC)' $(TEST_HC_OPTS) T23479_1.hs -v0 -O2 -dsuppress-uniques -ddump-js -ddump-to-file
-	./T23479_1
+T23479:
+	'$(TEST_HC)' $(TEST_HC_OPTS) T23479.hs -v0 -O2 -dsuppress-uniques -ddump-js -ddump-to-file
+	./T23479
 	# check that the optimization occurred
-	grep -c "h\$$r1 = \"test_val_1\"" T23479_1.dump-js
-	grep -c "h\$$r1 = \"test_val_2\"" T23479_1.dump-js
-	grep -c "h\$$r1 = \"test_val_3\"" T23479_1.dump-js
-	grep -c "h\$$r1 = \"test_val_80_local" T23479_1.dump-js
-	grep -c "h\$$r1 = \"test_val_80_global" T23479_1.dump-js || true
+	grep -c "h\$$r1 = \"test_val_1\"" T23479.dump-js
+	grep -c "h\$$r1 = \"test_val_2\"" T23479.dump-js
+	grep -c "h\$$r1 = \"test_val_3\"" T23479.dump-js
+	grep -c "h\$$r1 = \"test_val_80_local" T23479.dump-js
+	grep -c "h\$$r1 = \"test_val_80_global" T23479.dump-js || true
 
-T23479_2:
-	'$(TEST_HC)' $(TEST_HC_OPTS) T23479_2.hs -v0 -O2 -dsuppress-uniques -ddump-js -ddump-to-file
-	./T23479_2
-	grep -c "h\$$r1 = \"test_val_1\"" T23479_2.dump-js
-	grep -c "h\$$r1 = \"test_val_80_local_once" T23479_2.dump-js
+T24744:
+	'$(TEST_HC)' $(TEST_HC_OPTS) T24744.hs -v0 -O2 -dsuppress-uniques -ddump-js -ddump-to-file
+	./T24744
+	grep -c "h\$$r1 = \"test_val_1\"" T24744.dump-js
+	grep -c "h\$$r1 = \"test_val_80_local_once" T24744.dump-js
 	# check that the optimization occurred
 	grep -c "h\$$r1 = h\$$decodeUtf8z" T23479_2.dump-js
+	grep -c "h\$$stc(h\$$mainZCMainzitestzuvalzu80zulocal,h\$$mainZCMainzitestzuvalzu80zulocal_e,\[h\$$ghczmprimZCGHCziCStringziunpackCStringzh,h\$$mainZCMainzimain7_1,h\$$mainZCMainzimain7_2\])" T24744.jsexe/out.js


=====================================
testsuite/tests/javascript/T23479_1.hs → testsuite/tests/javascript/T23479.hs
=====================================


=====================================
testsuite/tests/javascript/T23479_1.stdout → testsuite/tests/javascript/T23479.stdout
=====================================


=====================================
testsuite/tests/javascript/T23479_2.hs → testsuite/tests/javascript/T24744.hs
=====================================


=====================================
testsuite/tests/javascript/T23479_2.stdout → testsuite/tests/javascript/T24744.stdout
=====================================


=====================================
testsuite/tests/javascript/all.T
=====================================
@@ -23,5 +23,5 @@ test('T22455', normal, compile_and_run, ['-ddisable-js-minifier'])
 test('T23565', normal, compile_and_run, [''])
 test('T24495', normal, makefile_test, ['T24495'])
 
-test('T23479_1', normal, makefile_test, ['T23479_1'])
-test('T23479_2', normal, makefile_test, ['T23479_2'])
+test('T23479', normal, makefile_test, ['T23479'])
+test('T24744', normal, makefile_test, ['T24744'])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a420e23fbc4874e8dadd7794d7163a2c89a1e442
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/20241127/b04ae0a0/attachment-0001.html>


More information about the ghc-commits mailing list