Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
91edd292 by Wolfgang Jeltsch at 2025-12-19T03:18:19-05:00
Remove unused known-key and name variables for generics
This removes the known-key and corresponding name variables for `K1`,
`M1`, `R`, `D`, `C`, `S`, and `URec` from `GHC.Generics`, as they are
apparently nowhere used in GHC’s source code.
- - - - -
73ee7e38 by Wolfgang Jeltsch at 2025-12-19T03:19:02-05:00
Remove unused known keys and names for generics classes
This removes the known-key and corresponding name variables for
`Datatype`, `Constructor`, and `Selector` from `GHC.Generics`, as they
are apparently nowhere used in GHC’s source code.
- - - - -
f69c5f14 by Cheng Shao at 2025-12-19T03:19:45-05:00
wasm: fix handling of ByteArray#/MutableByteArray# arguments in JSFFI imports
This patch fixes the handling of ByteArray#/MutableByteArray#
arguments in JSFFI imports, see the amended note and manual for
explanation. Also adds a test to witness the fix.
Co-authored-by: Codex
- - - - -
4011f64c by Cheng Shao at 2025-12-19T17:46:21-05:00
rts: workaround -Werror=maybe-uninitialized false positives
In some cases gcc might report -Werror=maybe-uninitialized that we
know are false positives, but need to workaround it to make validate
builds with -Werror pass.
- - - - -
bb3c938f by Cheng Shao at 2025-12-19T17:46:21-05:00
hadrian: use -Og as C/C++ optimization level when debugging
This commit enables -Og as optimization level when compiling the debug
ways of rts. According to gcc documentation
(https://gcc.gnu.org/onlinedocs/gcc/Optimize-Options.html#index-Og),
-Og is a better choice than -O0 for producing debuggable code. It's
also supported by clang as well, so it makes sense to use it as a
default for debugging. Also add missing -g3 flag to C++ compilation
flags in +debug_info flavour transformer.
- - - - -
f5507684 by Cheng Shao at 2025-12-19T17:46:22-05:00
compiler: replace DList with OrdList
This patch removes `DList` logic from the compiler and replaces it
with `OrdList` which also supports O(1) concatenation and should be
more memory efficient than the church-encoded `DList`.
- - - - -
14 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/HsToCore/Foreign/Wasm.hs
- compiler/GHC/Parser/String.hs
- compiler/GHC/StgToCmm/InfoTableProv.hs
- docs/users_guide/wasm.rst
- hadrian/src/Flavour.hs
- hadrian/src/Settings/Packages.hs
- rts/linker/InitFini.c
- rts/sm/Sanity.c
- testsuite/tests/jsffi/all.T
- + testsuite/tests/jsffi/bytearrayarg.hs
- + testsuite/tests/jsffi/bytearrayarg.mjs
- + testsuite/tests/jsffi/bytearrayarg.stdout
- testsuite/tests/perf/should_run/all.T
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -476,7 +476,6 @@ basicKnownKeyNames
-- Generics
, genClassName, gen1ClassName
- , datatypeClassName, constructorClassName, selectorClassName
-- Monad comprehensions
, guardMName
@@ -517,12 +516,9 @@ basicKnownKeyNames
genericTyConNames :: [Name]
genericTyConNames = [
- v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
- k1TyConName, m1TyConName, sumTyConName, prodTyConName,
- compTyConName, rTyConName, dTyConName,
- cTyConName, sTyConName, rec0TyConName,
- d1TyConName, c1TyConName, s1TyConName,
- repTyConName, rep1TyConName, uRecTyConName,
+ v1TyConName, u1TyConName, par1TyConName, rec1TyConName, sumTyConName,
+ prodTyConName, compTyConName, rec0TyConName, d1TyConName, c1TyConName,
+ s1TyConName, repTyConName, rep1TyConName,
uAddrTyConName, uCharTyConName, uDoubleTyConName,
uFloatTyConName, uIntTyConName, uWordTyConName,
prefixIDataConName, infixIDataConName, leftAssociativeDataConName,
@@ -939,11 +935,8 @@ voidTyConName = tcQual gHC_INTERNAL_BASE (fsLit "Void") voidTyConKey
-- Generics (types)
v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
- k1TyConName, m1TyConName, sumTyConName, prodTyConName,
- compTyConName, rTyConName, dTyConName,
- cTyConName, sTyConName, rec0TyConName,
- d1TyConName, c1TyConName, s1TyConName,
- repTyConName, rep1TyConName, uRecTyConName,
+ sumTyConName, prodTyConName, compTyConName, rec0TyConName, d1TyConName,
+ c1TyConName, s1TyConName, repTyConName, rep1TyConName,
uAddrTyConName, uCharTyConName, uDoubleTyConName,
uFloatTyConName, uIntTyConName, uWordTyConName,
prefixIDataConName, infixIDataConName, leftAssociativeDataConName,
@@ -958,18 +951,11 @@ v1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "V1") v1TyConKey
u1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "U1") u1TyConKey
par1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Par1") par1TyConKey
rec1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rec1") rec1TyConKey
-k1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "K1") k1TyConKey
-m1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "M1") m1TyConKey
sumTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit ":+:") sumTyConKey
prodTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit ":*:") prodTyConKey
compTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit ":.:") compTyConKey
-rTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "R") rTyConKey
-dTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "D") dTyConKey
-cTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "C") cTyConKey
-sTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "S") sTyConKey
-
rec0TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rec0") rec0TyConKey
d1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "D1") d1TyConKey
c1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "C1") c1TyConKey
@@ -978,7 +964,6 @@ s1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "S1") s1TyConKey
repTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rep") repTyConKey
rep1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rep1") rep1TyConKey
-uRecTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "URec") uRecTyConKey
uAddrTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "UAddr") uAddrTyConKey
uCharTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "UChar") uCharTyConKey
uDoubleTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "UDouble") uDoubleTyConKey
@@ -1494,15 +1479,10 @@ readClassName :: Name
readClassName = clsQual gHC_INTERNAL_READ (fsLit "Read") readClassKey
-- Classes Generic and Generic1, Datatype, Constructor and Selector
-genClassName, gen1ClassName, datatypeClassName, constructorClassName,
- selectorClassName :: Name
+genClassName, gen1ClassName :: Name
genClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Generic") genClassKey
gen1ClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Generic1") gen1ClassKey
-datatypeClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Datatype") datatypeClassKey
-constructorClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Constructor") constructorClassKey
-selectorClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Selector") selectorClassKey
-
genericClassNames :: [Name]
genericClassNames = [genClassName, gen1ClassName]
@@ -1753,15 +1733,10 @@ applicativeClassKey = mkPreludeClassUnique 34
foldableClassKey = mkPreludeClassUnique 35
traversableClassKey = mkPreludeClassUnique 36
-genClassKey, gen1ClassKey, datatypeClassKey, constructorClassKey,
- selectorClassKey :: Unique
+genClassKey, gen1ClassKey :: Unique
genClassKey = mkPreludeClassUnique 37
gen1ClassKey = mkPreludeClassUnique 38
-datatypeClassKey = mkPreludeClassUnique 39
-constructorClassKey = mkPreludeClassUnique 40
-selectorClassKey = mkPreludeClassUnique 41
-
-- KnownNat: see Note [KnownNat & KnownSymbol and EvLit] in GHC.Tc.Instance.Class
knownNatClassNameKey :: Unique
knownNatClassNameKey = mkPreludeClassUnique 42
@@ -1950,11 +1925,8 @@ typeLitSortTyConKey = mkPreludeTyConUnique 108
-- Generics (Unique keys)
v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey,
- k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey,
- compTyConKey, rTyConKey, dTyConKey,
- cTyConKey, sTyConKey, rec0TyConKey,
- d1TyConKey, c1TyConKey, s1TyConKey,
- repTyConKey, rep1TyConKey, uRecTyConKey,
+ sumTyConKey, prodTyConKey, compTyConKey, rec0TyConKey,
+ d1TyConKey, c1TyConKey, s1TyConKey, repTyConKey, rep1TyConKey,
uAddrTyConKey, uCharTyConKey, uDoubleTyConKey,
uFloatTyConKey, uIntTyConKey, uWordTyConKey :: Unique
@@ -1962,18 +1934,11 @@ v1TyConKey = mkPreludeTyConUnique 135
u1TyConKey = mkPreludeTyConUnique 136
par1TyConKey = mkPreludeTyConUnique 137
rec1TyConKey = mkPreludeTyConUnique 138
-k1TyConKey = mkPreludeTyConUnique 139
-m1TyConKey = mkPreludeTyConUnique 140
sumTyConKey = mkPreludeTyConUnique 141
prodTyConKey = mkPreludeTyConUnique 142
compTyConKey = mkPreludeTyConUnique 143
-rTyConKey = mkPreludeTyConUnique 144
-dTyConKey = mkPreludeTyConUnique 146
-cTyConKey = mkPreludeTyConUnique 147
-sTyConKey = mkPreludeTyConUnique 148
-
rec0TyConKey = mkPreludeTyConUnique 149
d1TyConKey = mkPreludeTyConUnique 151
c1TyConKey = mkPreludeTyConUnique 152
@@ -1982,7 +1947,6 @@ s1TyConKey = mkPreludeTyConUnique 153
repTyConKey = mkPreludeTyConUnique 155
rep1TyConKey = mkPreludeTyConUnique 156
-uRecTyConKey = mkPreludeTyConUnique 157
uAddrTyConKey = mkPreludeTyConUnique 158
uCharTyConKey = mkPreludeTyConUnique 159
uDoubleTyConKey = mkPreludeTyConUnique 160
=====================================
compiler/GHC/HsToCore/Foreign/Wasm.hs
=====================================
@@ -224,6 +224,25 @@ especially since leaving all the boxing/unboxing business to C unifies
the implementation of JSFFI imports and exports
(rts_mkJSVal/rts_getJSVal).
+We don't support unboxed FFI types like Int# etc. But we do support
+one kind of unlifted FFI type for JSFFI import arguments:
+ByteArray#/MutableByteArray#. The semantics is the same in C: the
+pointer to the ByteArray# payload is passed instead of the ByteArray#
+closure itself. This allows efficient zero-copy data exchange between
+Haskell and JavaScript using unpinned ByteArray#, and the following
+conditions must be met:
+
+- The JSFFI import itself must be a sync import marked as unsafe
+- The JavaScript code must not re-enter Haskell when a ByteArray# is
+ passed as argument
+
+There's no magic in the handling of ByteArray#/MutableByteArray#
+arguments. When generating C stub, we treat them like Ptr that points
+to the payload, just without the rts_getPtr() unboxing call. After
+lowering to C import, the backend takes care of adding the offset, see
+add_shim in GHC.StgToCmm.Foreign and
+Note [Unlifted boxed arguments to foreign calls].
+
Now, each sync import calls a generated C function with a unique
symbol. The C function uses rts_get* to unbox the arguments, call into
JavaScript, then boxes the result with rts_mk* and returns it to
@@ -517,8 +536,9 @@ importCStub sync cfun_name arg_tys res_ty js_src = CStub c_doc [] []
cfun_ret
| res_ty `eqType` unitTy = cfun_call_import <> semi
| otherwise = text "return" <+> cfun_call_import <> semi
- cfun_make_arg arg_ty arg_val =
- text ("rts_get" ++ ffiType arg_ty) <> parens arg_val
+ cfun_make_arg arg_ty arg_val
+ | isByteArrayPrimTy arg_ty = arg_val
+ | otherwise = text ("rts_get" ++ ffiType arg_ty) <> parens arg_val
cfun_make_ret ret_val
| res_ty `eqType` unitTy = ret_val
| otherwise =
@@ -543,7 +563,11 @@ importCStub sync cfun_name arg_tys res_ty js_src = CStub c_doc [] []
| res_ty `eqType` unitTy = text "void"
| otherwise = text "HaskellObj"
cfun_arg_list =
- [text "HaskellObj" <+> char 'a' <> int n | n <- [1 .. length arg_tys]]
+ [ text (if isByteArrayPrimTy arg_ty then "HsPtr" else "HaskellObj")
+ <+> char 'a'
+ <> int n
+ | (arg_ty, n) <- zip arg_tys [1 ..]
+ ]
cfun_args = case cfun_arg_list of
[] -> text "void"
_ -> hsep $ punctuate comma cfun_arg_list
@@ -746,8 +770,18 @@ lookupGhcInternalTyCon m t = do
n <- lookupOrig (mkGhcInternalModule m) (mkTcOcc t)
dsLookupTyCon n
+isByteArrayPrimTy :: Type -> Bool
+isByteArrayPrimTy ty
+ | Just tc <- tyConAppTyCon_maybe ty,
+ tc == byteArrayPrimTyCon || tc == mutableByteArrayPrimTyCon =
+ True
+ | otherwise =
+ False
+
ffiType :: Type -> String
-ffiType = occNameString . getOccName . fst . splitTyConApp
+ffiType ty
+ | isByteArrayPrimTy ty = "Ptr"
+ | otherwise = occNameString $ getOccName $ tyConAppTyCon ty
commonCDecls :: SDoc
commonCDecls =
=====================================
compiler/GHC/Parser/String.hs
=====================================
@@ -19,6 +19,7 @@ import Data.Char (chr, ord)
import qualified Data.Foldable1 as Foldable1
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (listToMaybe, mapMaybe)
+import GHC.Data.OrdList (fromOL, nilOL, snocOL)
import GHC.Data.StringBuffer (StringBuffer)
import qualified GHC.Data.StringBuffer as StringBuffer
import GHC.Parser.CharClass (
@@ -167,16 +168,16 @@ collapseGaps = go
[] -> panic "gap unexpectedly ended"
resolveEscapes :: HasChar c => [c] -> Either (c, LexErr) [c]
-resolveEscapes = go dlistEmpty
+resolveEscapes = go nilOL
where
go !acc = \case
- [] -> pure $ dlistToList acc
+ [] -> pure $ fromOL acc
Char '\\' : Char '&' : cs -> go acc cs
backslash@(Char '\\') : cs ->
case resolveEscapeChar cs of
- Right (esc, cs') -> go (acc `dlistSnoc` setChar esc backslash) cs'
+ Right (esc, cs') -> go (acc `snocOL` setChar esc backslash) cs'
Left (c, e) -> Left (c, e)
- c : cs -> go (acc `dlistSnoc` c) cs
+ c : cs -> go (acc `snocOL` c) cs
-- -----------------------------------------------------------------------------
-- Escape characters
@@ -420,17 +421,3 @@ It's more precisely defined with the following algorithm:
* Lines with only whitespace characters
3. Calculate the longest prefix of whitespace shared by all lines in the remaining list
-}
-
--- -----------------------------------------------------------------------------
--- DList
-
-newtype DList a = DList ([a] -> [a])
-
-dlistEmpty :: DList a
-dlistEmpty = DList id
-
-dlistToList :: DList a -> [a]
-dlistToList (DList f) = f []
-
-dlistSnoc :: DList a -> a -> DList a
-dlistSnoc (DList f) x = DList (f . (x :))
=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -11,6 +11,7 @@ import GHC.IO (unsafePerformIO)
#endif
import Data.Char
+import Data.Foldable
import GHC.Prelude
import GHC.Platform
import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
@@ -18,6 +19,7 @@ import GHC.Types.Unique.DSM
import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..))
+import GHC.Data.OrdList (OrdList, nilOL, snocOL)
import GHC.Cmm
import GHC.Cmm.CLabel
@@ -286,7 +288,7 @@ data CgInfoProvEnt = CgInfoProvEnt
, ipeSrcSpan :: !StrTabOffset
}
-data StringTable = StringTable { stStrings :: DList ShortText
+data StringTable = StringTable { stStrings :: !(OrdList ShortText)
, stLength :: !Int
, stLookup :: !(M.Map ShortText StrTabOffset)
}
@@ -295,7 +297,7 @@ type StrTabOffset = Word32
emptyStringTable :: StringTable
emptyStringTable =
- StringTable { stStrings = emptyDList
+ StringTable { stStrings = nilOL
, stLength = 0
, stLookup = M.empty
}
@@ -303,7 +305,7 @@ emptyStringTable =
getStringTableStrings :: StringTable -> BS.ByteString
getStringTableStrings st =
BSL.toStrict $ BSB.toLazyByteString
- $ foldMap f $ dlistToList (stStrings st)
+ $ foldMap' f $ stStrings st
where
f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0
@@ -312,7 +314,7 @@ lookupStringTable str = state $ \st ->
case M.lookup str (stLookup st) of
Just off -> (off, st)
Nothing ->
- let !st' = st { stStrings = stStrings st `snoc` str
+ let !st' = st { stStrings = stStrings st `snocOL` str
, stLength = stLength st + ST.byteLength str + 1
, stLookup = M.insert str res (stLookup st)
}
@@ -359,14 +361,3 @@ foreign import ccall unsafe "ZSTD_compressBound"
defaultCompressionLevel :: Int
defaultCompressionLevel = 3
-
-newtype DList a = DList ([a] -> [a])
-
-emptyDList :: DList a
-emptyDList = DList id
-
-snoc :: DList a -> a -> DList a
-snoc (DList f) x = DList (f . (x:))
-
-dlistToList :: DList a -> [a]
-dlistToList (DList f) = f []
=====================================
docs/users_guide/wasm.rst
=====================================
@@ -265,7 +265,7 @@ backend’s JavaScript FFI, which we’ll now abbreviate as JSFFI.
Marshalable types and ``JSVal``
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-JSFFI supports all boxed marshalable foreign types in C FFI:
+JSFFI supports all lifted marshalable foreign types in C FFI:
- ``Bool``
- ``Char``
@@ -298,8 +298,14 @@ types in JSFFI. Some caveats to keep in mind:
results in type errors, so keep this in mind. As for ``Int`` /
``Word``, they are 32-bit since the GHC wasm backend is based on
``wasm32`` .
-- JSFFI doesn’t support unboxed foreign types like ``Int#``,
- ``ByteArray#``, etc, even when ``UnliftedFFITypes`` is enabled.
+- JSFFI doesn’t support unboxed foreign types like ``Int#``, even
+ when ``UnliftedFFITypes`` is enabled. The only supported unlifted
+ types are ``ByteArray#`` and ``MutableByteArray#``, they may only
+ be used as JSFFI import argument types, with the same semantics in
+ C FFI: the pointer to the payload is passed to JavaScript. Be
+ careful and avoid calling back into Haskell in such cases,
+ otherwise GC may occur and the pointer may be invalidated if it's
+ unpinned!
In addition to the above types, JSFFI supports the ``JSVal`` type and
its ``newtype``\ s as argument/result types. ``JSVal`` is defined in
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -169,6 +169,7 @@ enableDebugInfo :: Flavour -> Flavour
enableDebugInfo = addArgs $ notStage0 ? mconcat
[ builder (Ghc CompileHs) ? pure ["-g3"]
, builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"]
+ , builder (Ghc CompileCppWithGhc) ? pure ["-optcxx-g3"]
, builder (Cc CompileC) ? arg "-g3"
, builder (Cabal Setup) ? arg "--disable-library-stripping"
, builder (Cabal Setup) ? arg "--disable-executable-stripping"
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -351,7 +351,7 @@ rtsPackageArgs = package rts ? do
, Debug `wayUnit` way ? pure [ "-DDEBUG"
, "-fno-omit-frame-pointer"
, "-g3"
- , "-O0" ]
+ , "-Og" ]
-- Set the namespace for the rts fs functions
, arg $ "-DFS_NAMESPACE=rts"
=====================================
rts/linker/InitFini.c
=====================================
@@ -75,7 +75,7 @@ static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order)
while (*last != NULL && (*last)->next != NULL) {
struct InitFiniList *s0 = *last;
struct InitFiniList *s1 = s0->next;
- bool flip;
+ bool flip = false;
switch (order) {
case INCREASING: flip = s0->priority > s1->priority; break;
case DECREASING: flip = s0->priority < s1->priority; break;
=====================================
rts/sm/Sanity.c
=====================================
@@ -692,7 +692,7 @@ checkCompactObjects(bdescr *bd)
ASSERT((W_)str == (W_)block + sizeof(StgCompactNFDataBlock));
StgWord totalW = 0;
- StgCompactNFDataBlock *last;
+ StgCompactNFDataBlock *last = block;
for ( ; block ; block = block->next) {
last = block;
ASSERT(block->owner == str);
=====================================
testsuite/tests/jsffi/all.T
=====================================
@@ -25,4 +25,6 @@ test('jsffion', [], compile_and_run, ['-optl-Wl,--export=main'])
test('jsffisleep', [], compile_and_run, ['-optl-Wl,--export=testWouldBlock,--export=testLazySleep,--export=testThreadDelay,--export=testInterruptingSleep'])
+test('bytearrayarg', [], compile_and_run, ['-optl-Wl,--export=main'])
+
test('textconv', [], compile_and_run, ['-optl-Wl,--export=main'])
=====================================
testsuite/tests/jsffi/bytearrayarg.hs
=====================================
@@ -0,0 +1,39 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+
+module Test where
+
+import GHC.Exts
+import GHC.IO
+import GHC.Word (Word8(W8#))
+
+foreign import javascript unsafe "(() => { const u8 = new Uint8Array(__exports.memory.buffer, $1, 4); return (u8[0] === 0x12 && u8[1] === 0x34 && u8[2] === 0x56 && u8[3] === 0x78) ? 1 : 0; })()"
+ js_check_mba :: MutableByteArray# RealWorld -> IO Int
+
+foreign import javascript unsafe "(() => { const u8 = new Uint8Array(__exports.memory.buffer, $1, 4); return (u8[0] === 0x12 && u8[1] === 0x34 && u8[2] === 0x56 && u8[3] === 0x78) ? 1 : 0; })()"
+ js_check_ba :: ByteArray# -> IO Int
+
+foreign export javascript "main"
+ main :: IO ()
+
+main :: IO ()
+main =
+ IO $ \s0 ->
+ case newPinnedByteArray# 4# s0 of
+ (# s1, mba# #) ->
+ case (0x12 :: Word8) of { W8# b0# ->
+ case (0x34 :: Word8) of { W8# b1# ->
+ case (0x56 :: Word8) of { W8# b2# ->
+ case (0x78 :: Word8) of { W8# b3# ->
+ let s2 = writeWord8Array# mba# 0# b0# s1
+ s3 = writeWord8Array# mba# 1# b1# s2
+ s4 = writeWord8Array# mba# 2# b2# s3
+ s5 = writeWord8Array# mba# 3# b3# s4
+ in case unIO (js_check_mba mba#) s5 of
+ (# s6, ok_mba #) -> case unsafeFreezeByteArray# mba# s6 of
+ (# s7, ba# #) -> case unIO (js_check_ba ba#) s7 of
+ (# s8, ok_ba #) -> case unIO (print ok_mba) s8 of
+ (# s9, _ #) -> case unIO (print ok_ba) s9 of
+ (# s10, _ #) -> (# s10, () #)
+ }}}}
=====================================
testsuite/tests/jsffi/bytearrayarg.mjs
=====================================
@@ -0,0 +1,4 @@
+export default async (__exports) => {
+ await __exports.main();
+ process.exit();
+}
=====================================
testsuite/tests/jsffi/bytearrayarg.stdout
=====================================
@@ -0,0 +1,2 @@
+1
+1
=====================================
testsuite/tests/perf/should_run/all.T
=====================================
@@ -420,6 +420,7 @@ test('T17949', [collect_stats('bytes allocated', 1), only_ways(['normal'])], com
test('ByteCodeAsm',
[ extra_run_opts('"' + config.libdir + '"')
, js_broken(22261)
+ , when(arch('wasm32'), run_timeout_multiplier(10))
, collect_stats('bytes allocated', 10),
],
compile_and_run,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d02245f603cd5170668cb58264f0b49...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d02245f603cd5170668cb58264f0b49...
You're receiving this email because of your account on gitlab.haskell.org.
