aaf3e15 · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Replace 'push' with 'pushCheap' and 'cacheEvent'

aaf3e15Ryan Trinkle10 years ago

src/Data/WeakBag.hs+9−7

compare with develop

unifiedsplit

@@ -1,4 +1,5 @@

1{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE ExistentialQuantification #-}

2-- | This module defines the 'WeakBag' type, which represents a mutable

3-- | This module defines the 'WeakBag' type, which represents a mutable

3-- collection of items that does not cause the items to be retained in memory.

4-- collection of items that does not cause the items to be retained in memory.

4-- This is useful for situations where a value needs to be inspected or modified

5-- This is useful for situations where a value needs to be inspected or modified

@@ -36,7 +37,7 @@ data WeakBag a = WeakBag

36-- the caller retains the ticket, the item is guranteed to stay in memory (and

37-- the caller retains the ticket, the item is guranteed to stay in memory (and

37-- thus in the 'WeakBag'). The ticket can also be used to remove the item from

38-- thus in the 'WeakBag'). The ticket can also be used to remove the item from

38-- the 'WeakBag' prematurely (i.e. while it is still alive), using 'remove'.

39-- the 'WeakBag' prematurely (i.e. while it is still alive), using 'remove'.

39−data WeakBagTicket a = WeakBagTicket

40+data WeakBagTicket = forall a. WeakBagTicket

40 { _weakBagTicket_weakItem :: {-# UNPACK #-} !(Weak a)

41 { _weakBagTicket_weakItem :: {-# UNPACK #-} !(Weak a)

41 , _weakBagTicket_item :: {-# NOUNPACK #-} !a

42 , _weakBagTicket_item :: {-# NOUNPACK #-} !a

42 }

43 }

@@ -50,9 +51,8 @@ insert :: a -- ^ The item

50 -> (b -> IO ()) -- ^ A callback to be invoked when the item is removed

51 -> (b -> IO ()) -- ^ A callback to be invoked when the item is removed

51 -- (whether automatically by the item being garbage

52 -- (whether automatically by the item being garbage

52 -- collected or manually via 'remove')

53 -- collected or manually via 'remove')

53− -> IO (WeakBagTicket a) -- ^ Returns a 'WeakBagTicket' that ensures the

54+ -> IO WeakBagTicket -- ^ Returns a 'WeakBagTicket' that ensures the item

54− -- item is retained and allows the item to be

55+ -- is retained and allows the item to be removed.

55− -- removed.

56insert a (WeakBag nextId children) wbRef finalizer = {-# SCC "insert" #-} do

57 a' <- evaluate a

58 wbRef' <- evaluate wbRef

@@ -89,7 +89,7 @@ empty = {-# SCC "empty" #-} do

89-- | Create a 'WeakBag' with one item; equivalent to creating the 'WeakBag' with

90-- 'empty', then using 'insert'.

91{-# INLINE singleton #-}

92−singleton :: a -> IORef (Weak b) -> (b -> IO ()) -> IO (WeakBag a, WeakBagTicket a)

92+singleton :: a -> IORef (Weak b) -> (b -> IO ()) -> IO (WeakBag a, WeakBagTicket)

93singleton a wbRef finalizer = {-# SCC "singleton" #-} do

94 bag <- empty

95 ticket <- insert a bag wbRef finalizer

@@ -110,6 +110,8 @@ traverse (WeakBag _ children) f = {-# SCC "traverse" #-} do

110-- | Remove an item from the 'WeakBag'; does nothing if invoked multiple times

111-- on the same 'WeakBagTicket'.

112{-# INLINE remove #-}

113−remove :: WeakBagTicket a -> IO ()

113+remove :: WeakBagTicket -> IO ()

114−remove = {-# SCC "remove" #-} finalize . _weakBagTicket_weakItem

114+remove (WeakBagTicket w _) = {-# SCC "remove" #-} finalize w

115--TODO: Should 'remove' also drop the reference to the item?

116+

117+--TODO: can/should we provide a null WeakBagTicket?

src/Reflex/Spider/Internal.hs+136−160

@@ -52,6 +52,7 @@ import Data.These

52import Data.Traversable

53import Data.Type.Coercion

54import Data.Word

55+import GHC.Exts

55import GHC.IORef (IORef (..))

56import GHC.IORef (IORef (..))

56import GHC.Stack

57import GHC.Stack

57import System.IO.Unsafe

58import System.IO.Unsafe

@@ -182,13 +183,85 @@ unsafeNodeId a = unsafePerformIO $ do

182-- Event

183-- Event

183--------------------------------------------------------------------------------

184--------------------------------------------------------------------------------

184

185

185−newtype Event x a = Event { subscribeAndRead :: Subscriber x a -> EventM x (EventSubscription x a, Maybe a) }

186+newtype Event x a = Event { subscribeAndRead :: Subscriber x a -> EventM x (EventSubscription x, Maybe a) }

187+

188+-- | Construct an 'Event' equivalent to that constructed by 'push', but with no

189+-- caching; if the computation function is very cheap, this is (much) more

190+-- efficient than 'push'

191+pushCheap :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b

192+pushCheap f e = Event $ \sub -> do

193+ (subscription, occ) <- subscribeAndRead e $ sub

194+ { subscriberPropagate = \a -> do

195+ mb <- runComputeM $ f a

196+ mapM_ (subscriberPropagate sub) mb

197+ }

198+ occ' <- join <$> mapM (runComputeM . f) occ

199+ return (subscription, occ')

200+

201+data CacheSubscribed x a

202+ = CacheSubscribed { _cacheSubscribed_subscribers :: {-# UNPACK #-} !(WeakBag (Subscriber x a))

203+ , _cacheSubscribed_weakSelf :: {-# UNPACK #-} !(IORef (Weak (CacheSubscribed x a)))

204+ , _cacheSubscribed_parent :: {-# UNPACK #-} !(EventSubscription x)

205+ , _cacheSubscribed_cached :: {-# UNPACK #-} !(IORef (Maybe (CacheSubscribed x a)))

206+ , _cacheSubscribed_occurrence :: {-# UNPACK #-} !(IORef (Maybe a))

207+ }

208+

209+-- | Construct an 'Event' whose value is guaranteed not to be recomputed

210+-- repeatedly

211+--

212+--TODO: Try a caching strategy where we subscribe directly to the parent when

213+--there's only one subscriber, and then build our own WeakBag only when a second

214+--subscriber joins

215+cacheEvent :: Event x a -> Event x a

216+cacheEvent e = Event $ \sub -> do

217+ let !mSubscribedRef = unsafeNewIORef e Nothing

218+ mSubscribed <- liftIO $ readIORef mSubscribedRef

219+ case mSubscribed of

220+ Just subscribed -> liftIO $ do

221+ ticket <- WeakBag.insert sub (_cacheSubscribed_subscribers subscribed) (_cacheSubscribed_weakSelf subscribed) cleanupCacheSubscribed

222+ occ <- readIORef $ _cacheSubscribed_occurrence subscribed

223+ let es = EventSubscribed

224+ { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ _cacheSubscribed_parent subscribed

225+ , eventSubscribedRetained = toAny subscribed

226+ }

227+ return (EventSubscription (Just ticket) es, occ)

228+ Nothing -> do

229+ weakSelf <- liftIO $ newIORef $ error "cacheEvent: weakSelf not yet intialized"

230+ (subscribers, ticket) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCacheSubscribed

231+ occRef <- liftIO $ newIORef undefined

232+ (parentSub, occ) <- subscribeAndRead e $ Subscriber

233+ { subscriberPropagate = \a -> do

234+ liftIO $ writeIORef occRef $ Just a

235+ scheduleClear occRef

236+ propagate a subscribers

237+ , subscriberInvalidateHeight = \old -> do

238+ WeakBag.traverse subscribers $ invalidateSubscriberHeight old

239+ , subscriberRecalculateHeight = \new -> do

240+ WeakBag.traverse subscribers $ recalculateSubscriberHeight new

241+ }

242+ liftIO $ writeIORef occRef occ

243+ when (isJust occ) $ scheduleClear occRef

244+ let !subscribed = CacheSubscribed

245+ { _cacheSubscribed_subscribers = subscribers

246+ , _cacheSubscribed_weakSelf = weakSelf

247+ , _cacheSubscribed_parent = parentSub

248+ , _cacheSubscribed_cached = mSubscribedRef

249+ , _cacheSubscribed_occurrence = occRef

250+ }

251+ liftIO $ writeIORef mSubscribedRef $ Just subscribed

252+ liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "PushSubscribed"

253+ return (EventSubscription (Just ticket) (EventSubscribed (eventSubscribedHeightRef $ _eventSubscription_subscribed parentSub) (toAny subscribed)), occ)

254+

255+cleanupCacheSubscribed :: CacheSubscribed x a -> IO ()

256+cleanupCacheSubscribed self = do

257+ unsubscribe $ _cacheSubscribed_parent self

258+ writeIORef (_cacheSubscribed_cached self) Nothing

186

259

187−subscribe :: Event x a -> Subscriber x a -> EventM x (EventSubscription x a)

260+subscribe :: Event x a -> Subscriber x a -> EventM x (EventSubscription x)

188subscribe e s = fst <$> subscribeAndRead e s

261subscribe e s = fst <$> subscribeAndRead e s

189

262

190{-# INLINE wrap #-}

263{-# INLINE wrap #-}

191−wrap :: MonadIO m => (t -> EventSubscribed x a) -> (Subscriber x a -> m (WeakBagTicket (Subscriber x a), t, Maybe a)) -> Subscriber x a -> m (EventSubscription x a, Maybe a)

264+wrap :: MonadIO m => (t -> EventSubscribed x) -> (Subscriber x a -> m (WeakBagTicket, t, Maybe a)) -> Subscriber x a -> m (EventSubscription x, Maybe a)

192wrap tag getSpecificSubscribed sub = do

265wrap tag getSpecificSubscribed sub = do

193 (sln, subd, occ) <- getSpecificSubscribed sub

266 (sln, subd, occ) <- getSpecificSubscribed sub

194 let es = tag subd

267 let es = tag subd

@@ -200,9 +273,6 @@ eventRoot !k !r = Event $ wrap eventSubscribedRoot $ liftIO . getRootSubscribed

200eventNever :: Event x a

273eventNever :: Event x a

201eventNever = Event $ \_ -> return (EventSubscription Nothing eventSubscribedNever, Nothing)

274eventNever = Event $ \_ -> return (EventSubscription Nothing eventSubscribedNever, Nothing)

202

275

203−eventPush :: Push x b a -> Event x a

204−eventPush !p = Event $ wrap eventSubscribedPush $ getPushSubscribed p

205−

206eventMerge :: (GCompare k, a ~ DMap k Identity) => Merge x k -> Event x a

276eventMerge :: (GCompare k, a ~ DMap k Identity) => Merge x k -> Event x a

207eventMerge !m = Event $ wrap eventSubscribedMerge $ getMergeSubscribed m

277eventMerge !m = Event $ wrap eventSubscribedMerge $ getMergeSubscribed m

208

278

@@ -222,7 +292,7 @@ eventDyn :: R.Patch p => Dyn x p -> Event x p

222eventDyn !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub

292eventDyn !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub

223

293

224{-# INLINE subscribeCoincidenceInner #-}

294{-# INLINE subscribeCoincidenceInner #-}

225−subscribeCoincidenceInner :: CanSubscribe x m => Event x a -> Height -> CoincidenceSubscribed x a -> m (Maybe a, Height, EventSubscribed x a)

295+subscribeCoincidenceInner :: CanSubscribe x m => Event x a -> Height -> CoincidenceSubscribed x a -> m (Maybe a, Height, EventSubscribed x)

226subscribeCoincidenceInner inner outerHeight subscribedUnsafe = do

296subscribeCoincidenceInner inner outerHeight subscribedUnsafe = do

227 subInner <- liftIO $ newSubscriberCoincidenceInner subscribedUnsafe

297 subInner <- liftIO $ newSubscriberCoincidenceInner subscribedUnsafe

228 (subscription@(EventSubscription _ innerSubd), innerOcc) <- subscribeAndRead inner subInner

298 (subscription@(EventSubscription _ innerSubd), innerOcc) <- subscribeAndRead inner subInner

@@ -251,27 +321,6 @@ data Subscriber x a = Subscriber

251-- The result is also evaluated to WHNF, since forcing a thunk invalidates

321-- The result is also evaluated to WHNF, since forcing a thunk invalidates

252-- the weak pointer to it in some cases.

322-- the weak pointer to it in some cases.

253

323

254−newSubscriberPush :: (a -> ComputeM x (Maybe b)) -> PushSubscribed x a b -> IO (Subscriber x a)

255−newSubscriberPush compute subscribed = return $ Subscriber

256− { subscriberPropagate = \a -> {-# SCC "traversePush" #-} do

257− tracePropagate $ "SubscriberPush" <> showNodeId subscribed

258− occ <- runComputeM $ compute a

259− case occ of

260− Nothing -> return () -- No need to write a Nothing back into the Ref

261− Just o -> do

262− liftIO $ writeIORef (pushSubscribedOccurrence subscribed) occ

263− scheduleClear $ pushSubscribedOccurrence subscribed

264− propagate o $ pushSubscribedSubscribers subscribed

265− , subscriberInvalidateHeight = \old -> do

266− when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberPush" <> showNodeId subscribed

267− WeakBag.traverse (pushSubscribedSubscribers subscribed) $ invalidateSubscriberHeight old

268− when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberPush" <> showNodeId subscribed <> " done"

269− , subscriberRecalculateHeight = \new -> do

270− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberPush" <> showNodeId subscribed

271− WeakBag.traverse (pushSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new

272− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberPush" <> showNodeId subscribed <> " done"

273− }

274−

275newSubscriberHold :: R.Patch p => Hold x p -> IO (Subscriber x p)

324newSubscriberHold :: R.Patch p => Hold x p -> IO (Subscriber x p)

276newSubscriberHold h = return $ Subscriber

325newSubscriberHold h = return $ Subscriber

277 { subscriberPropagate = {-# SCC "traverseHold" #-} propagateSubscriberHold h

326 { subscriberPropagate = {-# SCC "traverseHold" #-} propagateSubscriberHold h

@@ -440,9 +489,12 @@ propagate a subscribers = withIncreasedDepth $ do

440-- EventSubscribed

489-- EventSubscribed

441--------------------------------------------------------------------------------

490--------------------------------------------------------------------------------

442

491

492+toAny :: a -> Any

493+toAny = unsafeCoerce

494+

443−data EventSubscribed x a = forall b. EventSubscribed

495+data EventSubscribed x = EventSubscribed

444 { eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)

496 { eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)

445− , eventSubscribedRetained :: {-# NOUNPACK #-} !b

497+ , eventSubscribedRetained :: {-# NOUNPACK #-} !Any

446#ifdef DEBUG_CYCLES

498#ifdef DEBUG_CYCLES

447 , eventSubscribedGetParents :: !(IO [Some (EventSubscribed x)]) -- For debugging loops

499 , eventSubscribedGetParents :: !(IO [Some (EventSubscribed x)]) -- For debugging loops

448 , eventSubscribedHasOwnHeightRef :: !Bool

500 , eventSubscribedHasOwnHeightRef :: !Bool

@@ -450,10 +502,10 @@ data EventSubscribed x a = forall b. EventSubscribed

450#endif

502#endif

451 }

503 }

452

504

453−eventSubscribedRoot :: RootSubscribed x a -> EventSubscribed x a

505+eventSubscribedRoot :: RootSubscribed x a -> EventSubscribed x

454eventSubscribedRoot !r = EventSubscribed

506eventSubscribedRoot !r = EventSubscribed

455 { eventSubscribedHeightRef = zeroRef

507 { eventSubscribedHeightRef = zeroRef

456− , eventSubscribedRetained = r

508+ , eventSubscribedRetained = toAny r

457#ifdef DEBUG_CYCLES

509#ifdef DEBUG_CYCLES

458 , eventSubscribedGetParents = return []

510 , eventSubscribedGetParents = return []

459 , eventSubscribedHasOwnHeightRef = False

511 , eventSubscribedHasOwnHeightRef = False

@@ -461,10 +513,10 @@ eventSubscribedRoot !r = EventSubscribed

461#endif

513#endif

462 }

514 }

463

515

464−eventSubscribedNever :: EventSubscribed x a

516+eventSubscribedNever :: EventSubscribed x

465eventSubscribedNever = EventSubscribed

517eventSubscribedNever = EventSubscribed

466 { eventSubscribedHeightRef = zeroRef

518 { eventSubscribedHeightRef = zeroRef

467− , eventSubscribedRetained = ()

519+ , eventSubscribedRetained = toAny ()

468#ifdef DEBUG_CYCLES

520#ifdef DEBUG_CYCLES

469 , eventSubscribedGetParents = return []

521 , eventSubscribedGetParents = return []

470 , eventSubscribedHasOwnHeightRef = False

522 , eventSubscribedHasOwnHeightRef = False

@@ -472,21 +524,10 @@ eventSubscribedNever = EventSubscribed

472#endif

524#endif

473 }

525 }

474

526

475−eventSubscribedPush :: PushSubscribed x b a -> EventSubscribed x a

476−eventSubscribedPush !subscribed = EventSubscribed

477− { eventSubscribedHeightRef = pushSubscribedHeight subscribed

478− , eventSubscribedRetained = subscribed

479−#ifdef DEBUG_CYCLES

480− , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ pushSubscribedParent subscribed]

481− , eventSubscribedHasOwnHeightRef = False

482− , eventSubscribedWhoCreated = whoCreatedIORef $ pushSubscribedCachedSubscribed subscribed

483−#endif

484− }

485−

486−eventSubscribedMerge :: MergeSubscribed x k -> EventSubscribed x a

527+eventSubscribedMerge :: MergeSubscribed x k -> EventSubscribed x

487eventSubscribedMerge !subscribed = EventSubscribed

528eventSubscribedMerge !subscribed = EventSubscribed

488 { eventSubscribedHeightRef = mergeSubscribedHeight subscribed

529 { eventSubscribedHeightRef = mergeSubscribedHeight subscribed

489− , eventSubscribedRetained = subscribed

530+ , eventSubscribedRetained = toAny subscribed

490#ifdef DEBUG_CYCLES

531#ifdef DEBUG_CYCLES

491 , eventSubscribedGetParents = do

532 , eventSubscribedGetParents = do

492 ps <- readIORef $ mergeSubscribedParents subscribed

533 ps <- readIORef $ mergeSubscribedParents subscribed

@@ -496,10 +537,10 @@ eventSubscribedMerge !subscribed = EventSubscribed

496#endif

537#endif

497 }

538 }

498

539

499−eventSubscribedFan :: FanSubscribed x k -> EventSubscribed x a

540+eventSubscribedFan :: FanSubscribed x k -> EventSubscribed x

500eventSubscribedFan !subscribed = EventSubscribed

541eventSubscribedFan !subscribed = EventSubscribed

501 { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed

542 { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed

502− , eventSubscribedRetained = subscribed

543+ , eventSubscribedRetained = toAny subscribed

503#ifdef DEBUG_CYCLES

544#ifdef DEBUG_CYCLES

504 , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]

545 , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]

505 , eventSubscribedHasOwnHeightRef = False

546 , eventSubscribedHasOwnHeightRef = False

@@ -507,10 +548,10 @@ eventSubscribedFan !subscribed = EventSubscribed

507#endif

548#endif

508 }

549 }

509

550

510−eventSubscribedSwitch :: SwitchSubscribed x a -> EventSubscribed x a

551+eventSubscribedSwitch :: SwitchSubscribed x a -> EventSubscribed x

511eventSubscribedSwitch !subscribed = EventSubscribed

552eventSubscribedSwitch !subscribed = EventSubscribed

512 { eventSubscribedHeightRef = switchSubscribedHeight subscribed

553 { eventSubscribedHeightRef = switchSubscribedHeight subscribed

513− , eventSubscribedRetained = subscribed

554+ , eventSubscribedRetained = toAny subscribed

514#ifdef DEBUG_CYCLES

555#ifdef DEBUG_CYCLES

515 , eventSubscribedGetParents = do

556 , eventSubscribedGetParents = do

516 s <- readIORef $ switchSubscribedCurrentParent subscribed

557 s <- readIORef $ switchSubscribedCurrentParent subscribed

@@ -520,10 +561,10 @@ eventSubscribedSwitch !subscribed = EventSubscribed

520#endif

561#endif

521 }

562 }

522

563

523−eventSubscribedCoincidence :: CoincidenceSubscribed x a -> EventSubscribed x a

564+eventSubscribedCoincidence :: CoincidenceSubscribed x a -> EventSubscribed x

524eventSubscribedCoincidence !subscribed = EventSubscribed

565eventSubscribedCoincidence !subscribed = EventSubscribed

525 { eventSubscribedHeightRef = coincidenceSubscribedHeight subscribed

566 { eventSubscribedHeightRef = coincidenceSubscribedHeight subscribed

526− , eventSubscribedRetained = subscribed

567+ , eventSubscribedRetained = toAny subscribed

527#ifdef DEBUG_CYCLES

568#ifdef DEBUG_CYCLES

528 , eventSubscribedGetParents = do

569 , eventSubscribedGetParents = do

529 innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed

570 innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed

@@ -535,14 +576,14 @@ eventSubscribedCoincidence !subscribed = EventSubscribed

535#endif

576#endif

536 }

577 }

537

578

538−getEventSubscribedHeight :: EventSubscribed x a -> IO Height

579+getEventSubscribedHeight :: EventSubscribed x -> IO Height

539getEventSubscribedHeight es = readIORef $ eventSubscribedHeightRef es

580getEventSubscribedHeight es = readIORef $ eventSubscribedHeightRef es

540

581

541#ifdef DEBUG_CYCLES

582#ifdef DEBUG_CYCLES

542−whoCreatedEventSubscribed :: EventSubscribed x a -> IO [String]

583+whoCreatedEventSubscribed :: EventSubscribed x -> IO [String]

543whoCreatedEventSubscribed = eventSubscribedWhoCreated

584whoCreatedEventSubscribed = eventSubscribedWhoCreated

544

585

545−walkInvalidHeightParents :: EventSubscribed x a -> IO [Some (EventSubscribed x)]

586+walkInvalidHeightParents :: EventSubscribed x -> IO [Some (EventSubscribed x)]

546walkInvalidHeightParents s0 = do

587walkInvalidHeightParents s0 = do

547 subscribers <- flip execStateT mempty $ ($ Some.This s0) $ fix $ \loop (Some.This s) -> do

588 subscribers <- flip execStateT mempty $ ($ Some.This s0) $ fix $ \loop (Some.This s) -> do

548 h <- liftIO $ readIORef $ eventSubscribedHeightRef s

589 h <- liftIO $ readIORef $ eventSubscribedHeightRef s

@@ -555,19 +596,19 @@ walkInvalidHeightParents s0 = do

555#endif

596#endif

556

597

557{-# INLINE subscribeHoldEvent #-}

598{-# INLINE subscribeHoldEvent #-}

558−subscribeHoldEvent :: CanSubscribe x m => Hold x p -> Subscriber x p -> m (EventSubscription x p, Maybe p)

599+subscribeHoldEvent :: CanSubscribe x m => Hold x p -> Subscriber x p -> m (EventSubscription x, Maybe p)

559subscribeHoldEvent = subscribeAndRead . holdEvent

600subscribeHoldEvent = subscribeAndRead . holdEvent

560

601

561--------------------------------------------------------------------------------

602--------------------------------------------------------------------------------

562-- EventSubscription

603-- EventSubscription

563--------------------------------------------------------------------------------

604--------------------------------------------------------------------------------

564

605

565−data EventSubscription x a = EventSubscription

606+data EventSubscription x = EventSubscription

566− { _eventSubscription_ticket :: !(Maybe (WeakBagTicket (Subscriber x a)))

607+ { _eventSubscription_ticket :: !(Maybe WeakBagTicket)

567− , _eventSubscription_subscribed :: !(EventSubscribed x a)

608+ , _eventSubscription_subscribed :: {-# UNPACK #-} !(EventSubscribed x)

568 }

609 }

569

610

570−unsubscribe :: EventSubscription x a -> IO ()

611+unsubscribe :: EventSubscription x -> IO ()

571unsubscribe (EventSubscription msln _) = forM_ msln $ \sln -> WeakBag.remove sln

612unsubscribe (EventSubscription msln _) = forM_ msln $ \sln -> WeakBag.remove sln

572

613

573--------------------------------------------------------------------------------

614--------------------------------------------------------------------------------

@@ -675,7 +716,7 @@ data Hold x p

675 = Hold { holdValue :: !(IORef (R.PatchTarget p))

716 = Hold { holdValue :: !(IORef (R.PatchTarget p))

676 , holdInvalidators :: !(IORef [Weak (Invalidator x)])

717 , holdInvalidators :: !(IORef [Weak (Invalidator x)])

677 , holdEvent :: Event x p -- This must be lazy, or holds cannot be defined before their input Events

718 , holdEvent :: Event x p -- This must be lazy, or holds cannot be defined before their input Events

678− , holdParent :: !(IORef (Maybe (EventSubscription x p))) -- Keeps its parent alive (will be undefined until the hold is initialized) --TODO: Probably shouldn't be an IORef

719+ , holdParent :: !(IORef (Maybe (EventSubscription x))) -- Keeps its parent alive (will be undefined until the hold is initialized) --TODO: Probably shouldn't be an IORef

679#ifdef DEBUG_NODEIDS

720#ifdef DEBUG_NODEIDS

680 , holdNodeId :: Int

721 , holdNodeId :: Int

681#endif

722#endif

@@ -802,7 +843,7 @@ hold v0 e = do

802 return h

843 return h

803

844

804{-# INLINE getHoldEventSubscription #-}

845{-# INLINE getHoldEventSubscription #-}

805−getHoldEventSubscription :: forall m p x. (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer SomeClear m, R.Patch p, HasCurrentHeight x m, Defer (SomeMergeInit x) m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x m, m ~ EventM x) => Hold x p -> m (EventSubscription x p)

846+getHoldEventSubscription :: forall m p x. (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer SomeClear m, R.Patch p, HasCurrentHeight x m, Defer (SomeMergeInit x) m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x m, m ~ EventM x) => Hold x p -> m (EventSubscription x)

806getHoldEventSubscription h = do

847getHoldEventSubscription h = do

807 ep <- liftIO $ readIORef $ holdParent h

848 ep <- liftIO $ readIORef $ holdParent h

808 case ep of

849 case ep of

@@ -893,24 +934,9 @@ data SomeMergeUpdate x = forall k. GCompare k => SomeMergeUpdate (R.PatchDMap k

893

934

894data SomeMergeInit x = forall k. GCompare k => SomeMergeInit !(MergeSubscribed x k) !(Event x (R.PatchDMap k (Event x)))

935data SomeMergeInit x = forall k. GCompare k => SomeMergeInit !(MergeSubscribed x k) !(Event x (R.PatchDMap k (Event x)))

895

936

896−data SomeEventSubscription x = forall a. SomeEventSubscription (EventSubscription x a)

897−

898-- EventM can do everything BehaviorM can, plus create holds

937-- EventM can do everything BehaviorM can, plus create holds

899newtype EventM x (a :: *) = EventM { unEventM :: ReaderT (EventEnv x) IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException) -- The environment should be Nothing if we are not in a frame, and Just if we are - in which case it is a list of assignments to be done after the frame is over

938newtype EventM x (a :: *) = EventM { unEventM :: ReaderT (EventEnv x) IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException) -- The environment should be Nothing if we are not in a frame, and Just if we are - in which case it is a list of assignments to be done after the frame is over

900

939

901−data PushSubscribed x a b

902− = PushSubscribed { pushSubscribedCachedSubscribed :: !(IORef (Maybe (PushSubscribed x a b)))

903− , pushSubscribedOccurrence :: !(IORef (Maybe b)) -- If the current height is less than our height, this should always be Nothing; during our height, this will get filled in at some point, always before our children are notified; after our height, this will be filled in with the correct value (Nothing if we are not firing, Just if we are)

904− , pushSubscribedHeight :: !(IORef Height)

905− , pushSubscribedSubscribers :: !(WeakBag (Subscriber x b))

906− , pushSubscribedSelf :: !(Subscriber x a) -- Hold this in memory to ensure our WeakReferences don't die --TODO: Probably unneeded now

907− , pushSubscribedWeakSelf :: !(IORef (Weak (PushSubscribed x a b)))

908− , pushSubscribedParent :: !(EventSubscription x a)

909−#ifdef DEBUG_NODEIDS

910− , pushSubscribedNodeId :: Int

911−#endif

912− }

913−

914newtype ComputeM x a = ComputeM (ReaderT (IORef [SomeHoldInit x]) IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

940newtype ComputeM x a = ComputeM (ReaderT (IORef [SomeHoldInit x]) IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

915

941

916instance Defer (SomeHoldInit x) (ComputeM x) where

942instance Defer (SomeHoldInit x) (ComputeM x) where

@@ -920,15 +946,9 @@ instance Defer (SomeHoldInit x) (ComputeM x) where

920runComputeM :: Defer (SomeHoldInit x) m => ComputeM x a -> m a

946runComputeM :: Defer (SomeHoldInit x) m => ComputeM x a -> m a

921runComputeM (ComputeM a) = liftIO . runReaderT a =<< getDeferralQueue

947runComputeM (ComputeM a) = liftIO . runReaderT a =<< getDeferralQueue

922

948

923−data Push x a b

924− = Push { pushCompute :: !(a -> ComputeM x (Maybe b)) -- Compute the current firing value; assumes that its parent has been computed --TODO: This only uses Defer SomeHoldInit EventM; perhaps only the hold init queue should be passed in (also, perhaps those hold inits can be accelerated - can there be a loop we would need to worry about?)

925− , pushParent :: !(Event x a)

926− , pushSubscribed :: !(IORef (Maybe (PushSubscribed x a b))) --TODO: Can we replace this with an unsafePerformIO thunk?

927− }

928−

929−data MergeSubscribedParent (x :: *) k a = MergeSubscribedParent !(EventSubscription x a) !(Subscriber x a)

949+data MergeSubscribedParent (x :: *) k a = MergeSubscribedParent !(EventSubscription x) !(Subscriber x a)

930

950

931−mergeSubscribedParentSubscription :: MergeSubscribedParent x k a -> EventSubscription x a

951+mergeSubscribedParentSubscription :: MergeSubscribedParent x k a -> EventSubscription x

932mergeSubscribedParentSubscription (MergeSubscribedParent es _) = es

952mergeSubscribedParentSubscription (MergeSubscribedParent es _) = es

933

953

934data HeightBag = HeightBag

954data HeightBag = HeightBag

@@ -980,7 +1000,7 @@ data MergeSubscribed x k

980 , mergeSubscribedHeight :: !(IORef Height)

1000 , mergeSubscribedHeight :: !(IORef Height)

981 , mergeSubscribedHeightBag :: !(IORef HeightBag)

1001 , mergeSubscribedHeightBag :: !(IORef HeightBag)

982 , mergeSubscribedSubscribers :: !(WeakBag (Subscriber x (DMap k Identity)))

1002 , mergeSubscribedSubscribers :: !(WeakBag (Subscriber x (DMap k Identity)))

983− , mergeSubscribedChange :: !(IORef (Subscriber x (R.PatchDMap k (Event x)), EventSubscribed x (R.PatchDMap k (Event x))))

1003+ , mergeSubscribedChange :: !(IORef (Subscriber x (R.PatchDMap k (Event x)), EventSubscribed x))

984 , mergeSubscribedParents :: !(IORef (DMap k (MergeSubscribedParent x k)))

1004 , mergeSubscribedParents :: !(IORef (DMap k (MergeSubscribedParent x k)))

985 , mergeSubscribedWeakSelf :: !(IORef (Weak (MergeSubscribed x k)))

1005 , mergeSubscribedWeakSelf :: !(IORef (Weak (MergeSubscribed x k)))

986#ifdef DEBUG_NODEIDS

1006#ifdef DEBUG_NODEIDS

@@ -1004,7 +1024,7 @@ data FanSubscribed (x :: *) k

1004 = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k)))

1024 = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k)))

1005 , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))

1025 , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))

1006 , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k))) -- This DMap should never be empty

1026 , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k))) -- This DMap should never be empty

1007− , fanSubscribedParent :: !(EventSubscription x (DMap k Identity))

1027+ , fanSubscribedParent :: !(EventSubscription x)

1008#ifdef DEBUG_NODEIDS

1028#ifdef DEBUG_NODEIDS

1009 , fanSubscribedNodeId :: Int

1029 , fanSubscribedNodeId :: Int

1010#endif

1030#endif

@@ -1024,7 +1044,7 @@ data SwitchSubscribed x a

1024 , switchSubscribedOwnWeakInvalidator :: !(IORef (Weak (Invalidator x)))

1044 , switchSubscribedOwnWeakInvalidator :: !(IORef (Weak (Invalidator x)))

1025 , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed x])

1045 , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed x])

1026 , switchSubscribedParent :: !(Behavior x (Event x a))

1046 , switchSubscribedParent :: !(Behavior x (Event x a))

1027− , switchSubscribedCurrentParent :: !(IORef (EventSubscription x a))

1047+ , switchSubscribedCurrentParent :: !(IORef (EventSubscription x))

1028 , switchSubscribedWeakSelf :: !(IORef (Weak (SwitchSubscribed x a)))

1048 , switchSubscribedWeakSelf :: !(IORef (Weak (SwitchSubscribed x a)))

1029#ifdef DEBUG_NODEIDS

1049#ifdef DEBUG_NODEIDS

1030 , switchSubscribedNodeId :: Int

1050 , switchSubscribedNodeId :: Int

@@ -1043,8 +1063,8 @@ data CoincidenceSubscribed x a

1043 , coincidenceSubscribedSubscribers :: !(WeakBag (Subscriber x a))

1063 , coincidenceSubscribedSubscribers :: !(WeakBag (Subscriber x a))

1044 , coincidenceSubscribedHeight :: !(IORef Height)

1064 , coincidenceSubscribedHeight :: !(IORef Height)

1045 , coincidenceSubscribedOuter :: {-# NOUNPACK #-} (Subscriber x (Event x a))

1065 , coincidenceSubscribedOuter :: {-# NOUNPACK #-} (Subscriber x (Event x a))

1046− , coincidenceSubscribedOuterParent :: !(EventSubscription x (Event x a))

1066+ , coincidenceSubscribedOuterParent :: !(EventSubscription x)

1047− , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed x a)))

1067+ , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed x)))

1048 , coincidenceSubscribedWeakSelf :: !(IORef (Weak (CoincidenceSubscribed x a)))

1068 , coincidenceSubscribedWeakSelf :: !(IORef (Weak (CoincidenceSubscribed x a)))

1049#ifdef DEBUG_NODEIDS

1069#ifdef DEBUG_NODEIDS

1050 , coincidenceSubscribedNodeId :: Int

1070 , coincidenceSubscribedNodeId :: Int

@@ -1120,12 +1140,15 @@ instance Functor (Behavior x) where

1120

1140

1121{-# NOINLINE push #-} --TODO: If this is helpful, we can get rid of the unsafeNewIORef and use unsafePerformIO directly

1141{-# NOINLINE push #-} --TODO: If this is helpful, we can get rid of the unsafeNewIORef and use unsafePerformIO directly

1122push :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b

1142push :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b

1143+push f e = cacheEvent (pushCheap f e)

1144+{-

1123push f e = eventPush $ Push

1145push f e = eventPush $ Push

1124 { pushCompute = f

1146 { pushCompute = f

1125 , pushParent = e

1147 , pushParent = e

1126 , pushSubscribed = unsafeNewIORef (f, e) Nothing --TODO: Does the use of the tuple here create unnecessary overhead?

1148 , pushSubscribed = unsafeNewIORef (f, e) Nothing --TODO: Does the use of the tuple here create unnecessary overhead?

1127 }

1149 }

1128-- DISABLED: {- RULES "push/push" forall f g e. push f (push g e) = push (maybe (return Nothing) f <=< g) e #-}

1150-- DISABLED: {- RULES "push/push" forall f g e. push f (push g e) = push (maybe (return Nothing) f <=< g) e #-}

1151+-}

1129

1152

1130{-# NOINLINE pull #-}

1153{-# NOINLINE pull #-}

1131pull :: BehaviorM x a -> Behavior x a

1154pull :: BehaviorM x a -> Behavior x a

@@ -1289,7 +1312,7 @@ propagateSubscriberHold h a = do

1289 iRef <- {-# SCC "iRef" #-} liftIO $ evaluate $ holdInvalidators h

1312 iRef <- {-# SCC "iRef" #-} liftIO $ evaluate $ holdInvalidators h

1290 defer $ {-# SCC "assignment" #-} SomeAssignment vRef iRef v'

1313 defer $ {-# SCC "assignment" #-} SomeAssignment vRef iRef v'

1291

1314

1292−data SomeResetCoincidence x = forall a. SomeResetCoincidence !(EventSubscription x a) !(Maybe (CoincidenceSubscribed x a)) -- The CoincidenceSubscriber will be present only if heights need to be reset

1315+data SomeResetCoincidence x = forall a. SomeResetCoincidence !(EventSubscription x) !(Maybe (CoincidenceSubscribed x a)) -- The CoincidenceSubscriber will be present only if heights need to be reset

1293

1316

1294runBehaviorM :: BehaviorM x a -> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]) -> IORef [SomeHoldInit x] -> IO a

1317runBehaviorM :: BehaviorM x a -> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]) -> IORef [SomeHoldInit x] -> IO a

1295runBehaviorM a mwi holdInits = runReaderT (unBehaviorM a) (mwi, holdInits)

1318runBehaviorM a mwi holdInits = runReaderT (unBehaviorM a) (mwi, holdInits)

@@ -1341,7 +1364,7 @@ type CanSubscribe x m =

1341 , m ~ EventM x

1364 , m ~ EventM x

1342 )

1365 )

1343

1366

1344−getRootSubscribed :: GCompare k => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a), RootSubscribed x a, Maybe a)

1367+getRootSubscribed :: GCompare k => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket, RootSubscribed x a, Maybe a)

1345getRootSubscribed k r sub = do

1368getRootSubscribed k r sub = do

1346 mSubscribed <- readIORef $ rootSubscribed r

1369 mSubscribed <- readIORef $ rootSubscribed r

1347 let getOcc = fmap (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r

1370 let getOcc = fmap (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r

@@ -1381,58 +1404,11 @@ cleanupRootSubscribed self@(RootSubscribed { rootSubscribedKey = k, rootSubscrib

1381 modifyIORef' cached $ DMap.delete k

1404 modifyIORef' cached $ DMap.delete k

1382

1405

1383{-# INLINE subscribeRootSubscribed #-}

1406{-# INLINE subscribeRootSubscribed #-}

1384−subscribeRootSubscribed :: RootSubscribed x a -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a))

1407+subscribeRootSubscribed :: RootSubscribed x a -> Subscriber x a -> IO WeakBagTicket

1385subscribeRootSubscribed subscribed sub = WeakBag.insert sub (rootSubscribedSubscribers subscribed) (rootSubscribedWeakSelf subscribed) cleanupRootSubscribed

1408subscribeRootSubscribed subscribed sub = WeakBag.insert sub (rootSubscribedSubscribers subscribed) (rootSubscribedWeakSelf subscribed) cleanupRootSubscribed

1386

1409

1387−-- When getPushSubscribed returns, the PushSubscribed returned will have a fully filled-in

1388−{-# SPECIALIZE getPushSubscribed :: Push x a b -> Subscriber x b -> EventM x (WeakBagTicket (Subscriber x b), PushSubscribed x a b, Maybe b) #-}

1389−getPushSubscribed :: CanSubscribe x m => Push x a b -> Subscriber x b -> m (WeakBagTicket (Subscriber x b), PushSubscribed x a b, Maybe b)

1390−getPushSubscribed p sub = do

1391− mSubscribed <- liftIO $ readIORef $ pushSubscribed p

1392− case mSubscribed of

1393− Just subscribed -> {-# SCC "hitPush" #-} liftIO $ do

1394− sln <- subscribePushSubscribed subscribed sub

1395− occ <- readIORef $ pushSubscribedOccurrence subscribed

1396− return (sln, subscribed, occ)

1397− Nothing -> {-# SCC "missPush" #-} do -- Not yet subscribed

1398− subscribedRef <- liftIO $ newIORef $ error "getPushSubscribed: subscribed not yet intialized"

1399− subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef

1400− s <- liftIO $ newSubscriberPush (pushCompute p) subscribedUnsafe

1401− (subscription@(EventSubscription _ subd), parentOcc) <- subscribeAndRead (pushParent p) s

1402− occ <- runComputeM $ join <$> mapM (pushCompute p) parentOcc

1403− occRef <- liftIO $ newIORef occ

1404− when (isJust occ) $ scheduleClear occRef

1405− weakSelf <- liftIO $ newIORef $ error "getPushSubscribed: weakSelf not initialized"

1406− let !cached = pushSubscribed p

1407− (subs, sln) <- liftIO $ WeakBag.singleton sub weakSelf cleanupPushSubscribed

1408− let subscribed = PushSubscribed

1409− { pushSubscribedCachedSubscribed = cached

1410− , pushSubscribedOccurrence = occRef

1411− , pushSubscribedHeight = eventSubscribedHeightRef subd -- Since pushes have the same height as their parents, share the ref

1412− , pushSubscribedSubscribers = subs

1413− , pushSubscribedSelf = s

1414− , pushSubscribedWeakSelf = weakSelf

1415− , pushSubscribedParent = subscription

1416−#ifdef DEBUG_NODEIDS

1417− , pushSubscribedNodeId = unsafeNodeId p

1418−#endif

1419− }

1420− liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "PushSubscribed"

1421− liftIO $ writeIORef subscribedRef $! subscribed

1422− liftIO $ writeIORef (pushSubscribed p) $ Just subscribed

1423− return (sln, subscribed, occ)

1424−

1425−cleanupPushSubscribed :: PushSubscribed x a b -> IO ()

1426−cleanupPushSubscribed self = do

1427− unsubscribe $ pushSubscribedParent self

1428− writeIORef (pushSubscribedCachedSubscribed self) $ Nothing

1429−

1430−{-# INLINE subscribePushSubscribed #-}

1431−subscribePushSubscribed :: PushSubscribed x a b -> Subscriber x b -> IO (WeakBagTicket (Subscriber x b))

1432−subscribePushSubscribed subscribed sub = WeakBag.insert sub (pushSubscribedSubscribers subscribed) (pushSubscribedWeakSelf subscribed) cleanupPushSubscribed

1433−

1434−{-# SPECIALIZE getMergeSubscribed :: GCompare k => Merge x k -> Subscriber x (DMap k Identity) -> EventM x (WeakBagTicket (Subscriber x (DMap k Identity)), MergeSubscribed x k, Maybe (DMap k Identity)) #-}

1410+{-# SPECIALIZE getMergeSubscribed :: GCompare k => Merge x k -> Subscriber x (DMap k Identity) -> EventM x (WeakBagTicket, MergeSubscribed x k, Maybe (DMap k Identity)) #-}

1435−getMergeSubscribed :: forall x k m. (CanSubscribe x m, GCompare k) => Merge x k -> Subscriber x (DMap k Identity) -> m (WeakBagTicket (Subscriber x (DMap k Identity)), MergeSubscribed x k, Maybe (DMap k Identity))

1411+getMergeSubscribed :: forall x k m. (CanSubscribe x m, GCompare k) => Merge x k -> Subscriber x (DMap k Identity) -> m (WeakBagTicket, MergeSubscribed x k, Maybe (DMap k Identity))

1436getMergeSubscribed m sub = do

1412getMergeSubscribed m sub = do

1437 mSubscribed <- liftIO $ readIORef $ mergeSubscribed m

1413 mSubscribed <- liftIO $ readIORef $ mergeSubscribed m

1438 case mSubscribed of

1414 case mSubscribed of

@@ -1498,11 +1474,11 @@ cleanupMergeSubscribed subscribed = do

1498 writeIORef (mergeSubscribedCachedSubscribed subscribed) $ Nothing -- Get rid of the cached subscribed

1474 writeIORef (mergeSubscribedCachedSubscribed subscribed) $ Nothing -- Get rid of the cached subscribed

1499

1475

1500{-# INLINE subscribeMergeSubscribed #-}

1476{-# INLINE subscribeMergeSubscribed #-}

1501−subscribeMergeSubscribed :: MergeSubscribed x k -> Subscriber x (DMap k Identity) -> IO (WeakBagTicket (Subscriber x (DMap k Identity)))

1477+subscribeMergeSubscribed :: MergeSubscribed x k -> Subscriber x (DMap k Identity) -> IO WeakBagTicket

1502subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed

1478subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed

1503

1479

1504−{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), FanSubscribed x k, Maybe a) #-}

1480+{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket, FanSubscribed x k, Maybe a) #-}

1505−getFanSubscribed :: (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, HasCurrentHeight x m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x m, m ~ EventM x, GCompare k) => k a -> Fan x k -> Subscriber x a -> m (WeakBagTicket (Subscriber x a), FanSubscribed x k, Maybe a)

1481+getFanSubscribed :: (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, HasCurrentHeight x m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x m, m ~ EventM x, GCompare k) => k a -> Fan x k -> Subscriber x a -> m (WeakBagTicket, FanSubscribed x k, Maybe a)

1506getFanSubscribed k f sub = do

1482getFanSubscribed k f sub = do

1507 mSubscribed <- liftIO $ readIORef $ fanSubscribed f

1483 mSubscribed <- liftIO $ readIORef $ fanSubscribed f

1508 case mSubscribed of

1484 case mSubscribed of

@@ -1548,7 +1524,7 @@ cleanupFanSubscribed (k, subscribed) = do

1548 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers

1524 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers

1549

1525

1550{-# INLINE subscribeFanSubscribed #-}

1526{-# INLINE subscribeFanSubscribed #-}

1551−subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a))

1527+subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> Subscriber x a -> IO WeakBagTicket

1552subscribeFanSubscribed k subscribed sub = do

1528subscribeFanSubscribed k subscribed sub = do

1553 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1529 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1554 case DMap.lookup k subscribers of

1530 case DMap.lookup k subscribers of

@@ -1560,8 +1536,8 @@ subscribeFanSubscribed k subscribed sub = do

1560 return sln

1536 return sln

1561 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed

1537 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed

1562

1538

1563−{-# SPECIALIZE getSwitchSubscribed :: Switch x a -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), SwitchSubscribed x a, Maybe a) #-}

1539+{-# SPECIALIZE getSwitchSubscribed :: Switch x a -> Subscriber x a -> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a) #-}

1564−getSwitchSubscribed :: (Defer (SomeHoldInit x) m, Defer (SomeAssignment x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, Defer (SomeResetCoincidence x) m, HasCurrentHeight x m, HasSpiderTimeline x m, m ~ EventM x) => Switch x a -> Subscriber x a -> m (WeakBagTicket (Subscriber x a), SwitchSubscribed x a, Maybe a)

1540+getSwitchSubscribed :: (Defer (SomeHoldInit x) m, Defer (SomeAssignment x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, Defer (SomeResetCoincidence x) m, HasCurrentHeight x m, HasSpiderTimeline x m, m ~ EventM x) => Switch x a -> Subscriber x a -> m (WeakBagTicket, SwitchSubscribed x a, Maybe a)

1565getSwitchSubscribed s sub = do

1541getSwitchSubscribed s sub = do

1566 mSubscribed <- liftIO $ readIORef $ switchSubscribed s

1542 mSubscribed <- liftIO $ readIORef $ switchSubscribed s

1567 case mSubscribed of

1543 case mSubscribed of

@@ -1613,11 +1589,11 @@ cleanupSwitchSubscribed subscribed = do

1613 writeIORef (switchSubscribedCachedSubscribed subscribed) Nothing

1589 writeIORef (switchSubscribedCachedSubscribed subscribed) Nothing

1614

1590

1615{-# INLINE subscribeSwitchSubscribed #-}

1591{-# INLINE subscribeSwitchSubscribed #-}

1616−subscribeSwitchSubscribed :: SwitchSubscribed x a -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a))

1592+subscribeSwitchSubscribed :: SwitchSubscribed x a -> Subscriber x a -> IO WeakBagTicket

1617subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed

1593subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed

1618

1594

1619−{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence x a -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), CoincidenceSubscribed x a, Maybe a) #-}

1595+{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence x a -> Subscriber x a -> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a) #-}

1620−getCoincidenceSubscribed :: forall x a m. (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, HasCurrentHeight x m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x m, m ~ EventM x) => Coincidence x a -> Subscriber x a -> m (WeakBagTicket (Subscriber x a), CoincidenceSubscribed x a, Maybe a)

1596+getCoincidenceSubscribed :: forall x a m. (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, HasCurrentHeight x m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x m, m ~ EventM x) => Coincidence x a -> Subscriber x a -> m (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)

1621getCoincidenceSubscribed c sub = do

1597getCoincidenceSubscribed c sub = do

1622 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c

1598 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c

1623 case mSubscribed of

1599 case mSubscribed of

@@ -1667,7 +1643,7 @@ cleanupCoincidenceSubscribed subscribed = do

1667 writeIORef (coincidenceSubscribedCachedSubscribed subscribed) Nothing

1643 writeIORef (coincidenceSubscribedCachedSubscribed subscribed) Nothing

1668

1644

1669{-# INLINE subscribeCoincidenceSubscribed #-}

1645{-# INLINE subscribeCoincidenceSubscribed #-}

1670−subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a))

1646+subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket

1671subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed

1647subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed

1672

1648

1673{-# INLINE merge #-}

1649{-# INLINE merge #-}

@@ -1742,7 +1718,7 @@ runFrame a = SpiderHost $ ask >>= \spiderTimeline -> lift $ do

1742 writeIORef iRef =<< evaluate =<< invalidate toReconnectRef =<< readIORef iRef

1718 writeIORef iRef =<< evaluate =<< invalidate toReconnectRef =<< readIORef iRef

1743 mergeUpdates <- readIORef mergeUpdateRef

1719 mergeUpdates <- readIORef mergeUpdateRef

1744 writeIORef mergeUpdateRef []

1720 writeIORef mergeUpdateRef []

1745− let updateMerge :: SomeMergeUpdate x -> IO [SomeEventSubscription x]

1721+ let updateMerge :: SomeMergeUpdate x -> IO [EventSubscription x]

1746 updateMerge (SomeMergeUpdate (R.PatchDMap p :: R.PatchDMap k (Event x)) m) = do

1722 updateMerge (SomeMergeUpdate (R.PatchDMap p :: R.PatchDMap k (Event x)) m) = do

1747 oldParents <- readIORef $ mergeSubscribedParents m

1723 oldParents <- readIORef $ mergeSubscribedParents m

1748 let f (subscriptionsToKill, ps) (k :=> R.ComposeMaybe me) = do

1724 let f (subscriptionsToKill, ps) (k :=> R.ComposeMaybe me) = do

@@ -1758,7 +1734,7 @@ runFrame a = SpiderHost $ ask >>= \spiderTimeline -> lift $ do

1758 forM_ mOldSubd $ \oldSubd -> do

1734 forM_ mOldSubd $ \oldSubd -> do

1759 oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ mergeSubscribedParentSubscription oldSubd

1735 oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ mergeSubscribedParentSubscription oldSubd

1760 liftIO $ removeMergeHeight oldHeight m

1736 liftIO $ removeMergeHeight oldHeight m

1761− return (maybeToList (SomeEventSubscription . mergeSubscribedParentSubscription <$> mOldSubd) ++ subscriptionsToKill, newPs)

1737+ return (maybeToList (mergeSubscribedParentSubscription <$> mOldSubd) ++ subscriptionsToKill, newPs)

1762 (subscriptionsToKill, newParents) <- flip runEventM env $ foldM f ([], oldParents) $ DMap.toList p --TODO: I think this runEventM is OK, since no events are firing at this time, but it might not be

1738 (subscriptionsToKill, newParents) <- flip runEventM env $ foldM f ([], oldParents) $ DMap.toList p --TODO: I think this runEventM is OK, since no events are firing at this time, but it might not be

1763 writeIORef (mergeSubscribedParents m) $! newParents

1739 writeIORef (mergeSubscribedParents m) $! newParents

1764 return subscriptionsToKill

1740 return subscriptionsToKill

@@ -1789,9 +1765,9 @@ runFrame a = SpiderHost $ ask >>= \spiderTimeline -> lift $ do

1789 _ -> "something else"

1765 _ -> "something else"

1790 -}

1766 -}

1791 writeIORef (switchSubscribedCurrentParent subscribed) $! subscription

1767 writeIORef (switchSubscribedCurrentParent subscribed) $! subscription

1792− return $ SomeEventSubscription oldSubscription

1768+ return oldSubscription

1793− forM_ mergeSubscriptionsToKill $ \(SomeEventSubscription oldSubscription) -> liftIO $ unsubscribe oldSubscription

1769+ liftIO $ mapM_ unsubscribe mergeSubscriptionsToKill

1794− forM_ switchSubscriptionsToKill $ \(SomeEventSubscription oldSubscription) -> liftIO $ unsubscribe oldSubscription

1770+ liftIO $ mapM_ unsubscribe switchSubscriptionsToKill

1795 forM_ toReconnect $ \(SomeSwitchSubscribed subscribed) -> {-# SCC "switchSubscribed" #-} do

1771 forM_ toReconnect $ \(SomeSwitchSubscribed subscribed) -> {-# SCC "switchSubscribed" #-} do

1796 EventSubscription _ subd' <- readIORef $ switchSubscribedCurrentParent subscribed

1772 EventSubscription _ subd' <- readIORef $ switchSubscribedCurrentParent subscribed

1797 parentHeight <- getEventSubscribedHeight subd'

1773 parentHeight <- getEventSubscribedHeight subd'

@@ -1947,7 +1923,7 @@ globalSpiderTimeline = unsafePerformIO unsafeNewSpiderTimeline

1947-- | Stores all global data relevant to a particular Spider timeline; only one

1923-- | Stores all global data relevant to a particular Spider timeline; only one

1948-- value should exist for each type @x@

1924-- value should exist for each type @x@

1949data SpiderTimeline x = SpiderTimeline

1925data SpiderTimeline x = SpiderTimeline

1950− { _spiderTimeline_toUnsubscribe :: !(IORef [SomeEventSubscription x])

1926+ { _spiderTimeline_toUnsubscribe :: !(IORef [EventSubscription x])

1951 , _spiderTimeline_lock :: !(MVar ())

1927 , _spiderTimeline_lock :: !(MVar ())

1952 , _spiderTimeline_cleanups :: !(IORef [IO ()])

1928 , _spiderTimeline_cleanups :: !(IORef [IO ()])

1953#ifdef DEBUG

1929#ifdef DEBUG

@@ -2106,7 +2082,7 @@ instance R.MonadHold (SpiderTimeline x) (SpiderPushM x) where

2106data RootTrigger x a = forall k. GCompare k => RootTrigger (WeakBag (Subscriber x a), IORef (DMap k Identity), k a)

2082data RootTrigger x a = forall k. GCompare k => RootTrigger (WeakBag (Subscriber x a), IORef (DMap k Identity), k a)

2107

2083

2108data SpiderEventHandle x a = SpiderEventHandle

2084data SpiderEventHandle x a = SpiderEventHandle

2109− { spiderEventHandleSubscription :: EventSubscription x a

2085+ { spiderEventHandleSubscription :: EventSubscription x

2110 , spiderEventHandleValue :: IORef (Maybe a)

2086 , spiderEventHandleValue :: IORef (Maybe a)

2111 }

2087 }

2112

2088