git.iko.soy/patch
on 032e6b2 help sign in
patch/src/Reflex/FastWeak.hs
196 lines 7.1 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4#if GHCJS_FAST_WEAK
5{-# LANGUAGE ForeignFunctionInterface #-}
6{-# LANGUAGE JavaScriptFFI #-}
7#endif
9-- | 'FastWeak' is a weak pointer to some value, and 'FastWeakTicket' ensures the value
10-- referred to by a 'FastWeak' stays live while the ticket is held (live).
11--
12-- On GHC or GHCJS when not built with the @fast-weak@ cabal flag, 'FastWeak' is a wrapper
13-- around the simple version of 'System.Mem.Weak.Weak' where the key and value are the same.
14--
15-- On GHCJS when built with the @fast-weak@ cabal flag, 'FastWeak' is implemented directly
16-- in JS using @h$FastWeak@ and @h$FastWeakTicket@ which are a nonstandard part of the GHCJS RTS.
17module Reflex.FastWeak
18 ( FastWeakTicket
19 , FastWeak
20 , mkFastWeakTicket
21 , getFastWeakTicketValue
22 , getFastWeakTicketWeak
23 , getFastWeakValue
24 , getFastWeakTicket
25 , emptyFastWeak
26#ifdef GHCJS_FAST_WEAK
27 --TODO: Move these elsewhere
28 , unsafeFromRawJSVal
29 , unsafeToRawJSVal
30 , js_isNull
31#endif
32 ) where
34import GHC.Exts (Any)
35import Unsafe.Coerce
37#ifdef GHCJS_FAST_WEAK
38import GHCJS.Types
39#else
40import Control.Exception (evaluate)
41import System.IO.Unsafe
42import System.Mem.Weak
43#endif
46#ifdef GHCJS_FAST_WEAK
47-- | A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue'
48-- can be used to get the referred to value without fear of @Nothing,
49-- and 'getFastWeakTicketWeak' can be used to get the weak version.
50--
51-- Implemented by way of special support in the GHCJS RTS, @h$FastWeakTicket@.
52newtype FastWeakTicket a = FastWeakTicket JSVal
54-- | A reference to some value which can be garbage collected if there are only
55-- weak references to the value left.
56--
57-- 'getFastWeakValue' can be used to try and obtain a strong reference to the value.
58--
59-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using
60-- 'getFastWeakTicket' if the value hasn't been collected yet.
61--
62-- Implemented by way of special support in the GHCJS RTS, @h$FastWeak@.
63newtype FastWeak a = FastWeak JSVal
65-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two
66data Val a = Val { unVal :: a }
68-- | Coerce a JSVal that represents the heap object of a value of type @a@ into a value of type @a@
69unsafeFromRawJSVal :: JSVal -> a
70unsafeFromRawJSVal v = unVal (unsafeCoerce v)
72-- | Coerce a heap object of type @a@ into a 'JSVal' which represents that object.
73unsafeToRawJSVal :: a -> JSVal
74unsafeToRawJSVal v = unsafeCoerce (Val v)
75#else
76-- | A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue'
77-- can be used to get the referred to value without fear of @Nothing@,
78-- and 'getFastWeakTicketWeak' can be used to get the weak version.
79data FastWeakTicket a = FastWeakTicket
80 { _fastWeakTicket_val :: !a
81 , _fastWeakTicket_weak :: {-# UNPACK #-} !(Weak a)
82 }
84-- | A reference to some value which can be garbage collected if there are only weak references to the value left.
85--
86-- 'getFastWeakValue' can be used to try and obtain a strong reference to the value.
87--
88-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using 'getFastWeakTicket'
89-- if the value hasn't been collected yet.
90--
91-- Synonymous with 'Weak'.
92type FastWeak a = Weak a
93#endif
95-- | Return the @a@ kept alive by the given 'FastWeakTicket'.
96--
97-- This needs to be in IO so we know that we've relinquished the ticket.
98getFastWeakTicketValue :: FastWeakTicket a -> IO a
99#ifdef GHCJS_FAST_WEAK
100getFastWeakTicketValue t = do
101 v <- js_ticketVal t
102 return $ unsafeFromRawJSVal v
104foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a -> IO JSVal
105#else
106getFastWeakTicketValue = return . _fastWeakTicket_val
107#endif
109-- | Get the value referred to by a 'FastWeak' if it hasn't yet been collected,
110-- or @Nothing@ if it has been collected.
111getFastWeakValue :: FastWeak a -> IO (Maybe a)
112#ifdef GHCJS_FAST_WEAK
113getFastWeakValue w = do
114 r <- js_weakVal w
115 case js_isNull r of
116 True -> return Nothing
117 False -> return $ Just $ unsafeFromRawJSVal r
119foreign import javascript unsafe "$1 === null" js_isNull :: JSVal -> Bool
121foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.val;" js_weakVal :: FastWeak a -> IO JSVal
122#else
123getFastWeakValue = deRefWeak
124#endif
126-- | Try to create a 'FastWeakTicket' for the given 'FastWeak' which will ensure the value referred
127-- remains alive. Returns @Just@ if the value hasn't been collected
128-- and a ticket can therefore be obtained, @Nothing@ if it's been collected.
129getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))
130#ifdef GHCJS_FAST_WEAK
131getFastWeakTicket w = do
132 r <- js_weakTicket w
133 case js_isNull r of
134 True -> return Nothing
135 False -> return $ Just $ FastWeakTicket r
137foreign import javascript unsafe "$r = $1.ticket;" js_weakTicket :: FastWeak a -> IO JSVal
138#else
139getFastWeakTicket w = do
140 deRefWeak w >>= \case
141 Nothing -> return Nothing
142 Just v -> return $ Just $ FastWeakTicket
143 { _fastWeakTicket_val = v
144 , _fastWeakTicket_weak = w
145 }
146#endif
148-- | Create a 'FastWeakTicket' directly from a value, creating a 'FastWeak' in the process
149-- which can be obtained with 'getFastWeakTicketValue'.
150mkFastWeakTicket :: a -> IO (FastWeakTicket a)
151-- 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
152-- associated FastWeak to actually be weak
153#ifdef GHCJS_FAST_WEAK
154mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)
156foreign import javascript unsafe "$r = new h$FastWeakTicket($1);" js_fastWeakTicket :: JSVal -> IO (FastWeakTicket a)
157#else
158mkFastWeakTicket v = do
159 v' <- evaluate v
160 w <- mkWeakPtr v' Nothing
161 return $ FastWeakTicket
162 { _fastWeakTicket_val = v'
163 , _fastWeakTicket_weak = w
164 }
165#endif
167-- | Demote a 'FastWeakTicket'; which ensures the value is alive, to a 'FastWeak' which doesn't.
168-- Note that unless the ticket for the same 'FastWeak' is held in some other way
169-- the value might be collected immediately.
170getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
171-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value
172#ifdef GHCJS_FAST_WEAK
173foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak' :: FastWeakTicket a -> IO (FastWeak a)
174{-# INLINE getFastWeakTicketWeak #-}
175getFastWeakTicketWeak = getFastWeakTicketWeak'
176#else
177getFastWeakTicketWeak = return . _fastWeakTicket_weak
178#endif
180-- | A weak reference that is always empty
181emptyFastWeak :: FastWeak a
182emptyFastWeak = unsafeCoerce w
183 where w :: FastWeak Any
184#ifdef GHCJS_FAST_WEAK
185 w = js_emptyWeak
186#else
187 w = unsafePerformIO $ do
188 w' <- mkWeakPtr undefined Nothing
189 finalize w'
190 return w'
191#endif
192{-# NOINLINE emptyFastWeak #-}
194#ifdef GHCJS_FAST_WEAK
195foreign import javascript unsafe "$r = new h$FastWeak(null);" js_emptyWeak :: FastWeak Any
196#endif