[Git][ghc/ghc][wip/T23479] JS: Re-add optimization for literal strings in genApp (fixes #23479)

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

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


Commits:
db8e813c by Serge S. Gulin at 2024-08-25T19:18:54+03:00
JS: Re-add optimization for literal strings in genApp (fixes #23479)

Based on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10588/

- - - - -


1 changed file:

- compiler/GHC/StgToJS/Apply.hs


Changes:

=====================================
compiler/GHC/StgToJS/Apply.hs
=====================================
@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -51,6 +52,7 @@ import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Types.CostCentre
 import GHC.Types.RepType (mightBeFunTy)
+import GHC.Types.Name (nameModule_maybe, OccName (occNameFS), nameOccName)
 
 import GHC.Stg.Syntax
 
@@ -60,6 +62,8 @@ import GHC.Core.TyCon
 import GHC.Core.DataCon
 import GHC.Core.Type hiding (typeSize)
 
+import GHC.Unit.Module (moduleNameFS, GenModule (moduleName), unitIdString, moduleUnitId)
+
 import GHC.Utils.Misc
 import GHC.Utils.Monad
 import GHC.Utils.Panic
@@ -69,6 +73,7 @@ import GHC.Data.FastString
 import qualified Data.Bits as Bits
 import Data.Monoid
 import Data.Array
+import Data.List (isPrefixOf)
 
 -- | Pre-generated functions for fast Apply.
 -- These are bundled with the RTS.
@@ -86,6 +91,13 @@ rtsApply cfg = jBlock
      , moveRegs2
      ]
 
+matchVarName :: String -> FastString -> FastString -> Id -> Bool
+matchVarName pkg modu occ (idName -> n)
+  | Just m <- nameModule_maybe n =
+    occ  == occNameFS (nameOccName n) &&
+    modu == moduleNameFS (moduleName m) &&
+    pkg `isPrefixOf` unitIdString (moduleUnitId m)
+  | otherwise = False
 
 -- | Generate an application of some args to an Id.
 --
@@ -98,6 +110,23 @@ genApp
   -> [StgArg]
   -> G (JStgStat, ExprResult)
 genApp ctx i args
+    -- 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
+    , matchVarName "base" "GHC.JS.Prim" "unsafeUnpackJSStringUtf8##" i
+    -- 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 "h$decodeUtf8z" <$> varsForId v
 
     -- let-no-escape
     | Just n <- ctxLneBindingStackSize ctx i



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

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