Matthew Pickering pushed to branch wip/wasm-bytearray-marshall at Glasgow Haskell Compiler / GHC Commits: 96d12714 by Matthew Pickering at 2025-06-09T09:58:59+01:00 wasm: Add JSUint8Array to ByteArray conversion functions With these functions you can more directly pass ByteArray#-like objects to functions compiled using the wasm backend. For example, a foreign export can expect a JSUint8Array ``` foreign export javascript "hs_round" roundTrip :: JSUint8Array -> JSUint8Array ``` and then the function can be called from javascript and passed a Uint8Array. ``` var uint8Array = new Uint8Array(arrayBuffer); wasi.instance.exports.hs_round(uint8Array); ``` - - - - - 3 changed files: - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/GHC/Wasm/Uint8Array.hs - testsuite/tests/jsffi/textconv.hs Changes: ===================================== libraries/ghc-experimental/ghc-experimental.cabal.in ===================================== @@ -40,6 +40,7 @@ library Prelude.Experimental if arch(wasm32) exposed-modules: GHC.Wasm.Prim + GHC.Wasm.Uint8Array other-extensions: build-depends: base >=4.20 && < 4.22, ghc-internal == @ProjectVersionForLib@.* ===================================== libraries/ghc-experimental/src/GHC/Wasm/Uint8Array.hs ===================================== @@ -0,0 +1,48 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +-- | Utilities to marshall a javascript 'Uint8Array' to a 'ByteArray' +module GHC.Wasm.Uint8Array + ( toJSUint8Array, fromJSUint8Array, JSUint8Array(..), byteLength + ) where + +import Data.Array.Byte +import GHC.Wasm.Prim +import GHC.Ptr +import GHC.Exts +import System.IO.Unsafe +import GHC.IO + +newtype JSUint8Array = JSUint8Array { unJSUint8Array :: JSVal } + +foreign import javascript unsafe + "$1.byteLength" + byteLength :: JSUint8Array -> Int + +withByteArrayContents :: ByteArray -> (Ptr () -> Int -> IO a) -> IO a +withByteArrayContents (ByteArray arr#) f = IO $ \s0 -> + keepAlive# arr# s0 (unIO $ f (Ptr (byteArrayContents# arr#)) (I# (sizeofByteArray# arr#) )) + +fromJSUint8ArrayLen :: Int -> JSUint8Array -> ByteArray +fromJSUint8ArrayLen (I# len) arr = unsafePerformIO $ IO $ + \s -> case newByteArray# len s of + (# s', mb #) -> + let a = mutableByteArrayContents# mb + in case unIO (memorySetUint8Array (Ptr a) (I# len) arr) s' of + (# s'', () #) -> case unsafeFreezeByteArray# mb s'' of + (# s''', arr' #) -> (# s''', ByteArray arr' #) + +toJSUint8Array :: ByteArray -> JSUint8Array +toJSUint8Array ba = + unsafePerformIO $ withByteArrayContents ba uint8ArrayFromMemory + +fromJSUint8Array :: JSUint8Array -> ByteArray +fromJSUint8Array src_buf = fromJSUint8ArrayLen (byteLength src_buf) src_buf + +foreign import javascript unsafe + "(new Uint8Array(__exports.memory.buffer, $1, $2)).set($3)" + memorySetUint8Array :: Ptr a -> Int -> JSUint8Array -> IO () + +foreign import javascript unsafe + "new Uint8Array(new Uint8Array(__exports.memory.buffer, $1, $2))" + uint8ArrayFromMemory :: Ptr a -> Int -> IO JSUint8Array + ===================================== testsuite/tests/jsffi/textconv.hs ===================================== @@ -14,36 +14,24 @@ import qualified Data.Text.IO.Utf8 as T import GHC.Exts import GHC.IO import GHC.Wasm.Prim - -newtype JSUint8Array = JSUint8Array JSVal +import GHC.Wasm.Uint8Array foreign import javascript unsafe "(new TextEncoder()).encode($1)" - js_str_encode :: JSString -> IO JSUint8Array - -foreign import javascript unsafe "$1.byteLength" - js_buf_len :: JSUint8Array -> IO Int - -foreign import javascript unsafe "(new Uint8Array(__exports.memory.buffer, $2, $1.byteLength)).set($1)" - js_from_buf :: JSUint8Array -> Ptr a -> IO () + js_str_encode :: JSString -> JSUint8Array -foreign import javascript unsafe "(new TextDecoder('utf-8', {fatal: true})).decode(new Uint8Array(__exports.memory.buffer, $1, $2))" - js_to_str :: Ptr a -> Int -> IO JSString +foreign import javascript unsafe "(new TextDecoder('utf-8', {fatal: true})).decode($1)" + js_to_str :: JSUint8Array -> JSString textFromJSString :: JSString -> Text -textFromJSString str = unsafeDupablePerformIO $ do - buf <- js_str_encode str - I# len# <- js_buf_len buf - IO $ \s0 -> case newByteArray# len# s0 of - (# s1, mba# #) -> case unIO (js_from_buf buf (Ptr (mutableByteArrayContents# mba#))) s1 of - (# s2, _ #) -> case unIO (freeJSVal (coerce buf)) s2 of - (# s3, _ #) -> case unsafeFreezeByteArray# mba# s3 of - (# s4, ba# #) -> (# s4, Text (ByteArray ba#) 0 (I# len#) #) +textFromJSString str = + let buf = js_str_encode str + in Text (fromJSUint8Array buf) 0 (byteLength buf) +-- NOTE: Do not copy this into your program, you need to take into account the +-- offset to do this converson properly textToJSString :: Text -> JSString -textToJSString (Text (ByteArray ba#) (I# off#) (I# len#)) = unsafeDupablePerformIO $ - IO $ \s0 -> case newPinnedByteArray# len# s0 of - (# s1, mba# #) -> case copyByteArray# ba# off# mba# 0# len# s1 of - s2 -> keepAlive# mba# s2 $ unIO $ js_to_str (Ptr (mutableByteArrayContents# mba#)) $ I# len# +textToJSString (Text ba 0 len) = js_to_str (toJSUint8Array ba) +textToJSString _ = error "non-zero offset not supported" foreign export javascript "main sync" main :: IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/96d12714484b1d93b564fc046f0e1a27... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/96d12714484b1d93b564fc046f0e1a27... You're receiving this email because of your account on gitlab.haskell.org.