[Git][ghc/ghc][wip/T24744] 3 commits: JS: Basic cleanup for unused stuff to simplify things.
Serge S. Gulin (@gulin.serge)
gitlab at gitlab.haskell.org
Tue Nov 26 15:09:32 UTC 2024
Serge S. Gulin pushed to branch wip/T24744 at Glasgow Haskell Compiler / GHC
Commits:
ab159771 by Serge S. Gulin at 2024-11-26T17:55:29+03:00
JS: Basic cleanup for unused stuff to simplify things.
1. Make `staticInitStat`, `staticDeclStat`, `allocUnboxedConStatic`, `allocateStaticList`, `jsStaticArg` local to modules.
2. Remove unused `hdRawStr`, `hdStrStr` from Haskell and JavaScript (`h$pstr`, `h$rstr`, `h$str`).
3. Introduce a special type `StaticAppKind` enumeration and `StaticApp` to represent boxed scalar static applications. Originally, StaticThunk supported to pass Maybe when it became Nothing for initializied thunks in an alternatie way but it is not used anymore.
- - - - -
4f4ad9d6 by Serge S. Gulin at 2024-11-26T17:56:17+03:00
JS: Add trivial optimizations for `unpackCString` and `unpackCStringUtf8`.
It became possible due of introduction strings unfloating at Sinker pass (#13185). Earns few more bytes at optimizations.
- - - - -
59a558d7 by Serge S. Gulin at 2024-11-26T17:56:17+03:00
JS: Specialize unpackCString# CAFs (fixes #24744)
Code analysis shown that such optimization would be possible out of the box if `cachedIdentForId` allowed to do that for Haskell `Id`s which are represented by few JavaScript `Ident`s. It is a usual for strings which are represented at JavaScript as a pair of 2 values: the string content and the offset where to start reading actual string from the full content. Usually offset is 0 but technically we need to allow such complex structures to be treated as "global".
Enabling it there shown that `genToplevelRhs` and `globalOccs` had inaccuracies in their implementations:
1. `globalOccs` operated over JavaScript's `Ident`s but for complex structures it didn't pay attention to the fact that different Idents actually could be pointed to same Id. Now the algo is changed to calculate occurencies for Ids.
2. `genToplevelRhs` didn't assume that different Idents pointed to same Id can have mixed order of occurence. But actually the order is important. Strings are encoded into 2 variables where first is content and second is offset and their order are not interchangeable. It is fixed by regeneration Idents from collected Ids which is fine because all Idents generation is passed through the Cache and they are quasi-stable.
- - - - -
17 changed files:
- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/Arg.hs
- compiler/GHC/StgToJS/CodeGen.hs
- compiler/GHC/StgToJS/Expr.hs
- compiler/GHC/StgToJS/Ids.hs
- compiler/GHC/StgToJS/Linker/Linker.hs
- compiler/GHC/StgToJS/Monad.hs
- compiler/GHC/StgToJS/Object.hs
- compiler/GHC/StgToJS/Symbols.hs
- compiler/GHC/StgToJS/Types.hs
- rts/js/string.js
- 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,7 +100,7 @@ genApp
-> [StgArg]
-> G (JStgStat, ExprResult)
genApp ctx i args
- -- Test case T23479_2
+ -- Test case moved to T24744
-- 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.
@@ -119,7 +119,7 @@ genApp ctx i args
, [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
@@ -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/Arg.hs
=====================================
@@ -22,9 +22,6 @@ module GHC.StgToJS.Arg
, genIdArgI
, genIdStackArgI
, allocConStatic
- , allocUnboxedConStatic
- , allocateStaticList
- , jsStaticArg
, jsStaticArgs
)
where
@@ -215,7 +212,7 @@ allocConStatic (identFS -> to) cc con args = do
emitStatic to (StaticUnboxed $ StaticUnboxedBool True) cc'
| otherwise = do
e <- identFS <$> identForDataConWorker con
- emitStatic to (StaticData e []) cc'
+ emitStatic to (StaticScalar $ StaticApp SAKData e []) cc'
allocConStatic' cc' [x]
| isUnboxableCon con =
case x of
@@ -234,7 +231,7 @@ allocConStatic (identFS -> to) cc con args = do
_ -> panic "allocConStatic: invalid args for consDataCon"
else do
e <- identFS <$> identForDataConWorker con
- emitStatic to (StaticData e xs) cc'
+ emitStatic to (StaticScalar $ StaticApp SAKData e xs) cc'
-- | Allocate unboxed constructors
allocUnboxedConStatic :: DataCon -> [StaticArg] -> StaticArg
=====================================
compiler/GHC/StgToJS/CodeGen.hs
=====================================
@@ -327,25 +327,26 @@ 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
sr = CIStaticRefs sri
et <- genEntryType args
ll <- loadLiveFun lids
- (static, regs, upd) <-
+ (appK, regs, upd) <-
if et == CIThunk
then do
r <- updateThunk
- pure (StaticThunk (Just (eidt, map StaticObjArg lidents')), CIRegs 0 [PtrV],r)
- else return (StaticFun eidt (map StaticObjArg lidents'),
- (if null lidents then CIRegs 1 (concatMap idJSRep args)
- else CIRegs 0 (PtrV : concatMap idJSRep args))
- , mempty)
+ pure (SAKThunk, CIRegs 0 [PtrV], r)
+ else
+ let regs = if null lidents then CIRegs 1 (concatMap idJSRep args)
+ else CIRegs 0 (PtrV : concatMap idJSRep args)
+ in pure (SAKFun, regs, mempty)
setcc <- ifProfiling $
if et == CIThunk
then enterCostCentreThunk
@@ -359,5 +360,5 @@ genToplevelRhs i rhs = case rhs of
, ciStatic = sr
}
ccId <- costCentreStackLbl cc
- emitStatic idt static ccId
+ emitStatic idt (StaticScalar $ StaticApp appK eidt $ map StaticObjArg lidents') ccId
return $ (FuncStat eid [] (ll <> upd <> setcc <> body))
=====================================
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
=====================================
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/Linker/Linker.hs
=====================================
@@ -24,8 +24,6 @@ module GHC.StgToJS.Linker.Linker
( jsLinkBinary
, jsLink
, embedJsFile
- , staticInitStat
- , staticDeclStat
, mkExportedFuns
, mkExportedModFuns
, computeLinkDependencies
@@ -1253,27 +1251,22 @@ staticInitStat :: StaticInfo -> JS.JStat
staticInitStat (StaticInfo i sv mcc) =
jStgStatToJS $
case sv of
- StaticData con args -> appS hdStiStr $ add_cc_arg
- [ global i
- , global con
- , jsStaticArgs args
- ]
- StaticFun f args -> appS hdStiStr $ add_cc_arg
- [ global i
- , global f
- , jsStaticArgs args
- ]
- StaticList args mt -> appS hdStlStr $ add_cc_arg
- [ global i
- , jsStaticArgs args
- , toJExpr $ maybe null_ (toJExpr . TxtI) mt
- ]
- StaticThunk (Just (f,args)) -> appS hdStcStr $ add_cc_arg
- [ global i
- , global f
- , jsStaticArgs args
- ]
- _ -> mempty
+ StaticScalar (StaticApp k app args) -> appS
+ (if k == SAKThunk then hdStcStr else hdStiStr)
+ $ add_cc_arg
+ [ global i
+ , global app
+ , jsStaticArgs args
+ ]
+
+ StaticList args mt -> appS hdStlStr
+ $ add_cc_arg
+ [ global i
+ , jsStaticArgs args
+ , toJExpr $ maybe null_ (toJExpr . TxtI) mt
+ ]
+
+ StaticUnboxed _ -> mempty
where
-- add optional cost-center argument
add_cc_arg as = case mcc of
@@ -1286,20 +1279,15 @@ staticDeclStat (StaticInfo global_name static_value _) = jStgStatToJS decl
where
global_ident = name global_name
decl_init v = global_ident ||= v
- decl_no_init = appS hdDiStr [toJExpr global_ident]
decl = case static_value of
StaticUnboxed u -> decl_init (unboxed_expr u)
- StaticThunk Nothing -> decl_no_init -- CAF initialized in an alternative way
_ -> decl_init (app hdDStr [])
unboxed_expr = \case
StaticUnboxedBool b -> app hdPStr [toJExpr b]
StaticUnboxedInt i -> app hdPStr [toJExpr i]
StaticUnboxedDouble d -> app hdPStr [toJExpr (unSaneDouble d)]
- -- GHCJS used a function wrapper for this:
- -- StaticUnboxedString str -> ApplExpr (initStr str) []
- -- But we are defining it statically for now.
StaticUnboxedString str -> initStr str
StaticUnboxedStringOffset {} -> 0
=====================================
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
=====================================
compiler/GHC/StgToJS/Object.hs
=====================================
@@ -615,16 +615,16 @@ instance Binary StaticInfo where
get bh = StaticInfo <$> get bh <*> get bh <*> get bh
instance Binary StaticVal where
- put_ bh (StaticFun f args) = putByte bh 1 >> put_ bh f >> put_ bh args
- put_ bh (StaticThunk t) = putByte bh 2 >> put_ bh t
- put_ bh (StaticUnboxed u) = putByte bh 3 >> put_ bh u
- put_ bh (StaticData dc args) = putByte bh 4 >> put_ bh dc >> put_ bh args
- put_ bh (StaticList xs t) = putByte bh 5 >> put_ bh xs >> put_ bh t
+ put_ bh (StaticScalar (StaticApp SAKFun f args)) = putByte bh 1 >> put_ bh f >> put_ bh args
+ put_ bh (StaticScalar (StaticApp SAKThunk f args)) = putByte bh 2 >> put_ bh f >> put_ bh args
+ put_ bh (StaticUnboxed u) = putByte bh 3 >> put_ bh u
+ put_ bh (StaticScalar (StaticApp SAKData dc args)) = putByte bh 4 >> put_ bh dc >> put_ bh args
+ put_ bh (StaticList xs t) = putByte bh 5 >> put_ bh xs >> put_ bh t
get bh = getByte bh >>= \case
- 1 -> StaticFun <$> get bh <*> get bh
- 2 -> StaticThunk <$> get bh
+ 1 -> StaticScalar <$> (StaticApp SAKFun <$> get bh <*> get bh)
+ 2 -> StaticScalar <$> (StaticApp SAKThunk <$> get bh <*> get bh)
3 -> StaticUnboxed <$> get bh
- 4 -> StaticData <$> get bh <*> get bh
+ 4 -> StaticScalar <$> (StaticApp SAKData <$> get bh <*> get bh)
5 -> StaticList <$> get bh <*> get bh
n -> error ("Binary get bh StaticVal: invalid tag " ++ show n)
=====================================
compiler/GHC/StgToJS/Symbols.hs
=====================================
@@ -849,9 +849,6 @@ unknown = fsLit "<unknown>"
typeof :: FastString
typeof = fsLit "typeof"
-hdRawStr :: FastString
-hdRawStr = fsLit "h$rstr"
-
throwStr :: FastString
throwStr = fsLit "throw"
@@ -1213,8 +1210,6 @@ hdStlStr = fsLit "h$stl"
hdStiStr :: FastString
hdStiStr = fsLit "h$sti"
-hdStrStr :: FastString
-hdStrStr = fsLit "h$str"
------------------------------ Pack/Unpack --------------------------------------------
hdDecodeUtf8Z :: FastString
=====================================
compiler/GHC/StgToJS/Types.hs
=====================================
@@ -231,18 +231,25 @@ data StaticInfo = StaticInfo
, siCC :: !(Maybe Ident) -- ^ optional CCS name
} deriving stock (Eq, Show)
+data StaticAppKind
+ = SAKFun
+ -- ^ heap object for function
+ | SAKThunk
+ -- ^ heap object for CAF
+ | SAKData
+ -- ^ regular datacon app
+ deriving stock (Eq, Show)
+
+-- Static scalar application
+data StaticApp = StaticApp StaticAppKind !FastString [StaticArg]
+ deriving stock (Eq, Show)
+
data StaticVal
- = StaticFun !FastString [StaticArg]
- -- ^ heap object for function
- | StaticThunk !(Maybe (FastString,[StaticArg]))
- -- ^ heap object for CAF (field is Nothing when thunk is initialized in an
- -- alternative way, like string thunks through h$str)
- | StaticUnboxed !StaticUnboxed
+ = StaticUnboxed !StaticUnboxed
-- ^ unboxed constructor (Bool, Int, Double etc)
- | StaticData !FastString [StaticArg]
- -- ^ regular datacon app
| StaticList [StaticArg] (Maybe FastString)
-- ^ list initializer (with optional tail)
+ | StaticScalar StaticApp
deriving stock (Eq, Show)
data StaticUnboxed
=====================================
rts/js/string.js
=====================================
@@ -1,53 +1,5 @@
//#OPTIONS: CPP
-// encode a string constant
-function h$str(s) {
- var enc = null;
- return function() {
- if(enc === null) {
- enc = h$encodeModifiedUtf8(s);
- }
- return enc;
- }
-}
-
-// encode a packed string
-// since \0 is used to separate strings (and a common occurrence)
-// we add the following mapping:
-// - \0 -> \cz\0
-// - \cz -> \cz\cz
-//
-// decoding to bytes, the following is produced:
-// - \cz\0 -> C0 80
-// - \cz\cz -> 1A
-//
-// additionally, for dealing with raw binary data we have an escape sequence
-// to pack base64 encoded runs:
-//
-// - \cz\xNN -> followed by NN-0x1f (31 decimal) bytes of base64 encoded
-// data. supported range: 0x20 .. 0x9f (1-128 bytes data)
-//
-
-function h$pstr(s) {
- var enc = null;
- return function() {
- if(enc === null) {
- enc = h$encodePackedUtf8(s);
- }
- return enc;
- }
-}
-// encode a raw string from bytes
-function h$rstr(d) {
- var enc = null;
- return function() {
- if(enc === null) {
- enc = h$rawStringData(d);
- }
- return enc;
- }
-}
-
// these aren't added to the CAFs, so the list stays in mem indefinitely, is that a problem?
#ifdef GHCJS_PROF
function h$strt(str, cc) { return MK_LAZY_CC(function() { return h$toHsString(str, cc); }, cc); }
@@ -265,10 +217,27 @@ function h$encodeUtf8(str) {
return h$encodeUtf8Internal(str, false, false);
}
+// encode a string constant
function h$encodeModifiedUtf8(str) {
return h$encodeUtf8Internal(str, true, false);
}
+// encode a packed string
+// since \0 is used to separate strings (and a common occurrence)
+// we add the following mapping:
+// - \0 -> \cz\0
+// - \cz -> \cz\cz
+//
+// decoding to bytes, the following is produced:
+// - \cz\0 -> C0 80
+// - \cz\cz -> 1A
+//
+// additionally, for dealing with raw binary data we have an escape sequence
+// to pack base64 encoded runs:
+//
+// - \cz\xNN -> followed by NN-0x1f (31 decimal) bytes of base64 encoded
+// data. supported range: 0x20 .. 0x9f (1-128 bytes data)
+//
function h$encodePackedUtf8(str) {
return h$encodeUtf8Internal(str, false, true);
}
@@ -759,6 +728,30 @@ function h$appendToHsStringA(str, appendTo) {
return r;
}
+// unpack utf8 string, append to existing Haskell string
+#ifdef GHCJS_PROF
+function h$appendToHsString(str, appendTo, cc) {
+#else
+function h$appendToHsString(str, appendTo) {
+#endif
+ var i = str.length - 1;
+ // we need to make an updatable thunk here
+ // if we embed the given closure in a CONS cell.
+ // (#24495)
+ var r = i == 0 ? appendTo : MK_UPD_THUNK(appendTo);
+ while(i>=0) {
+ // Copied from h$toHsString
+ var cp = str.charCodeAt(i);
+ if(cp >= 0xDC00 && cp <= 0xDFFF && i > 0) {
+ --i;
+ cp = (cp - 0xDC00) + (str.charCodeAt(i) - 0xD800) * 1024 + 0x10000;
+ }
+ r = MK_CONS_CC(cp, r, cc);
+ --i;
+ }
+ return r;
+}
+
// throw e wrapped in a GHCJS.Prim.JSException in the current thread
function h$throwJSException(e) {
// create a JSException object and wrap it in a SomeException
=====================================
testsuite/tests/javascript/Makefile
=====================================
@@ -13,20 +13,21 @@ 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/8503e8b9c550899761a725cf51c66809a1f74e3b...59a558d7280723d4c6149ec331baca069f044f93
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8503e8b9c550899761a725cf51c66809a1f74e3b...59a558d7280723d4c6149ec331baca069f044f93
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/c3119845/attachment-0001.html>
More information about the ghc-commits
mailing list