[Git][ghc/ghc][wip/T24744] 3 commits: Enable static args

Serge S. Gulin (@gulin.serge) gitlab at gitlab.haskell.org
Tue Nov 26 09:41:29 UTC 2024



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


Commits:
b9f928f4 by Serge S. Gulin at 2024-11-26T12:40:57+03:00
Enable static args

- - - - -
be43cbca by Serge S. Gulin at 2024-11-26T12:41:07+03:00
Remove useless premature optimization

- - - - -
8503e8b9 by Serge S. Gulin at 2024-11-26T12:41:07+03:00
Fix tests

- - - - -


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,26 +100,7 @@ genApp
   -> [StgArg]
   -> G (JStgStat, ExprResult)
 genApp ctx i args
-    -- Test case T23479_2
-    -- 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.
-    -- We could handle unpackNBytes# here, but that's probably not common
-    -- enough to warrant a special case.
-    -- See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10588/#note_503978
-    -- Comment by Jeffrey Young  <jeffrey.young at iohk.io>
-    -- We detect if the Id is unsafeUnpackJSStringUtf8## applied to a string literal,
-    -- if so then we convert the unsafeUnpack to a call to h$decode.
-    | [StgVarArg v] <- args
-    , idName i == unsafeUnpackJSStringUtf8ShShName
-    -- See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10588
-    -- Comment by Josh Meredith  <josh.meredith at iohk.io>
-    -- `typex_expr` can throw an error for certain bindings so it's important
-    -- that this condition comes after matching on the function name
-    , [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,20 @@ 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/-/compare/5d0d86f7a331238df51794b733a47277720ab04c...8503e8b9c550899761a725cf51c66809a1f74e3b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d0d86f7a331238df51794b733a47277720ab04c...8503e8b9c550899761a725cf51c66809a1f74e3b
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/20241126/d33f95cd/attachment-0001.html>


More information about the ghc-commits mailing list