GitLab

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

 +{-# 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 ()