diff --git a/libraries/ghc-experimental/src/GHC/Wasm/Prim.hs b/libraries/ghc-experimental/src/GHC/Wasm/Prim.hs index 0e90fce0560e5f423194390b2df1f7c897c9b0e0..480c2f4d7cc5e5c6951fe77967ab2a0a07ea879f 100644 --- a/libraries/ghc-experimental/src/GHC/Wasm/Prim.hs +++ b/libraries/ghc-experimental/src/GHC/Wasm/Prim.hs @@ -4,6 +4,7 @@ module GHC.Wasm.Prim ( -- User-facing JSVal type and freeJSVal JSVal, freeJSVal, + mkWeakJSVal, -- The JSString type and conversion from/to Haskell String JSString (..), diff --git a/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim.hs b/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim.hs index e5a9ab29cf36dd7468ecf592b43912f353ee5a8e..ed74fbe8b3a12609e9a20bfe5cb7e42a902a5c78 100644 --- a/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim.hs +++ b/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim.hs @@ -4,6 +4,7 @@ module GHC.Internal.Wasm.Prim ( -- User-facing JSVal type and freeJSVal JSVal (..), freeJSVal, + mkWeakJSVal, -- The JSString type and conversion from/to Haskell String JSString (..), diff --git a/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs b/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs index 46f5b6deac5b802830f08feae79c0cbdaec0dd84..2b5f2e408dbb47e37723de653689f36af05a1fe5 100644 --- a/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs +++ b/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs @@ -8,6 +8,7 @@ module GHC.Internal.Wasm.Prim.Types ( JSVal# (..), JSVal (..), freeJSVal, + mkWeakJSVal, JSString (..), fromJSString, toJSString, @@ -26,6 +27,7 @@ import GHC.Internal.IO.Encoding import GHC.Internal.Num import GHC.Internal.Show import GHC.Internal.Stable +import GHC.Internal.Weak {- @@ -94,6 +96,12 @@ freeJSVal v@(JSVal _ w sp) = do IO $ \s0 -> case finalizeWeak# w s0 of (# s1, _, _ #) -> (# s1, () #) +mkWeakJSVal :: JSVal -> Maybe (IO ()) -> IO (Weak JSVal) +mkWeakJSVal v@(JSVal k _ _) (Just (IO fin)) = IO $ \s0 -> + case mkWeak# k v fin s0 of + (# s1, w #) -> (# s1, Weak w #) +mkWeakJSVal (JSVal _ w _) Nothing = pure $ Weak w + foreign import javascript unsafe "if (!__ghc_wasm_jsffi_finalization_registry.unregister($1)) { throw new WebAssembly.RuntimeError('js_callback_unregister'); }" js_callback_unregister :: JSVal -> IO () diff --git a/testsuite/tests/jsffi/jsffigc.hs b/testsuite/tests/jsffi/jsffigc.hs index f260e10f6eb292157e15d61c3cf5680cf3107068..851ad0438d31a603e14bb94a88ba6e7b6ed55eb4 100644 --- a/testsuite/tests/jsffi/jsffigc.hs +++ b/testsuite/tests/jsffi/jsffigc.hs @@ -4,7 +4,7 @@ module Test where import Data.Maybe import GHC.Exts -import GHC.Internal.Wasm.Prim +import GHC.Wasm.Prim import GHC.Weak import System.Mem @@ -22,13 +22,6 @@ foreign import javascript "wrapper" foreign export javascript "testDynExportFree sync" testDynExportFree :: Int -> Int -> Int -> IO () --- JSVal uses Weak# under the hood for garbage collection support, --- this exposes the internal Weak# to observe the liveliness of --- JSVal#. Do not use this in your own codebase since this is purely --- an implementation detail of JSVal and subject to change! -jsvalWeak :: JSVal -> Weak JSVal -jsvalWeak (JSVal _ w _) = Weak w - probeWeak :: Weak v -> IO () probeWeak wk = print =<< isJust <$> deRefWeak wk @@ -42,7 +35,7 @@ testDynExportFree x y z = do -- wk_js observe the liveliness of the JavaScript callback on the -- Haskell heap. Make sure it's eagerly evaluated and isn't a thunk -- that retains cb. - let !wk_js = jsvalWeak cb + !wk_js <- mkWeakJSVal cb Nothing print $ js_to_hs cb x y -- Eagerly drop references to both the JavaScript callback and the -- Haskell function closure. @@ -60,7 +53,7 @@ testDynExportGC x y z = do let fn a b = a * b + z wk_fn <- mkWeak fn () Nothing cb <- js_from_hs fn - let !wk_js = jsvalWeak cb + !wk_js <- mkWeakJSVal cb Nothing print $ js_to_hs cb x y -- Why performGC twice? The first run gathers some C finalizers -- which will be invoked in the second run to free the JSVal