on develop help sign in
Eliminate SubscriberList and SubscriberListTicket
commitf3ffc4ec49863aad059d32b4b806e856f589bf50 authorRyan Trinkle <ryan.trinkle@gmail.com> dateTue 2 Aug 2016, 17:05 (10 years ago) parent763717d
1 file changed+28−31
src/Reflex/Spider/Internal.hs+28−31
src/Reflex/Spider/Internal.hs+28−31
@@ -76,9 +76,6 @@ import qualified Reflex.Host.Class as R
7676-- Note: must come last to silence warnings due to AMP on GHC < 7.10
7777import Prelude hiding (any, concat, mapM, mapM_, sequence)
7878
79−type SubscriberList x a = WeakBag (Subscriber x a)
80−type SubscriberListTicket x a = WeakBagTicket (Subscriber x a)
81−
8279debugPropagate :: Bool
8380
8481debugInvalidateHeight :: Bool
@@ -189,7 +186,7 @@ unsafeNodeId a = unsafePerformIO $ do
189186
190187newtype Event x a = Event { subscribe :: Subscriber x a -> EventM x (EventSubscription x a) }
191188
192−wrap :: Monad m => (t -> EventSubscribed x a) -> (Subscriber x a -> m (SubscriberListTicket x a, t)) -> Subscriber x a -> m (EventSubscription x a)
189+wrap :: Monad m => (t -> EventSubscribed x a) -> (Subscriber x a -> m (WeakBagTicket (Subscriber x a), t)) -> Subscriber x a -> m (EventSubscription x a)
193190wrap tag getSpecificSubscribed sub = do
194191 (sln, subd) <- getSpecificSubscribed sub
195192 return $ EventSubscription (Just sln) $ tag subd
@@ -373,7 +370,7 @@ recalculateSubscriberHeight new s = case s of
373370 SubscriberHandle -> return ()
374371
375372-- | Propagate everything at the current height
376−propagate :: a -> SubscriberList x a -> EventM x ()
373+propagate :: a -> WeakBag (Subscriber x a) -> EventM x ()
377374propagate a subscribers = withIncreasedDepth $ do
378375 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
379376 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
@@ -481,7 +478,7 @@ readEventSubscribed = \case
481478 EventSubscribedCoincidence cs -> readCoincidenceSubscribed cs
482479
483480{-# INLINE subscribeEventSubscribed #-}
484−subscribeEventSubscribed :: EventSubscribed x a -> Subscriber x a -> IO (Maybe (SubscriberListTicket x a))
481+subscribeEventSubscribed :: EventSubscribed x a -> Subscriber x a -> IO (Maybe (WeakBagTicket (Subscriber x a)))
485482subscribeEventSubscribed es sub = case es of
486483 EventSubscribedRoot r -> do
487484 traceSubscribe $ "subscribeEventSubscribed Root"
@@ -582,7 +579,7 @@ subscribeHoldEvent h sub = do
582579--------------------------------------------------------------------------------
583580
584581data EventSubscription x a = EventSubscription
585− { _eventSubscription_ticket :: !(Maybe (SubscriberListTicket x a))
582+ { _eventSubscription_ticket :: !(Maybe (WeakBagTicket (Subscriber x a)))
586583 , _eventSubscription_subscribed :: !(EventSubscribed x a)
587584 }
588585
@@ -796,7 +793,7 @@ data Invalidator x
796793data RootSubscribed x a = forall k. GCompare k => RootSubscribed
797794 { rootSubscribedKey :: !(k a)
798795 , rootSubscribedCachedSubscribed :: !(IORef (DMap k (RootSubscribed x))) -- From the original Root
799− , rootSubscribedSubscribers :: !(SubscriberList x a)
796+ , rootSubscribedSubscribers :: !(WeakBag (Subscriber x a))
800797 , rootSubscribedOccurrence :: !(IO (Maybe a)) -- Lookup from rootOccurrence
801798 , rootSubscribedUninit :: IO ()
802799 , rootSubscribedWeakSelf :: !(IORef (Weak (RootSubscribed x a))) --TODO: Can we make this a lazy non-IORef and then force it manually to avoid an indirection each time we use it?
@@ -826,7 +823,7 @@ data PushSubscribed x a b
826823 = PushSubscribed { pushSubscribedCachedSubscribed :: !(IORef (Maybe (PushSubscribed x a b)))
827824 , 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)
828825 , pushSubscribedHeight :: !(IORef Height)
829− , pushSubscribedSubscribers :: !(SubscriberList x b)
826+ , pushSubscribedSubscribers :: !(WeakBag (Subscriber x b))
830827 , pushSubscribedSelf :: !(Subscriber x a) -- Hold this in memory to ensure our WeakReferences don't die --TODO: Probably unneeded now
831828 , pushSubscribedWeakSelf :: !(IORef (Weak (PushSubscribed x a b)))
832829 , pushSubscribedParent :: !(EventSubscription x a)
@@ -903,7 +900,7 @@ data MergeSubscribed x k
903900 , mergeSubscribedAccum :: !(IORef (DMap k Identity)) -- This will accumulate occurrences until our height is reached, at which point it will be transferred to mergeSubscribedOccurrence
904901 , mergeSubscribedHeight :: !(IORef Height)
905902 , mergeSubscribedHeightBag :: !(IORef HeightBag)
906− , mergeSubscribedSubscribers :: !(SubscriberList x (DMap k Identity))
903+ , mergeSubscribedSubscribers :: !(WeakBag (Subscriber x (DMap k Identity)))
907904 , mergeSubscribedChange :: !(IORef (Subscriber x (R.PatchDMap (DMap k (Event x))), EventSubscribed x (R.PatchDMap (DMap k (Event x)))))
908905 , mergeSubscribedParents :: !(IORef (DMap k (MergeSubscribedParent x k)))
909906 , mergeSubscribedWeakSelf :: !(IORef (Weak (MergeSubscribed x k)))
@@ -919,7 +916,7 @@ data Merge x k
919916 }
920917
921918data FanSubscribedChildren (x :: *) k a = FanSubscribedChildren
922− { _fanSubscribedChildren_list :: !(SubscriberList x a)
919+ { _fanSubscribedChildren_list :: !(WeakBag (Subscriber x a))
923920 , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k)
924921 , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k)))
925922 }
@@ -942,7 +939,7 @@ data SwitchSubscribed x a
942939 = SwitchSubscribed { switchSubscribedCachedSubscribed :: !(IORef (Maybe (SwitchSubscribed x a)))
943940 , switchSubscribedOccurrence :: !(IORef (Maybe a))
944941 , switchSubscribedHeight :: !(IORef Height)
945− , switchSubscribedSubscribers :: !(SubscriberList x a)
942+ , switchSubscribedSubscribers :: !(WeakBag (Subscriber x a))
946943 , switchSubscribedOwnInvalidator :: {-# NOUNPACK #-} !(Invalidator x)
947944 , switchSubscribedOwnWeakInvalidator :: !(IORef (Weak (Invalidator x)))
948945 , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed x])
@@ -963,7 +960,7 @@ data Switch x a
963960data CoincidenceSubscribed x a
964961 = CoincidenceSubscribed { coincidenceSubscribedCachedSubscribed :: !(IORef (Maybe (CoincidenceSubscribed x a)))
965962 , coincidenceSubscribedOccurrence :: !(IORef (Maybe a))
966− , coincidenceSubscribedSubscribers :: !(SubscriberList x a)
963+ , coincidenceSubscribedSubscribers :: !(WeakBag (Subscriber x a))
967964 , coincidenceSubscribedHeight :: !(IORef Height)
968965 , coincidenceSubscribedOuter :: {-# NOUNPACK #-} (Subscriber x (Event x a))
969966 , coincidenceSubscribedOuterParent :: !(EventSubscription x (Event x a))
@@ -1405,7 +1402,7 @@ type CanSubscribe x m =
14051402 , m ~ EventM x
14061403 )
14071404
1408−getRootSubscribed :: GCompare k => k a -> Root x k -> Subscriber x a -> IO (SubscriberListTicket x a, RootSubscribed x a)
1405+getRootSubscribed :: GCompare k => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a), RootSubscribed x a)
14091406getRootSubscribed k r sub = do
14101407 mSubscribed <- readIORef $ rootSubscribed r
14111408 case DMap.lookup k mSubscribed of
@@ -1442,12 +1439,12 @@ cleanupRootSubscribed self@(RootSubscribed { rootSubscribedKey = k, rootSubscrib
14421439 modifyIORef' cached $ DMap.delete k
14431440
14441441{-# INLINE subscribeRootSubscribed #-}
1445−subscribeRootSubscribed :: RootSubscribed x a -> Subscriber x a -> IO (SubscriberListTicket x a)
1442+subscribeRootSubscribed :: RootSubscribed x a -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a))
14461443subscribeRootSubscribed subscribed sub = WeakBag.insert sub (rootSubscribedSubscribers subscribed) (rootSubscribedWeakSelf subscribed) cleanupRootSubscribed
14471444
14481445-- When getPushSubscribed returns, the PushSubscribed returned will have a fully filled-in
1449−{-# SPECIALIZE getPushSubscribed :: Push x a b -> Subscriber x b -> EventM x (SubscriberListTicket x b, PushSubscribed x a b) #-}
1450−getPushSubscribed :: CanSubscribe x m => Push x a b -> Subscriber x b -> m (SubscriberListTicket x b, PushSubscribed x a b)
1446+{-# SPECIALIZE getPushSubscribed :: Push x a b -> Subscriber x b -> EventM x (WeakBagTicket (Subscriber x b), PushSubscribed x a b) #-}
1447+getPushSubscribed :: CanSubscribe x m => Push x a b -> Subscriber x b -> m (WeakBagTicket (Subscriber x b), PushSubscribed x a b)
14511448getPushSubscribed p sub = do
14521449 mSubscribed <- liftIO $ readIORef $ pushSubscribed p
14531450 case mSubscribed of
@@ -1489,11 +1486,11 @@ cleanupPushSubscribed self = do
14891486 writeIORef (pushSubscribedCachedSubscribed self) $ Nothing
14901487
14911488{-# INLINE subscribePushSubscribed #-}
1492−subscribePushSubscribed :: PushSubscribed x a b -> Subscriber x b -> IO (SubscriberListTicket x b)
1489+subscribePushSubscribed :: PushSubscribed x a b -> Subscriber x b -> IO (WeakBagTicket (Subscriber x b))
14931490subscribePushSubscribed subscribed sub = WeakBag.insert sub (pushSubscribedSubscribers subscribed) (pushSubscribedWeakSelf subscribed) cleanupPushSubscribed
14941491
1495−{-# SPECIALIZE getMergeSubscribed :: GCompare k => Merge x k -> Subscriber x (DMap k Identity) -> EventM x (SubscriberListTicket x (DMap k Identity), MergeSubscribed x k) #-}
1496−getMergeSubscribed :: forall x k m. (CanSubscribe x m, GCompare k) => Merge x k -> Subscriber x (DMap k Identity) -> m (SubscriberListTicket x (DMap k Identity), MergeSubscribed x k)
1492+{-# SPECIALIZE getMergeSubscribed :: GCompare k => Merge x k -> Subscriber x (DMap k Identity) -> EventM x (WeakBagTicket (Subscriber x (DMap k Identity)), MergeSubscribed x k) #-}
1493+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)
14971494getMergeSubscribed m sub = do
14981495 mSubscribed <- liftIO $ readIORef $ mergeSubscribed m
14991496 case mSubscribed of
@@ -1559,11 +1556,11 @@ cleanupMergeSubscribed subscribed = do
15591556 writeIORef (mergeSubscribedCachedSubscribed subscribed) $ Nothing -- Get rid of the cached subscribed
15601557
15611558{-# INLINE subscribeMergeSubscribed #-}
1562−subscribeMergeSubscribed :: MergeSubscribed x k -> Subscriber x (DMap k Identity) -> IO (SubscriberListTicket x (DMap k Identity))
1559+subscribeMergeSubscribed :: MergeSubscribed x k -> Subscriber x (DMap k Identity) -> IO (WeakBagTicket (Subscriber x (DMap k Identity)))
15631560subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed
15641561
1565−{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan x k -> Subscriber x a -> EventM x (SubscriberListTicket x a, FanSubscribed x k) #-}
1566−getFanSubscribed :: (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, HasCurrentHeight x m, Defer (SomeResetCoincidence x) m, HasSpiderEnv x m, m ~ EventM x, GCompare k) => k a -> Fan x k -> Subscriber x a -> m (SubscriberListTicket x a, FanSubscribed x k)
1562+{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), FanSubscribed x k) #-}
1563+getFanSubscribed :: (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, HasCurrentHeight x m, Defer (SomeResetCoincidence x) m, HasSpiderEnv x m, m ~ EventM x, GCompare k) => k a -> Fan x k -> Subscriber x a -> m (WeakBagTicket (Subscriber x a), FanSubscribed x k)
15671564getFanSubscribed k f sub = do
15681565 mSubscribed <- liftIO $ readIORef $ fanSubscribed f
15691566 case mSubscribed of
@@ -1605,7 +1602,7 @@ cleanupFanSubscribed (k, subscribed) = do
16051602 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers
16061603
16071604{-# INLINE subscribeFanSubscribed #-}
1608−subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> Subscriber x a -> IO (SubscriberListTicket x a)
1605+subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a))
16091606subscribeFanSubscribed k subscribed sub = do
16101607 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
16111608 case DMap.lookup k subscribers of
@@ -1617,8 +1614,8 @@ subscribeFanSubscribed k subscribed sub = do
16171614 return sln
16181615 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed
16191616
1620−{-# SPECIALIZE getSwitchSubscribed :: Switch x a -> Subscriber x a -> EventM x (SubscriberListTicket x a, SwitchSubscribed x a) #-}
1621−getSwitchSubscribed :: (Defer (SomeHoldInit x) m, Defer (SomeAssignment x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, Defer (SomeResetCoincidence x) m, HasCurrentHeight x m, HasSpiderEnv x m, m ~ EventM x) => Switch x a -> Subscriber x a -> m (SubscriberListTicket x a, SwitchSubscribed x a)
1617+{-# SPECIALIZE getSwitchSubscribed :: Switch x a -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), SwitchSubscribed x a) #-}
1618+getSwitchSubscribed :: (Defer (SomeHoldInit x) m, Defer (SomeAssignment x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, Defer (SomeResetCoincidence x) m, HasCurrentHeight x m, HasSpiderEnv x m, m ~ EventM x) => Switch x a -> Subscriber x a -> m (WeakBagTicket (Subscriber x a), SwitchSubscribed x a)
16221619getSwitchSubscribed s sub = do
16231620 mSubscribed <- liftIO $ readIORef $ switchSubscribed s
16241621 case mSubscribed of
@@ -1670,11 +1667,11 @@ cleanupSwitchSubscribed subscribed = do
16701667 writeIORef (switchSubscribedCachedSubscribed subscribed) Nothing
16711668
16721669{-# INLINE subscribeSwitchSubscribed #-}
1673−subscribeSwitchSubscribed :: SwitchSubscribed x a -> Subscriber x a -> IO (SubscriberListTicket x a)
1670+subscribeSwitchSubscribed :: SwitchSubscribed x a -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a))
16741671subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed
16751672
1676−{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence x a -> Subscriber x a -> EventM x (SubscriberListTicket x a, CoincidenceSubscribed x a) #-}
1677−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, HasSpiderEnv x m, m ~ EventM x) => Coincidence x a -> Subscriber x a -> m (SubscriberListTicket x a, CoincidenceSubscribed x a)
1673+{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence x a -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), CoincidenceSubscribed x a) #-}
1674+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, HasSpiderEnv x m, m ~ EventM x) => Coincidence x a -> Subscriber x a -> m (WeakBagTicket (Subscriber x a), CoincidenceSubscribed x a)
16781675getCoincidenceSubscribed c sub = do
16791676 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c
16801677 case mSubscribed of
@@ -1724,7 +1721,7 @@ cleanupCoincidenceSubscribed subscribed = do
17241721 writeIORef (coincidenceSubscribedCachedSubscribed subscribed) Nothing
17251722
17261723{-# INLINE subscribeCoincidenceSubscribed #-}
1727−subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO (SubscriberListTicket x a)
1724+subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a))
17281725subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed
17291726
17301727{-# INLINE merge #-}
@@ -2133,7 +2130,7 @@ instance R.MonadHold (SpiderEnv x) (SpiderPushM x) where
21332130 {-# INLINABLE holdIncremental #-}
21342131 holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . DynamicHold <$> hold v0 e
21352132
2136−data RootTrigger x a = forall k. GCompare k => RootTrigger (SubscriberList x a, IORef (DMap k Identity), k a)
2133+data RootTrigger x a = forall k. GCompare k => RootTrigger (WeakBag (Subscriber x a), IORef (DMap k Identity), k a)
21372134newtype SpiderEventHandle x a = SpiderEventHandle { unSpiderEventHandle :: EventSubscription x a }
21382135
21392136instance R.MonadSubscribeEvent (SpiderEnv x) (SpiderHostFrame x) where