2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ForeignFunctionInterface #-}
6{-# LANGUAGE JavaScriptFFI #-}
8{-# LANGUAGE MagicHash #-}
9{-# LANGUAGE UnboxedTuples #-}
16-- 'FastWeak' is a weak pointer to some value, and 'FastWeakTicket' ensures the value
17-- referred to by a 'FastWeak' stays live while the ticket is held (live).
19-- On GHC or GHCJS when not built with the @fast-weak@ cabal flag, 'FastWeak' is a wrapper
20-- around the simple version of 'System.Mem.Weak.Weak' where the key and value are the same.
22-- On GHCJS when built with the @fast-weak@ cabal flag, 'FastWeak' is implemented directly
23-- in JS using @h$FastWeak@ and @h$FastWeakTicket@ which are a nonstandard part of the GHCJS RTS.
28 , getFastWeakTicketValue
29 , getFastWeakTicketWeak
34 --TODO: Move these elsewhere
47import Control.Monad ((<=<))
48import GHC.Base (IO (..), mkWeakNoFinalizer#)
49import GHC.IORef (IORef (..), newIORef, readIORef)
52import System.IO.Unsafe
58-- | A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue'
59-- can be used to get the referred to value without fear of @Nothing,
60-- and 'getFastWeakTicketWeak' can be used to get the weak version.
62-- Implemented by way of special support in the GHCJS RTS, @h$FastWeakTicket@.
63newtype FastWeakTicket a = FastWeakTicket JSVal
65-- | A reference to some value which can be garbage collected if there are only
66-- weak references to the value left.
68-- 'getFastWeakValue' can be used to try and obtain a strong reference to the value.
70-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using
71-- 'getFastWeakTicket' if the value hasn't been collected yet.
73-- Implemented by way of special support in the GHCJS RTS, @h$FastWeak@.
74newtype FastWeak a = FastWeak JSVal
76-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two
77data Val a = Val { unVal :: a }
79-- | Coerce a JSVal that represents the heap object of a value of type @a@ into a value of type @a@
80unsafeFromRawJSVal :: JSVal -> a
81unsafeFromRawJSVal v = unVal (unsafeCoerce v)
83-- | Coerce a heap object of type @a@ into a 'JSVal' which represents that object.
84unsafeToRawJSVal :: a -> JSVal
85unsafeToRawJSVal v = unsafeCoerce (Val v)
87-- | A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue'
88-- can be used to get the referred to value without fear of @Nothing@,
89-- and 'getFastWeakTicketWeak' can be used to get the weak version.
90data FastWeakTicket a = FastWeakTicket
91 { _fastWeakTicket_val :: {-# UNPACK #-} !(IORef a)
92 , _fastWeakTicket_weak :: {-# UNPACK #-} !(Weak (IORef a))
95-- | A reference to some value which can be garbage collected if there are only weak references to the value left.
97-- 'getFastWeakValue' can be used to try and obtain a strong reference to the value.
99-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using 'getFastWeakTicket'
100-- if the value hasn't been collected yet.
102-- Synonymous with 'Weak'.
103type FastWeak a = Weak (IORef a)
106-- | Return the @a@ kept alive by the given 'FastWeakTicket'.
108-- This needs to be in IO so we know that we've relinquished the ticket.
109getFastWeakTicketValue :: FastWeakTicket a -> IO a
110#ifdef GHCJS_FAST_WEAK
111getFastWeakTicketValue t = do
113 return $ unsafeFromRawJSVal v
115foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a -> IO JSVal
117getFastWeakTicketValue = readIORef . _fastWeakTicket_val
120-- | Get the value referred to by a 'FastWeak' if it hasn't yet been collected,
121-- or @Nothing@ if it has been collected.
122getFastWeakValue :: FastWeak a -> IO (Maybe a)
123#ifdef GHCJS_FAST_WEAK
124getFastWeakValue w = do
127 True -> return Nothing
128 False -> return $ Just $ unsafeFromRawJSVal r
130foreign import javascript unsafe "$1 === null" js_isNull :: JSVal -> Bool
132foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.val;" js_weakVal :: FastWeak a -> IO JSVal
134getFastWeakValue = mapM readIORef <=< deRefWeak
137{-# NOINLINE getFastWeakTicket #-}
138-- | Try to create a 'FastWeakTicket' for the given 'FastWeak' which will ensure the value referred
139-- remains alive. Returns @Just@ if the value hasn't been collected
140-- and a ticket can therefore be obtained, @Nothing@ if it's been collected.
141getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))
142#ifdef GHCJS_FAST_WEAK
143getFastWeakTicket w = do
146 True -> return Nothing
147 False -> return $ Just $ FastWeakTicket r
149foreign import javascript unsafe "$r = $1.ticket;" js_weakTicket :: FastWeak a -> IO JSVal
151getFastWeakTicket w = do
152 deRefWeak w >>= \case
153 Nothing -> return Nothing
154 Just v -> return $ Just $ FastWeakTicket
155 { _fastWeakTicket_val = v
156 , _fastWeakTicket_weak = w
160-- | Create a 'FastWeakTicket' directly from a value, creating a 'FastWeak' in the process
161-- which can be obtained with 'getFastWeakTicketValue'.
163-- This function is marked NOINLINE so it is opaque to GHC.
164-- If we do not do this, then GHC will sometimes fuse the constructor away
165-- so any weak references that are attached to the ticket will have their
166-- finalizer run. Using the opaque constructor, GHC does not see the
167-- constructor application, so it behaves like an IORef and cannot be fused away.
169-- The result is also evaluated to WHNF, since forcing a thunk invalidates
170-- the weak pointer to it in some cases.
171{-# NOINLINE mkFastWeakTicket #-}
172mkFastWeakTicket :: a -> IO (FastWeakTicket a)
173-- 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
174-- associated FastWeak to actually be weak
175#ifdef GHCJS_FAST_WEAK
176mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)
178foreign import javascript unsafe "$r = new h$FastWeakTicket($1);" js_fastWeakTicket :: JSVal -> IO (FastWeakTicket a)
180mkFastWeakTicket v = do
182 w <- mkWeakIORefNoFinalizer vr
183 return $ FastWeakTicket
184 { _fastWeakTicket_val = vr
185 , _fastWeakTicket_weak = w
188-- |Make a 'Weak' pointer to an 'IORef', without a finalizer
189mkWeakIORefNoFinalizer :: IORef a -> IO (Weak (IORef a))
190mkWeakIORefNoFinalizer r@(IORef (STRef r#)) = IO $ \s ->
191 case mkWeakNoFinalizer# r# r s of (# s1, w #) -> (# s1, Weak w #)
194-- | Demote a 'FastWeakTicket'; which ensures the value is alive, to a 'FastWeak' which doesn't.
195-- Note that unless the ticket for the same 'FastWeak' is held in some other way
196-- the value might be collected immediately.
197getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)
198-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value
199#ifdef GHCJS_FAST_WEAK
200foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak' :: FastWeakTicket a -> IO (FastWeak a)
201{-# INLINE getFastWeakTicketWeak #-}
202getFastWeakTicketWeak = getFastWeakTicketWeak'
204getFastWeakTicketWeak = return . _fastWeakTicket_weak
207-- | A weak reference that is always empty
208emptyFastWeak :: FastWeak a
209emptyFastWeak = unsafeCoerce w
210 where w :: FastWeak Any
211#ifdef GHCJS_FAST_WEAK
214 w = unsafePerformIO $ do
215 w' <- mkWeakPtr undefined Nothing
219{-# NOINLINE emptyFastWeak #-}
221#ifdef GHCJS_FAST_WEAK
222foreign import javascript unsafe "$r = new h$FastWeak(null);" js_emptyWeak :: FastWeak Any
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list