[Git][ghc/ghc][wip/T24744] Add trivial optimizations for `unpackCString` and `unpackCStringUtf8`

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

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


Commits:
e5904575 by Serge S. Gulin at 2024-11-04T15:32:40+11:00
Add trivial optimizations for `unpackCString` and `unpackCStringUtf8`

- - - - -


2 changed files:

- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/Expr.hs


Changes:

=====================================
compiler/GHC/StgToJS/Apply.hs
=====================================
@@ -157,6 +157,24 @@ genApp ctx i args
                , ExprInline
                )
 
+    | [StgLitArg (LitString bs)] <- args
+    , Just d <- decodeModifiedUTF8 bs
+    , idName i == unpackCStringName
+    , [top] <- concatMap typex_expr (ctxTarget ctx)
+    = return
+        ( top |= app "h$toHsStringA" [toJExpr d]
+        , ExprInline
+        )
+
+    | [StgLitArg (LitString bs)] <- args
+    , Just d <- decodeModifiedUTF8 bs
+    , idName i == unpackCStringUtf8Name
+    , [top] <- concatMap typex_expr (ctxTarget ctx)
+    = return
+        ( top |= app "h$toHsString" [toJExpr d]
+        , ExprInline
+        )
+
     -- let-no-escape
     | Just n <- ctxLneBindingStackSize ctx i
     = do


=====================================
compiler/GHC/StgToJS/Expr.hs
=====================================
@@ -606,6 +606,32 @@ genCase ctx bnd e at alts l
              , ExprInline
              )
 
+  | StgLit (LitString bs) <- e
+  , [GenStgAlt DEFAULT _ rhs] <- alts
+  , StgApp i args <- rhs
+  , idName i == unpackCStringName
+  , [StgVarArg b'] <- args
+  , bnd == b'
+  , Just d <- decodeModifiedUTF8 bs
+  , [top] <- concatMap typex_expr (ctxTarget ctx)
+  = return
+      ( top |= app "h$toHsStringA" [toJExpr d]
+      , ExprInline
+      )
+
+  | StgLit (LitString bs) <- e
+  , [GenStgAlt DEFAULT _ rhs] <- alts
+  , StgApp i args <- rhs
+  , idName i == unpackCStringUtf8Name
+  , [StgVarArg b'] <- args
+  , bnd == b'
+  , Just d <- decodeModifiedUTF8 bs
+  , [top] <- concatMap typex_expr (ctxTarget ctx)
+  = return
+      ( top |= app "h$toHsString" [toJExpr d]
+      , ExprInline
+      )
+
   | isInlineExpr e = do
       bndi <- identsForId bnd
       let ctx' = ctxSetTop bnd



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

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