[Git][ghc/ghc][wip/T24744] JS: Specialize unpackCString# CAFs (fixes #24744)
Serge S. Gulin (@gulin.serge)
gitlab at gitlab.haskell.org
Sun Dec 8 18:39:49 UTC 2024
Serge S. Gulin pushed to branch wip/T24744 at Glasgow Haskell Compiler / GHC
Commits:
b519c06b by Serge S. Gulin at 2024-12-08T15:50:26+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
=====================================
@@ -48,6 +48,7 @@ import GHC.Types.ForeignStubs (ForeignStubs (..), getCHeader, getCStub)
import GHC.Types.RepType
import GHC.Types.Id
import GHC.Types.Unique
+import GHC.Types.Unique.FM (nonDetEltsUFM)
import GHC.Data.FastString
import GHC.Utils.Encoding
@@ -60,6 +61,7 @@ import GHC.Utils.Outputable hiding ((<>))
import qualified Data.Set as S
import Data.Monoid
+import Data.List (sortBy)
import Control.Monad
import System.Directory
import System.FilePath
@@ -327,10 +329,12 @@ 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
+ occs <- globalOccs body
+ let lids = global_id <$> (sortBy cmp_cnt $ nonDetEltsUFM occs)
+ -- 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
@@ -361,3 +365,6 @@ genToplevelRhs i rhs = case rhs of
ccId <- costCentreStackLbl cc
emitStatic idt (StaticApp appK eidt $ map StaticObjArg lidents') ccId
return $ (FuncStat eid [] (ll <> upd <> setcc <> body))
+ where
+ cmp_cnt :: GlobalOcc -> GlobalOcc -> Ordering
+ cmp_cnt g1 g2 = compare (global_count g1) (global_count g2)
=====================================
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
=====================================
@@ -45,7 +45,6 @@ import GHC.Data.FastMutInt
import qualified Data.Map as M
import qualified Data.Set as S
-import qualified Data.List as L
runG :: StgToJSConfig -> Module -> UniqFM Id CgStgExpr -> G a -> IO a
runG config m unfloat action = State.evalStateT action =<< initState config m unfloat
@@ -153,32 +152,30 @@ 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 (UniqFM Id GlobalOcc)
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)
+ -- Note that different Idents can map to the same Id (e.g. string payload and string offset idents)
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] -> UniqFM Id GlobalOcc
go gids = \case
- [] -> -- return global Ids used locally sorted by increased use
- L.sortBy cmp_cnt $ nonDetEltsUFM gids
+ [] -> gids
(i:is) ->
-- check if the Id is global
case lookupUFM gidc i of
@@ -186,7 +183,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 $ 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\$$r1 = h\$$decodeUtf8z" T24744.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
=====================================
@@ -6,3 +6,4 @@ testFn:test_val_1
1
1
1
+1
=====================================
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/b519c06b889139f7e24f1e84d2e30461cc6cf4a5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b519c06b889139f7e24f1e84d2e30461cc6cf4a5
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/20241208/3e122a01/attachment-0001.html>
More information about the ghc-commits
mailing list