@@ -52,6 +52,7 @@ import Data.These
5252import Data.Traversable
5353import Data.Type.Coercion
5454import Data.Word
55+import GHC.Exts
5556import GHC.IORef (IORef (..))
5657import GHC.Stack
5758import System.IO.Unsafe
@@ -182,13 +183,85 @@ unsafeNodeId a = unsafePerformIO $ do
182183-- Event
183184--------------------------------------------------------------------------------
184185
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
186259
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)
188261subscribe e s = fst <$> subscribeAndRead e s
189262
190263{-# 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)
192265wrap tag getSpecificSubscribed sub = do
193266 (sln, subd, occ) <- getSpecificSubscribed sub
194267 let es = tag subd
@@ -200,9 +273,6 @@ eventRoot !k !r = Event $ wrap eventSubscribedRoot $ liftIO . getRootSubscribed
200273eventNever :: Event x a
201274eventNever = Event $ \_ -> return (EventSubscription Nothing eventSubscribedNever, Nothing)
202275
203−eventPush :: Push x b a -> Event x a
204−eventPush !p = Event $ wrap eventSubscribedPush $ getPushSubscribed p
205−
206276eventMerge :: (GCompare k, a ~ DMap k Identity) => Merge x k -> Event x a
207277eventMerge !m = Event $ wrap eventSubscribedMerge $ getMergeSubscribed m
208278
@@ -222,7 +292,7 @@ eventDyn :: R.Patch p => Dyn x p -> Event x p
222292eventDyn !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub
223293
224294{-# 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)
226296subscribeCoincidenceInner inner outerHeight subscribedUnsafe = do
227297 subInner <- liftIO $ newSubscriberCoincidenceInner subscribedUnsafe
228298 (subscription@(EventSubscription _ innerSubd), innerOcc) <- subscribeAndRead inner subInner
@@ -251,27 +321,6 @@ data Subscriber x a = Subscriber
251321-- The result is also evaluated to WHNF, since forcing a thunk invalidates
252322-- the weak pointer to it in some cases.
253323
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−
275324newSubscriberHold :: R.Patch p => Hold x p -> IO (Subscriber x p)
276325newSubscriberHold h = return $ Subscriber
277326 { subscriberPropagate = {-# SCC "traverseHold" #-} propagateSubscriberHold h
@@ -440,9 +489,12 @@ propagate a subscribers = withIncreasedDepth $ do
440489-- EventSubscribed
441490--------------------------------------------------------------------------------
442491
443−data EventSubscribed x a = forall b. EventSubscribed
492+toAny :: a -> Any
493+toAny = unsafeCoerce
494+
495+data EventSubscribed x = EventSubscribed
444496 { eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)
445− , eventSubscribedRetained :: {-# NOUNPACK #-} !b
497+ , eventSubscribedRetained :: {-# NOUNPACK #-} !Any
446498#ifdef DEBUG_CYCLES
447499 , eventSubscribedGetParents :: !(IO [Some (EventSubscribed x)]) -- For debugging loops
448500 , eventSubscribedHasOwnHeightRef :: !Bool
@@ -450,10 +502,10 @@ data EventSubscribed x a = forall b. EventSubscribed
450502#endif
451503 }
452504
453−eventSubscribedRoot :: RootSubscribed x a -> EventSubscribed x a
505+eventSubscribedRoot :: RootSubscribed x a -> EventSubscribed x
454506eventSubscribedRoot !r = EventSubscribed
455507 { eventSubscribedHeightRef = zeroRef
456− , eventSubscribedRetained = r
508+ , eventSubscribedRetained = toAny r
457509#ifdef DEBUG_CYCLES
458510 , eventSubscribedGetParents = return []
459511 , eventSubscribedHasOwnHeightRef = False
@@ -461,10 +513,10 @@ eventSubscribedRoot !r = EventSubscribed
461513#endif
462514 }
463515
464−eventSubscribedNever :: EventSubscribed x a
516+eventSubscribedNever :: EventSubscribed x
465517eventSubscribedNever = EventSubscribed
466518 { eventSubscribedHeightRef = zeroRef
467− , eventSubscribedRetained = ()
519+ , eventSubscribedRetained = toAny ()
468520#ifdef DEBUG_CYCLES
469521 , eventSubscribedGetParents = return []
470522 , eventSubscribedHasOwnHeightRef = False
@@ -472,21 +524,10 @@ eventSubscribedNever = EventSubscribed
472524#endif
473525 }
474526
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
487528eventSubscribedMerge !subscribed = EventSubscribed
488529 { eventSubscribedHeightRef = mergeSubscribedHeight subscribed
489− , eventSubscribedRetained = subscribed
530+ , eventSubscribedRetained = toAny subscribed
490531#ifdef DEBUG_CYCLES
491532 , eventSubscribedGetParents = do
492533 ps <- readIORef $ mergeSubscribedParents subscribed
@@ -496,10 +537,10 @@ eventSubscribedMerge !subscribed = EventSubscribed
496537#endif
497538 }
498539
499−eventSubscribedFan :: FanSubscribed x k -> EventSubscribed x a
540+eventSubscribedFan :: FanSubscribed x k -> EventSubscribed x
500541eventSubscribedFan !subscribed = EventSubscribed
501542 { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed
502− , eventSubscribedRetained = subscribed
543+ , eventSubscribedRetained = toAny subscribed
503544#ifdef DEBUG_CYCLES
504545 , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]
505546 , eventSubscribedHasOwnHeightRef = False
@@ -507,10 +548,10 @@ eventSubscribedFan !subscribed = EventSubscribed
507548#endif
508549 }
509550
510−eventSubscribedSwitch :: SwitchSubscribed x a -> EventSubscribed x a
551+eventSubscribedSwitch :: SwitchSubscribed x a -> EventSubscribed x
511552eventSubscribedSwitch !subscribed = EventSubscribed
512553 { eventSubscribedHeightRef = switchSubscribedHeight subscribed
513− , eventSubscribedRetained = subscribed
554+ , eventSubscribedRetained = toAny subscribed
514555#ifdef DEBUG_CYCLES
515556 , eventSubscribedGetParents = do
516557 s <- readIORef $ switchSubscribedCurrentParent subscribed
@@ -520,10 +561,10 @@ eventSubscribedSwitch !subscribed = EventSubscribed
520561#endif
521562 }
522563
523−eventSubscribedCoincidence :: CoincidenceSubscribed x a -> EventSubscribed x a
564+eventSubscribedCoincidence :: CoincidenceSubscribed x a -> EventSubscribed x
524565eventSubscribedCoincidence !subscribed = EventSubscribed
525566 { eventSubscribedHeightRef = coincidenceSubscribedHeight subscribed
526− , eventSubscribedRetained = subscribed
567+ , eventSubscribedRetained = toAny subscribed
527568#ifdef DEBUG_CYCLES
528569 , eventSubscribedGetParents = do
529570 innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed
@@ -535,14 +576,14 @@ eventSubscribedCoincidence !subscribed = EventSubscribed
535576#endif
536577 }
537578
538−getEventSubscribedHeight :: EventSubscribed x a -> IO Height
579+getEventSubscribedHeight :: EventSubscribed x -> IO Height
539580getEventSubscribedHeight es = readIORef $ eventSubscribedHeightRef es
540581
541582#ifdef DEBUG_CYCLES
542−whoCreatedEventSubscribed :: EventSubscribed x a -> IO [String]
583+whoCreatedEventSubscribed :: EventSubscribed x -> IO [String]
543584whoCreatedEventSubscribed = eventSubscribedWhoCreated
544585
545−walkInvalidHeightParents :: EventSubscribed x a -> IO [Some (EventSubscribed x)]
586+walkInvalidHeightParents :: EventSubscribed x -> IO [Some (EventSubscribed x)]
546587walkInvalidHeightParents s0 = do
547588 subscribers <- flip execStateT mempty $ ($ Some.This s0) $ fix $ \loop (Some.This s) -> do
548589 h <- liftIO $ readIORef $ eventSubscribedHeightRef s
@@ -555,19 +596,19 @@ walkInvalidHeightParents s0 = do
555596#endif
556597
557598{-# 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)
559600subscribeHoldEvent = subscribeAndRead . holdEvent
560601
561602--------------------------------------------------------------------------------
562603-- EventSubscription
563604--------------------------------------------------------------------------------
564605
565−data EventSubscription x a = EventSubscription
566− { _eventSubscription_ticket :: !(Maybe (WeakBagTicket (Subscriber x a)))
567− , _eventSubscription_subscribed :: !(EventSubscribed x a)
606+data EventSubscription x = EventSubscription
607+ { _eventSubscription_ticket :: !(Maybe WeakBagTicket)
608+ , _eventSubscription_subscribed :: {-# UNPACK #-} !(EventSubscribed x)
568609 }
569610
570−unsubscribe :: EventSubscription x a -> IO ()
611+unsubscribe :: EventSubscription x -> IO ()
571612unsubscribe (EventSubscription msln _) = forM_ msln $ \sln -> WeakBag.remove sln
572613
573614--------------------------------------------------------------------------------
@@ -675,7 +716,7 @@ data Hold x p
675716 = Hold { holdValue :: !(IORef (R.PatchTarget p))
676717 , holdInvalidators :: !(IORef [Weak (Invalidator x)])
677718 , 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
679720#ifdef DEBUG_NODEIDS
680721 , holdNodeId :: Int
681722#endif
@@ -802,7 +843,7 @@ hold v0 e = do
802843 return h
803844
804845{-# 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)
806847getHoldEventSubscription h = do
807848 ep <- liftIO $ readIORef $ holdParent h
808849 case ep of
@@ -893,24 +934,9 @@ data SomeMergeUpdate x = forall k. GCompare k => SomeMergeUpdate (R.PatchDMap k
893934
894935data SomeMergeInit x = forall k. GCompare k => SomeMergeInit !(MergeSubscribed x k) !(Event x (R.PatchDMap k (Event x)))
895936
896−data SomeEventSubscription x = forall a. SomeEventSubscription (EventSubscription x a)
897−
898937-- EventM can do everything BehaviorM can, plus create holds
899938newtype 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
900939
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−
914940newtype ComputeM x a = ComputeM (ReaderT (IORef [SomeHoldInit x]) IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
915941
916942instance Defer (SomeHoldInit x) (ComputeM x) where
@@ -920,15 +946,9 @@ instance Defer (SomeHoldInit x) (ComputeM x) where
920946runComputeM :: Defer (SomeHoldInit x) m => ComputeM x a -> m a
921947runComputeM (ComputeM a) = liftIO . runReaderT a =<< getDeferralQueue
922948
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)
930950
931−mergeSubscribedParentSubscription :: MergeSubscribedParent x k a -> EventSubscription x a
951+mergeSubscribedParentSubscription :: MergeSubscribedParent x k a -> EventSubscription x
932952mergeSubscribedParentSubscription (MergeSubscribedParent es _) = es
933953
934954data HeightBag = HeightBag
@@ -980,7 +1000,7 @@ data MergeSubscribed x k
9801000 , mergeSubscribedHeight :: !(IORef Height)
9811001 , mergeSubscribedHeightBag :: !(IORef HeightBag)
9821002 , 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))
9841004 , mergeSubscribedParents :: !(IORef (DMap k (MergeSubscribedParent x k)))
9851005 , mergeSubscribedWeakSelf :: !(IORef (Weak (MergeSubscribed x k)))
9861006#ifdef DEBUG_NODEIDS
@@ -1004,7 +1024,7 @@ data FanSubscribed (x :: *) k
10041024 = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k)))
10051025 , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))
10061026 , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k))) -- This DMap should never be empty
1007− , fanSubscribedParent :: !(EventSubscription x (DMap k Identity))
1027+ , fanSubscribedParent :: !(EventSubscription x)
10081028#ifdef DEBUG_NODEIDS
10091029 , fanSubscribedNodeId :: Int
10101030#endif
@@ -1024,7 +1044,7 @@ data SwitchSubscribed x a
10241044 , switchSubscribedOwnWeakInvalidator :: !(IORef (Weak (Invalidator x)))
10251045 , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed x])
10261046 , switchSubscribedParent :: !(Behavior x (Event x a))
1027− , switchSubscribedCurrentParent :: !(IORef (EventSubscription x a))
1047+ , switchSubscribedCurrentParent :: !(IORef (EventSubscription x))
10281048 , switchSubscribedWeakSelf :: !(IORef (Weak (SwitchSubscribed x a)))
10291049#ifdef DEBUG_NODEIDS
10301050 , switchSubscribedNodeId :: Int
@@ -1043,8 +1063,8 @@ data CoincidenceSubscribed x a
10431063 , coincidenceSubscribedSubscribers :: !(WeakBag (Subscriber x a))
10441064 , coincidenceSubscribedHeight :: !(IORef Height)
10451065 , coincidenceSubscribedOuter :: {-# NOUNPACK #-} (Subscriber x (Event x a))
1046− , coincidenceSubscribedOuterParent :: !(EventSubscription x (Event x a))
1047− , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed x a)))
1066+ , coincidenceSubscribedOuterParent :: !(EventSubscription x)
1067+ , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed x)))
10481068 , coincidenceSubscribedWeakSelf :: !(IORef (Weak (CoincidenceSubscribed x a)))
10491069#ifdef DEBUG_NODEIDS
10501070 , coincidenceSubscribedNodeId :: Int
@@ -1120,12 +1140,15 @@ instance Functor (Behavior x) where
11201140
11211141{-# NOINLINE push #-} --TODO: If this is helpful, we can get rid of the unsafeNewIORef and use unsafePerformIO directly
11221142push :: (a -> ComputeM x (Maybe b)) -> Event x a -> Event x b
1143+push f e = cacheEvent (pushCheap f e)
1144+{-
11231145push f e = eventPush $ Push
11241146 { pushCompute = f
11251147 , pushParent = e
11261148 , pushSubscribed = unsafeNewIORef (f, e) Nothing --TODO: Does the use of the tuple here create unnecessary overhead?
11271149 }
11281150-- DISABLED: {- RULES "push/push" forall f g e. push f (push g e) = push (maybe (return Nothing) f <=< g) e #-}
1151+-}
11291152
11301153{-# NOINLINE pull #-}
11311154pull :: BehaviorM x a -> Behavior x a
@@ -1289,7 +1312,7 @@ propagateSubscriberHold h a = do
12891312 iRef <- {-# SCC "iRef" #-} liftIO $ evaluate $ holdInvalidators h
12901313 defer $ {-# SCC "assignment" #-} SomeAssignment vRef iRef v'
12911314
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
12931316
12941317runBehaviorM :: BehaviorM x a -> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]) -> IORef [SomeHoldInit x] -> IO a
12951318runBehaviorM a mwi holdInits = runReaderT (unBehaviorM a) (mwi, holdInits)
@@ -1341,7 +1364,7 @@ type CanSubscribe x m =
13411364 , m ~ EventM x
13421365 )
13431366
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)
13451368getRootSubscribed k r sub = do
13461369 mSubscribed <- readIORef $ rootSubscribed r
13471370 let getOcc = fmap (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r
@@ -1381,58 +1404,11 @@ cleanupRootSubscribed self@(RootSubscribed { rootSubscribedKey = k, rootSubscrib
13811404 modifyIORef' cached $ DMap.delete k
13821405
13831406{-# 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
13851408subscribeRootSubscribed subscribed sub = WeakBag.insert sub (rootSubscribedSubscribers subscribed) (rootSubscribedWeakSelf subscribed) cleanupRootSubscribed
13861409
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)) #-}
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))
1410+{-# SPECIALIZE getMergeSubscribed :: GCompare k => Merge x k -> Subscriber x (DMap k Identity) -> EventM x (WeakBagTicket, 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))
14361412getMergeSubscribed m sub = do
14371413 mSubscribed <- liftIO $ readIORef $ mergeSubscribed m
14381414 case mSubscribed of
@@ -1498,11 +1474,11 @@ cleanupMergeSubscribed subscribed = do
14981474 writeIORef (mergeSubscribedCachedSubscribed subscribed) $ Nothing -- Get rid of the cached subscribed
14991475
15001476{-# 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
15021478subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed
15031479
1504−{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), 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)
1480+{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket, 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)
15061482getFanSubscribed k f sub = do
15071483 mSubscribed <- liftIO $ readIORef $ fanSubscribed f
15081484 case mSubscribed of
@@ -1548,7 +1524,7 @@ cleanupFanSubscribed (k, subscribed) = do
15481524 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers
15491525
15501526{-# 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
15521528subscribeFanSubscribed k subscribed sub = do
15531529 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
15541530 case DMap.lookup k subscribers of
@@ -1560,8 +1536,8 @@ subscribeFanSubscribed k subscribed sub = do
15601536 return sln
15611537 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed
15621538
1563−{-# SPECIALIZE getSwitchSubscribed :: Switch x a -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), 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)
1539+{-# SPECIALIZE getSwitchSubscribed :: Switch x a -> Subscriber x a -> EventM x (WeakBagTicket, 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)
15651541getSwitchSubscribed s sub = do
15661542 mSubscribed <- liftIO $ readIORef $ switchSubscribed s
15671543 case mSubscribed of
@@ -1613,11 +1589,11 @@ cleanupSwitchSubscribed subscribed = do
16131589 writeIORef (switchSubscribedCachedSubscribed subscribed) Nothing
16141590
16151591{-# 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
16171593subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed
16181594
1619−{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence x a -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), 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)
1595+{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence x a -> Subscriber x a -> EventM x (WeakBagTicket, 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)
16211597getCoincidenceSubscribed c sub = do
16221598 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c
16231599 case mSubscribed of
@@ -1667,7 +1643,7 @@ cleanupCoincidenceSubscribed subscribed = do
16671643 writeIORef (coincidenceSubscribedCachedSubscribed subscribed) Nothing
16681644
16691645{-# 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
16711647subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed
16721648
16731649{-# INLINE merge #-}
@@ -1742,7 +1718,7 @@ runFrame a = SpiderHost $ ask >>= \spiderTimeline -> lift $ do
17421718 writeIORef iRef =<< evaluate =<< invalidate toReconnectRef =<< readIORef iRef
17431719 mergeUpdates <- readIORef mergeUpdateRef
17441720 writeIORef mergeUpdateRef []
1745− let updateMerge :: SomeMergeUpdate x -> IO [SomeEventSubscription x]
1721+ let updateMerge :: SomeMergeUpdate x -> IO [EventSubscription x]
17461722 updateMerge (SomeMergeUpdate (R.PatchDMap p :: R.PatchDMap k (Event x)) m) = do
17471723 oldParents <- readIORef $ mergeSubscribedParents m
17481724 let f (subscriptionsToKill, ps) (k :=> R.ComposeMaybe me) = do
@@ -1758,7 +1734,7 @@ runFrame a = SpiderHost $ ask >>= \spiderTimeline -> lift $ do
17581734 forM_ mOldSubd $ \oldSubd -> do
17591735 oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ mergeSubscribedParentSubscription oldSubd
17601736 liftIO $ removeMergeHeight oldHeight m
1761− return (maybeToList (SomeEventSubscription . mergeSubscribedParentSubscription <$> mOldSubd) ++ subscriptionsToKill, newPs)
1737+ return (maybeToList (mergeSubscribedParentSubscription <$> mOldSubd) ++ subscriptionsToKill, newPs)
17621738 (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
17631739 writeIORef (mergeSubscribedParents m) $! newParents
17641740 return subscriptionsToKill
@@ -1789,9 +1765,9 @@ runFrame a = SpiderHost $ ask >>= \spiderTimeline -> lift $ do
17891765 _ -> "something else"
17901766 -}
17911767 writeIORef (switchSubscribedCurrentParent subscribed) $! subscription
1792− return $ SomeEventSubscription oldSubscription
1793− forM_ mergeSubscriptionsToKill $ \(SomeEventSubscription oldSubscription) -> liftIO $ unsubscribe oldSubscription
1794− forM_ switchSubscriptionsToKill $ \(SomeEventSubscription oldSubscription) -> liftIO $ unsubscribe oldSubscription
1768+ return oldSubscription
1769+ liftIO $ mapM_ unsubscribe mergeSubscriptionsToKill
1770+ liftIO $ mapM_ unsubscribe switchSubscriptionsToKill
17951771 forM_ toReconnect $ \(SomeSwitchSubscribed subscribed) -> {-# SCC "switchSubscribed" #-} do
17961772 EventSubscription _ subd' <- readIORef $ switchSubscribedCurrentParent subscribed
17971773 parentHeight <- getEventSubscribedHeight subd'
@@ -1947,7 +1923,7 @@ globalSpiderTimeline = unsafePerformIO unsafeNewSpiderTimeline
19471923-- | Stores all global data relevant to a particular Spider timeline; only one
19481924-- value should exist for each type @x@
19491925data SpiderTimeline x = SpiderTimeline
1950− { _spiderTimeline_toUnsubscribe :: !(IORef [SomeEventSubscription x])
1926+ { _spiderTimeline_toUnsubscribe :: !(IORef [EventSubscription x])
19511927 , _spiderTimeline_lock :: !(MVar ())
19521928 , _spiderTimeline_cleanups :: !(IORef [IO ()])
19531929#ifdef DEBUG
@@ -2106,7 +2082,7 @@ instance R.MonadHold (SpiderTimeline x) (SpiderPushM x) where
21062082data RootTrigger x a = forall k. GCompare k => RootTrigger (WeakBag (Subscriber x a), IORef (DMap k Identity), k a)
21072083
21082084data SpiderEventHandle x a = SpiderEventHandle
2109− { spiderEventHandleSubscription :: EventSubscription x a
2085+ { spiderEventHandleSubscription :: EventSubscription x
21102086 , spiderEventHandleValue :: IORef (Maybe a)
21112087 }
21122088