on develop help sign in
Provide GHC implementations for FastWeak
commitad1991da603a4d4742d9d26915bfb4f3bb5bf560 authorRyan Trinkle <ryan.trinkle@gmail.com> dateSat 10 Jun 2017, 18:14 (9 years ago) parent011edf2
3 files changed+30−17
reflex.cabal+1 src/Reflex/FastWeak.hs+28−16 src/Reflex/Spider/Internal.hs+1−1
reflex.cabal+1
@@ -72,6 +72,7 @@ library
7272 Data.AppendMap,
7373 Data.Functor.Misc,
7474 Data.WeakBag,
75+ Data.FastWeakBag,
7576 Reflex,
7677 Reflex.Class,
7778 Reflex.EventWriter,
src/Reflex/FastWeak.hs+28−16
@@ -1,11 +1,12 @@
11{-# LANGUAGE CPP #-}
2+#ifdef ghcjs_HOST_OS
23{-# LANGUAGE ForeignFunctionInterface #-}
34{-# LANGUAGE JavaScriptFFI #-}
4−{-# LANGUAGE MagicHash #-}
5+#endif
56module Reflex.FastWeak
67 ( FastWeakTicket
78 , FastWeak
8− , fastWeakTicket
9+ , mkFastWeakTicket
910 , fastWeakTicketValue
1011 , getFastWeakTicketWeak
1112 , getFastWeakValue
@@ -15,21 +16,26 @@ module Reflex.FastWeak
1516import GHCJS.Types
1617import Unsafe.Coerce
1718#else
19+import Control.Exception (evaluate)
20+import System.Mem.Weak
1821#endif
1922
2023
2124#ifdef ghcjs_HOST_OS
22−type Ref = JSVal
23−#else
24−type Ref = ()
25−#endif
25+newtype FastWeakTicket a = FastWeakTicket JSVal
2626
27−newtype FastWeakTicket a = FastWeakTicket Ref
28−
29−newtype FastWeak a = FastWeak Ref
27+newtype FastWeak a = FastWeak JSVal
3028
3129-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two
3230data Val a = Val { unVal :: a }
31+#else
32+data FastWeakTicket a = FastWeakTicket
33+ { _fastWeakTicket_val :: !a
34+ , _fastWeakTicket_weak :: {-# UNPACK #-} !(Weak a)
35+ }
36+
37+type FastWeak a = Weak a
38+#endif
3339
3440-- Do we have a concern about accidentally retaining the ticket here?
3541fastWeakTicketValue :: FastWeakTicket a -> a
@@ -38,7 +44,7 @@ fastWeakTicketValue t = unVal (unsafeCoerce (js_ticketVal t))
3844
3945foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a -> JSVal
4046#else
41−fastWeakTicketValue = error "fastWeakTicketValue not implemented"
47+fastWeakTicketValue = _fastWeakTicket_val
4248#endif
4349
4450getFastWeakValue :: FastWeak a -> IO (Maybe a)
@@ -53,17 +59,23 @@ foreign import javascript unsafe "$1 === null" js_isNull :: JSVal -> Bool
5359
5460foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.val;" js_weakVal :: FastWeak a -> IO JSVal
5561#else
56−getFastWeakValue = error "getFastWeakValue not implemented"
62+getFastWeakValue = deRefWeak
5763#endif
5864
5965-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the associated FastWeak to actually be weak
60−fastWeakTicket :: a -> FastWeakTicket a
66+mkFastWeakTicket :: a -> IO (FastWeakTicket a)
6167#ifdef ghcjs_HOST_OS
62−fastWeakTicket v = js_fastWeakTicket (unsafeCoerce (Val v))
68+mkFastWeakTicket v = js_fastWeakTicket (unsafeCoerce (Val v))
6369
64−foreign import javascript unsafe "$r = new h$FastWeakTicket($1);" js_fastWeakTicket :: JSVal -> FastWeakTicket a
70+foreign import javascript unsafe "$r = new h$FastWeakTicket($1);" js_fastWeakTicket :: JSVal -> IO (FastWeakTicket a)
6571#else
66−fastWeakTicket = error "fastWeakTicket not implemented"
72+mkFastWeakTicket v = do
73+ v' <- evaluate v
74+ w <- mkWeakPtr v' Nothing
75+ return $ FastWeakTicket
76+ { _fastWeakTicket_val = v'
77+ , _fastWeakTicket_weak = w
78+ }
6779#endif
6880
6981-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value
@@ -71,5 +83,5 @@ fastWeakTicket = error "fastWeakTicket not implemented"
7183foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
7284#else
7385getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
74−getFastWeakTicketWeak = error "fastWeakTicketWeak not implemented"
86+getFastWeakTicketWeak = return . _fastWeakTicket_weak
7587#endif
src/Reflex/Spider/Internal.hs+1−1
@@ -303,7 +303,7 @@ cacheEvent e =
303303 , _cacheSubscribed_cached = mSubscribedRef
304304 , _cacheSubscribed_occurrence = occRef
305305 }
306− !subscribedTicket = fastWeakTicket subscribed
306+ subscribedTicket <- liftIO $ mkFastWeakTicket subscribed
307307 liftIO $ writeIORef mSubscribedRef $ Just subscribedTicket
308308 return subscribedTicket
309309 liftIO $ do