JS: Re-add optimization for literal strings (fixes #23479)

compiler/GHC/StgToJS/Apply.hs

 {-# 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,13 @@ genApp
   -> [StgArg]
   -> G (JStgStat, ExprResult)
 genApp ctx i args
+    -- special cases for JSString literals
+    -- we could handle unpackNBytes# here, but that's probably not common
+    -- enough to warrant a special case
+    | [StgVarArg v] <- args
+    , [top] <- concatMap typex_expr (ctxTarget ctx)
+    , matchVarName "ghcjs-prim" "GHCJS.Prim" "unsafeUnpackJSStringUtf8##" i
+    = (,ExprInline) . (|=) top . app "h$decodeUtf8z" <$> varsForId v
 
     -- let-no-escape
     | Just n <- ctxLneBindingStackSize ctx i