[Git][ghc/ghc][wip/T24744] 2 commits: Alternate way "Enable static args"

[Serge S. Gulin (@gulin.serge)]

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


Commits:
3edea9e1 by Serge S. Gulin at 2024-11-25T20:34:05+03:00
Alternate way "Enable static args"

- - - - -
02c3c58b by Serge S. Gulin at 2024-11-25T20:35:14+03:00
Remove useless premature optimization

- - - - -


3 changed files:

- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/CodeGen.hs
- compiler/GHC/StgToJS/Monad.hs


Changes:

=====================================
compiler/GHC/StgToJS/Apply.hs
=====================================
@@ -100,25 +100,6 @@ 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
     | [StgLitArg (LitString bs)] <- args
     , Just d <- decodeModifiedUTF8 bs


=====================================
compiler/GHC/StgToJS/CodeGen.hs
=====================================
@@ -59,7 +59,6 @@ import qualified Control.Monad.Trans.State.Strict as State
 import GHC.Utils.Outputable hiding ((<>))
 
 import qualified Data.Set as S
-import Data.List (nub)
 import Data.Monoid
 import Control.Monad
 import System.Directory
@@ -328,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    = nub $ map global_id    global_occs
     let lidents' = map identFS lidents
     CIStaticRefs sr0 <- genStaticRefsRhs rhs
     let sri = filter (`notElem` lidents') sr0


=====================================
compiler/GHC/StgToJS/Monad.hs
=====================================
@@ -153,26 +153,23 @@ 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 }
@@ -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
+              let g = GlobalOcc gid 1
               in go (addToUFM_C inc gids i g) is
 
-  pure $ go emptyUFM (identsS jst)
+  pure $ map global_id $ go emptyUFM $ identsS jst



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/16ebc88f87c729f529d7f5553bf834c6463830db...02c3c58b5491dac950ea14f0243fd869d1671086

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/16ebc88f87c729f529d7f5553bf834c6463830db...02c3c58b5491dac950ea14f0243fd869d1671086
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/20241125/071133b6/attachment-0001.html>