git.iko.soy/patch
on develop help sign in
Provide GHC implementations for FastWeak
ad1991dRyan Trinkle
reflex.cabal+1
compare with develop
unifiedsplit
@@ -72,6 +72,7 @@ library
72 Data.AppendMap,
72 Data.AppendMap,
73 Data.Functor.Misc,
73 Data.Functor.Misc,
74 Data.WeakBag,
74 Data.WeakBag,
75+ Data.FastWeakBag,
75 Reflex,
76 Reflex,
76 Reflex.Class,
77 Reflex.Class,
77 Reflex.EventWriter,
78 Reflex.EventWriter,
src/Reflex/FastWeak.hs+28−16
@@ -1,11 +1,12 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2+#ifdef ghcjs_HOST_OS
2{-# LANGUAGE ForeignFunctionInterface #-}
3{-# LANGUAGE ForeignFunctionInterface #-}
3{-# LANGUAGE JavaScriptFFI #-}
4{-# LANGUAGE JavaScriptFFI #-}
4−{-# LANGUAGE MagicHash #-}
5+#endif
5module Reflex.FastWeak
6module Reflex.FastWeak
6 ( FastWeakTicket
7 ( FastWeakTicket
7 , FastWeak
8 , FastWeak
8− , fastWeakTicket
9+ , mkFastWeakTicket
9 , fastWeakTicketValue
10 , fastWeakTicketValue
10 , getFastWeakTicketWeak
11 , getFastWeakTicketWeak
11 , getFastWeakValue
12 , getFastWeakValue
@@ -15,21 +16,26 @@ module Reflex.FastWeak
15import GHCJS.Types
16import GHCJS.Types
16import Unsafe.Coerce
17import Unsafe.Coerce
17#else
18#else
19+import Control.Exception (evaluate)
20+import System.Mem.Weak
18#endif
21#endif
19
22
20
23
21#ifdef ghcjs_HOST_OS
24#ifdef ghcjs_HOST_OS
22−type Ref = JSVal
25+newtype FastWeakTicket a = FastWeakTicket JSVal
23−#else
24−type Ref = ()
25−#endif
26
26
27−newtype FastWeakTicket a = FastWeakTicket Ref
28−
29−newtype FastWeak a = FastWeak Ref
27+newtype FastWeak a = FastWeak JSVal
30
28
31-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two
29-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two
32data Val a = Val { unVal :: a }
30data 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
33
39
34-- Do we have a concern about accidentally retaining the ticket here?
40-- Do we have a concern about accidentally retaining the ticket here?
35fastWeakTicketValue :: FastWeakTicket a -> a
41fastWeakTicketValue :: FastWeakTicket a -> a
@@ -38,7 +44,7 @@ fastWeakTicketValue t = unVal (unsafeCoerce (js_ticketVal t))
38
44
39foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a -> JSVal
45foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a -> JSVal
40#else
46#else
41−fastWeakTicketValue = error "fastWeakTicketValue not implemented"
47+fastWeakTicketValue = _fastWeakTicket_val
42#endif
48#endif
43
49
44getFastWeakValue :: FastWeak a -> IO (Maybe a)
50getFastWeakValue :: FastWeak a -> IO (Maybe a)
@@ -53,17 +59,23 @@ foreign import javascript unsafe "$1 === null" js_isNull :: JSVal -> Bool
53
59
54foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.val;" js_weakVal :: FastWeak a -> IO JSVal
60foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.val;" js_weakVal :: FastWeak a -> IO JSVal
55#else
61#else
56−getFastWeakValue = error "getFastWeakValue not implemented"
62+getFastWeakValue = deRefWeak
57#endif
63#endif
58
64
59-- 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
65-- 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)
61#ifdef ghcjs_HOST_OS
67#ifdef ghcjs_HOST_OS
62−fastWeakTicket v = js_fastWeakTicket (unsafeCoerce (Val v))
68+mkFastWeakTicket v = js_fastWeakTicket (unsafeCoerce (Val v))
63
69
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)
65#else
71#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+ }
67#endif
79#endif
68
80
69-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value
81-- 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"
71foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
83foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
72#else
84#else
73getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
85getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
74−getFastWeakTicketWeak = error "fastWeakTicketWeak not implemented"
86+getFastWeakTicketWeak = return . _fastWeakTicket_weak
75#endif
87#endif
src/Reflex/Spider/Internal.hs+1−1
@@ -303,7 +303,7 @@ cacheEvent e =
303 , _cacheSubscribed_cached = mSubscribedRef
303 , _cacheSubscribed_cached = mSubscribedRef
304 , _cacheSubscribed_occurrence = occRef
304 , _cacheSubscribed_occurrence = occRef
305 }
305 }
306− !subscribedTicket = fastWeakTicket subscribed
306+ subscribedTicket <- liftIO $ mkFastWeakTicket subscribed
307 liftIO $ writeIORef mSubscribedRef $ Just subscribedTicket
307 liftIO $ writeIORef mSubscribedRef $ Just subscribedTicket
308 return subscribedTicket
308 return subscribedTicket
309 liftIO $ do
309 liftIO $ do