git.iko.soy/reflex
on develop help sign in
Eliminate eventSubscribedSubscribe and eventSubscribedRead
9cf221aRyan Trinkle
src/Reflex/Spider/Internal.hs+93−126
compare with develop
unifiedsplit
@@ -190,24 +190,23 @@ unsafeNodeId a = unsafePerformIO $ do
190-- Event
190-- Event
191--------------------------------------------------------------------------------
191--------------------------------------------------------------------------------
192
192
193−newtype Event x a = Event { subscribe :: Subscriber x a -> EventM x (EventSubscription x a) }
193+newtype Event x a = Event { subscribeAndRead :: Subscriber x a -> EventM x (EventSubscription x a, Maybe a) }
194
194
195−subscribeAndRead :: Event x a -> Subscriber x a -> EventM x (EventSubscription x a, Maybe a)
195+subscribe :: Event x a -> Subscriber x a -> EventM x (EventSubscription x a)
196−subscribeAndRead e sub = do
196+subscribe e s = fst <$> subscribeAndRead e s
197− subscription@(EventSubscription _ subd) <- subscribe e sub
198− occ <- liftIO $ eventSubscribedRead subd
199− return (subscription, occ)
200
197
198+{-# INLINE wrap #-}
201−wrap :: Monad m => (t -> EventSubscribed x a) -> (Subscriber x a -> m (WeakBagTicket (Subscriber x a), t)) -> Subscriber x a -> m (EventSubscription x a)
199+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)
202wrap tag getSpecificSubscribed sub = do
200wrap tag getSpecificSubscribed sub = do
203− (sln, subd) <- getSpecificSubscribed sub
201+ (sln, subd, occ) <- getSpecificSubscribed sub
202+ let es = tag subd
204− return $ EventSubscription (Just sln) $ tag subd
203+ return (EventSubscription (Just sln) es, occ)
205
204
206eventRoot :: GCompare k => k a -> Root x k -> Event x a
205eventRoot :: GCompare k => k a -> Root x k -> Event x a
207eventRoot !k !r = Event $ wrap eventSubscribedRoot $ liftIO . getRootSubscribed k r
206eventRoot !k !r = Event $ wrap eventSubscribedRoot $ liftIO . getRootSubscribed k r
208
207
209eventNever :: Event x a
208eventNever :: Event x a
210−eventNever = Event $ \_ -> return $ EventSubscription Nothing eventSubscribedNever
209+eventNever = Event $ \_ -> return (EventSubscription Nothing eventSubscribedNever, Nothing)
211
210
212eventPush :: Push x b a -> Event x a
211eventPush :: Push x b a -> Event x a
213eventPush !p = Event $ wrap eventSubscribedPush $ getPushSubscribed p
212eventPush !p = Event $ wrap eventSubscribedPush $ getPushSubscribed p
@@ -216,7 +215,7 @@ eventMerge :: (GCompare k, a ~ DMap k Identity) => Merge x k -> Event x a
216eventMerge !m = Event $ wrap eventSubscribedMerge $ getMergeSubscribed m
215eventMerge !m = Event $ wrap eventSubscribedMerge $ getMergeSubscribed m
217
216
218eventFan :: GCompare k => k a -> Fan x k -> Event x a
217eventFan :: GCompare k => k a -> Fan x k -> Event x a
219−eventFan !k !f = Event $ wrap (eventSubscribedFan k) $ getFanSubscribed k f
218+eventFan !k !f = Event $ wrap eventSubscribedFan $ getFanSubscribed k f
220
219
221eventSwitch :: Switch x a -> Event x a
220eventSwitch :: Switch x a -> Event x a
222eventSwitch !s = Event $ wrap eventSubscribedSwitch $ getSwitchSubscribed s
221eventSwitch !s = Event $ wrap eventSubscribedSwitch $ getSwitchSubscribed s
@@ -224,7 +223,7 @@ eventSwitch !s = Event $ wrap eventSubscribedSwitch $ getSwitchSubscribed s
224eventCoincidence :: Coincidence x a -> Event x a
223eventCoincidence :: Coincidence x a -> Event x a
225eventCoincidence !c = Event $ wrap eventSubscribedCoincidence $ getCoincidenceSubscribed c
224eventCoincidence !c = Event $ wrap eventSubscribedCoincidence $ getCoincidenceSubscribed c
226
225
227−eventHold :: (a ~ p b, R.Patch p) => Hold x p b -> Event x a
226+eventHold :: a ~ p b => Hold x p b -> Event x a
228eventHold !h = Event $ subscribeHoldEvent h
227eventHold !h = Event $ subscribeHoldEvent h
229
228
230eventDyn :: (a ~ p b, R.Patch p) => Dyn x p b -> Event x a
229eventDyn :: (a ~ p b, R.Patch p) => Dyn x p b -> Event x a
@@ -347,6 +346,8 @@ newSubscriberFan subscribed = return $ Subscriber
347 { subscriberPropagate = \a -> {-# SCC "traverseFan" #-} do
346 { subscriberPropagate = \a -> {-# SCC "traverseFan" #-} do
348 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
347 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
349 tracePropagate $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
348 tracePropagate $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
349+ liftIO $ writeIORef (fanSubscribedOccurrence subscribed) $ Just a
350+ scheduleClear $ fanSubscribedOccurrence subscribed
350 let f _ (Pair (Identity v) subsubs) = do
351 let f _ (Pair (Identity v) subsubs) = do
351 propagate v $ _fanSubscribedChildren_list subsubs
352 propagate v $ _fanSubscribedChildren_list subsubs
352 return $ Constant ()
353 return $ Constant ()
@@ -453,10 +454,9 @@ propagate a subscribers = withIncreasedDepth $ do
453-- EventSubscribed
454-- EventSubscribed
454--------------------------------------------------------------------------------
455--------------------------------------------------------------------------------
455
456
456−data EventSubscribed x a = EventSubscribed
457+data EventSubscribed x a = forall b. EventSubscribed
457− { eventSubscribedSubscribe :: !(Subscriber x a -> IO (Maybe (WeakBagTicket (Subscriber x a))))
458− , eventSubscribedRead :: !(IO (Maybe a))
459− , eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)
458+ { eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)
459+ , eventSubscribedRetained :: {-# NOUNPACK #-} !b
460#ifdef DEBUG_CYCLES
460#ifdef DEBUG_CYCLES
461 , eventSubscribedGetParents :: !(IO [Some (EventSubscribed x)]) -- For debugging loops
461 , eventSubscribedGetParents :: !(IO [Some (EventSubscribed x)]) -- For debugging loops
462 , eventSubscribedHasOwnHeightRef :: !Bool
462 , eventSubscribedHasOwnHeightRef :: !Bool
@@ -464,17 +464,10 @@ data EventSubscribed x a = EventSubscribed
464#endif
464#endif
465 }
465 }
466
466
467−readEventSubscribed :: EventSubscribed x a -> IO (Maybe a)
468−readEventSubscribed = eventSubscribedRead
469−
470−subscribeEventSubscribed :: EventSubscribed x a -> Subscriber x a -> IO (Maybe (WeakBagTicket (Subscriber x a)))
471−subscribeEventSubscribed = eventSubscribedSubscribe
472−
473eventSubscribedRoot :: RootSubscribed x a -> EventSubscribed x a
467eventSubscribedRoot :: RootSubscribed x a -> EventSubscribed x a
474eventSubscribedRoot !r = EventSubscribed
468eventSubscribedRoot !r = EventSubscribed
475− { eventSubscribedSubscribe = \sub -> Just <$> subscribeRootSubscribed r sub
476− , eventSubscribedRead = readRootSubscribed r
477− , eventSubscribedHeightRef = zeroRef
469+ { eventSubscribedHeightRef = zeroRef
470+ , eventSubscribedRetained = r
478#ifdef DEBUG_CYCLES
471#ifdef DEBUG_CYCLES
479 , eventSubscribedGetParents = return []
472 , eventSubscribedGetParents = return []
480 , eventSubscribedHasOwnHeightRef = False
473 , eventSubscribedHasOwnHeightRef = False
@@ -484,9 +477,8 @@ eventSubscribedRoot !r = EventSubscribed
484
477
485eventSubscribedNever :: EventSubscribed x a
478eventSubscribedNever :: EventSubscribed x a
486eventSubscribedNever = EventSubscribed
479eventSubscribedNever = EventSubscribed
487− { eventSubscribedSubscribe = \_ -> return Nothing
488− , eventSubscribedRead = return Nothing
489− , eventSubscribedHeightRef = zeroRef
480+ { eventSubscribedHeightRef = zeroRef
481+ , eventSubscribedRetained = ()
490#ifdef DEBUG_CYCLES
482#ifdef DEBUG_CYCLES
491 , eventSubscribedGetParents = return []
483 , eventSubscribedGetParents = return []
492 , eventSubscribedHasOwnHeightRef = False
484 , eventSubscribedHasOwnHeightRef = False
@@ -496,9 +488,8 @@ eventSubscribedNever = EventSubscribed
496
488
497eventSubscribedPush :: PushSubscribed x b a -> EventSubscribed x a
489eventSubscribedPush :: PushSubscribed x b a -> EventSubscribed x a
498eventSubscribedPush !subscribed = EventSubscribed
490eventSubscribedPush !subscribed = EventSubscribed
499− { eventSubscribedSubscribe = \sub -> Just <$> subscribePushSubscribed subscribed sub
500− , eventSubscribedRead = readPushSubscribed subscribed
501− , eventSubscribedHeightRef = pushSubscribedHeight subscribed
491+ { eventSubscribedHeightRef = pushSubscribedHeight subscribed
492+ , eventSubscribedRetained = subscribed
502#ifdef DEBUG_CYCLES
493#ifdef DEBUG_CYCLES
503 , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ pushSubscribedParent subscribed]
494 , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ pushSubscribedParent subscribed]
504 , eventSubscribedHasOwnHeightRef = False
495 , eventSubscribedHasOwnHeightRef = False
@@ -506,11 +497,10 @@ eventSubscribedPush !subscribed = EventSubscribed
506#endif
497#endif
507 }
498 }
508
499
509−eventSubscribedMerge :: a ~ DMap k Identity => MergeSubscribed x k -> EventSubscribed x a
500+eventSubscribedMerge :: MergeSubscribed x k -> EventSubscribed x a
510eventSubscribedMerge !subscribed = EventSubscribed
501eventSubscribedMerge !subscribed = EventSubscribed
511− { eventSubscribedSubscribe = \sub -> Just <$> subscribeMergeSubscribed subscribed sub
512− , eventSubscribedRead = readMergeSubscribed subscribed
513− , eventSubscribedHeightRef = mergeSubscribedHeight subscribed
502+ { eventSubscribedHeightRef = mergeSubscribedHeight subscribed
503+ , eventSubscribedRetained = subscribed
514#ifdef DEBUG_CYCLES
504#ifdef DEBUG_CYCLES
515 , eventSubscribedGetParents = do
505 , eventSubscribedGetParents = do
516 ps <- readIORef $ mergeSubscribedParents subscribed
506 ps <- readIORef $ mergeSubscribedParents subscribed
@@ -520,11 +510,10 @@ eventSubscribedMerge !subscribed = EventSubscribed
520#endif
510#endif
521 }
511 }
522
512
523−eventSubscribedFan :: GCompare k => k a -> FanSubscribed x k -> EventSubscribed x a
513+eventSubscribedFan :: FanSubscribed x k -> EventSubscribed x a
524−eventSubscribedFan !k !subscribed = EventSubscribed
514+eventSubscribedFan !subscribed = EventSubscribed
525− { eventSubscribedSubscribe = \sub -> Just <$> subscribeFanSubscribed k subscribed sub
526− , eventSubscribedRead = readFanSubscribed k subscribed
527− , eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed
515+ { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed
516+ , eventSubscribedRetained = subscribed
528#ifdef DEBUG_CYCLES
517#ifdef DEBUG_CYCLES
529 , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]
518 , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]
530 , eventSubscribedHasOwnHeightRef = False
519 , eventSubscribedHasOwnHeightRef = False
@@ -534,9 +523,8 @@ eventSubscribedFan !k !subscribed = EventSubscribed
534
523
535eventSubscribedSwitch :: SwitchSubscribed x a -> EventSubscribed x a
524eventSubscribedSwitch :: SwitchSubscribed x a -> EventSubscribed x a
536eventSubscribedSwitch !subscribed = EventSubscribed
525eventSubscribedSwitch !subscribed = EventSubscribed
537− { eventSubscribedSubscribe = \sub -> Just <$> subscribeSwitchSubscribed subscribed sub
538− , eventSubscribedRead = readSwitchSubscribed subscribed
539− , eventSubscribedHeightRef = switchSubscribedHeight subscribed
526+ { eventSubscribedHeightRef = switchSubscribedHeight subscribed
527+ , eventSubscribedRetained = subscribed
540#ifdef DEBUG_CYCLES
528#ifdef DEBUG_CYCLES
541 , eventSubscribedGetParents = do
529 , eventSubscribedGetParents = do
542 s <- readIORef $ switchSubscribedCurrentParent subscribed
530 s <- readIORef $ switchSubscribedCurrentParent subscribed
@@ -548,9 +536,8 @@ eventSubscribedSwitch !subscribed = EventSubscribed
548
536
549eventSubscribedCoincidence :: CoincidenceSubscribed x a -> EventSubscribed x a
537eventSubscribedCoincidence :: CoincidenceSubscribed x a -> EventSubscribed x a
550eventSubscribedCoincidence !subscribed = EventSubscribed
538eventSubscribedCoincidence !subscribed = EventSubscribed
551− { eventSubscribedSubscribe = \sub -> Just <$> subscribeCoincidenceSubscribed subscribed sub
552− , eventSubscribedRead = readCoincidenceSubscribed subscribed
553− , eventSubscribedHeightRef = coincidenceSubscribedHeight subscribed
539+ { eventSubscribedHeightRef = coincidenceSubscribedHeight subscribed
540+ , eventSubscribedRetained = subscribed
554#ifdef DEBUG_CYCLES
541#ifdef DEBUG_CYCLES
555 , eventSubscribedGetParents = do
542 , eventSubscribedGetParents = do
556 innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed
543 innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed
@@ -582,11 +569,8 @@ walkInvalidHeightParents s0 = do
582#endif
569#endif
583
570
584{-# INLINE subscribeHoldEvent #-}
571{-# INLINE subscribeHoldEvent #-}
585−subscribeHoldEvent :: (CanSubscribe x m, R.Patch p) => Hold x p a -> Subscriber x (p a) -> m (EventSubscription x (p a))
572+subscribeHoldEvent :: CanSubscribe x m => Hold x p a -> Subscriber x (p a) -> m (EventSubscription x (p a), Maybe (p a))
586−subscribeHoldEvent h sub = do
573+subscribeHoldEvent = subscribeAndRead . holdEvent
587− EventSubscription _ subd <- getHoldEventSubscription h
588− sln <- liftIO $ subscribeEventSubscribed subd sub
589− return $ EventSubscription sln subd
590
574
591--------------------------------------------------------------------------------
575--------------------------------------------------------------------------------
592-- EventSubscription
576-- EventSubscription
@@ -611,7 +595,8 @@ unsubscribe (EventSubscription msln _) = forM_ msln $ \sln -> WeakBag.remove sln
611data Hold x p a
595data Hold x p a
612 = Hold { holdValue :: !(IORef a)
596 = Hold { holdValue :: !(IORef a)
613 , holdInvalidators :: !(IORef [Weak (Invalidator x)])
597 , holdInvalidators :: !(IORef [Weak (Invalidator x)])
598+ , holdEvent :: !(Event x (p a))
614− , holdParent :: !(IORef (Either (Event x (p a)) (EventSubscription x (p a)))) -- Keeps its parent alive (will be undefined until the hold is initialized) --TODO: Probably shouldn't be an IORef
599+ , holdParent :: !(IORef (Maybe (EventSubscription x (p a)))) -- Keeps its parent alive (will be undefined until the hold is initialized) --TODO: Probably shouldn't be an IORef
615#ifdef DEBUG_NODEIDS
600#ifdef DEBUG_NODEIDS
616 , holdNodeId :: Int
601 , holdNodeId :: Int
617#endif
602#endif
@@ -721,13 +706,14 @@ hold :: (R.Patch p, Defer (SomeHoldInit x) m) => a -> Event x (p a) -> m (Hold x
721hold v0 e = do
706hold v0 e = do
722 valRef <- liftIO $ newIORef v0
707 valRef <- liftIO $ newIORef v0
723 invsRef <- liftIO $ newIORef []
708 invsRef <- liftIO $ newIORef []
724− parentRef <- liftIO $ newIORef $ Left e
709+ parentRef <- liftIO $ newIORef Nothing
725#ifdef DEBUG_NODEIDS
710#ifdef DEBUG_NODEIDS
726 nodeId <- liftIO newNodeId
711 nodeId <- liftIO newNodeId
727#endif
712#endif
728 let h = Hold
713 let h = Hold
729 { holdValue = valRef
714 { holdValue = valRef
730 , holdInvalidators = invsRef
715 , holdInvalidators = invsRef
716+ , holdEvent = e
731 , holdParent = parentRef
717 , holdParent = parentRef
732#ifdef DEBUG_NODEIDS
718#ifdef DEBUG_NODEIDS
733 , holdNodeId = nodeId
719 , holdNodeId = nodeId
@@ -741,8 +727,9 @@ getHoldEventSubscription :: forall m p a x. (Defer (SomeAssignment x) m, Defer (
741getHoldEventSubscription h = do
727getHoldEventSubscription h = do
742 ep <- liftIO $ readIORef $ holdParent h
728 ep <- liftIO $ readIORef $ holdParent h
743 case ep of
729 case ep of
744− Right subd -> return subd
730+ Just subd -> return subd
745− Left e -> do
731+ Nothing -> do
732+ let e = holdEvent h
746 subscriptionRef <- liftIO $ newIORef $ error "getHoldEventSubscription: subdRef uninitialized"
733 subscriptionRef <- liftIO $ newIORef $ error "getHoldEventSubscription: subdRef uninitialized"
747 (subscription@(EventSubscription _ _), occ) <- subscribeAndRead e =<< liftIO (newSubscriberHold h)
734 (subscription@(EventSubscription _ _), occ) <- subscribeAndRead e =<< liftIO (newSubscriberHold h)
748 liftIO $ writeIORef subscriptionRef $! subscription
735 liftIO $ writeIORef subscriptionRef $! subscription
@@ -757,7 +744,7 @@ getHoldEventSubscription h = do
757 v <- liftIO $ evaluate $ holdValue h
744 v <- liftIO $ evaluate $ holdValue h
758 i <- liftIO $ evaluate $ holdInvalidators h
745 i <- liftIO $ evaluate $ holdInvalidators h
759 defer $ SomeAssignment v i new
746 defer $ SomeAssignment v i new
760− liftIO $ writeIORef (holdParent h) $ Right subscription
747+ liftIO $ writeIORef (holdParent h) $ Just subscription
761 return subscription
748 return subscription
762
749
763type BehaviorEnv x = (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]), IORef [SomeHoldInit x])
750type BehaviorEnv x = (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]), IORef [SomeHoldInit x])
@@ -936,6 +923,7 @@ data FanSubscribedChildren (x :: *) k a = FanSubscribedChildren
936
923
937data FanSubscribed (x :: *) k
924data FanSubscribed (x :: *) k
938 = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k)))
925 = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k)))
926+ , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))
939 , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k))) -- This DMap should never be empty
927 , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k))) -- This DMap should never be empty
940 , fanSubscribedParent :: !(EventSubscription x (DMap k Identity))
928 , fanSubscribedParent :: !(EventSubscription x (DMap k Identity))
941#ifdef DEBUG_NODEIDS
929#ifdef DEBUG_NODEIDS
@@ -1361,39 +1349,6 @@ getDynHold d = do
1361 liftIO $ writeIORef (unDyn d) $ Right h
1349 liftIO $ writeIORef (unDyn d) $ Right h
1362 return h
1350 return h
1363
1351
1364−readRootSubscribed :: RootSubscribed x a -> IO (Maybe a)
1365−readRootSubscribed = rootSubscribedOccurrence
1366−
1367−readPushSubscribed :: PushSubscribed x b a -> IO (Maybe a)
1368−readPushSubscribed subscribed = do
1369− result <- readIORef $ pushSubscribedOccurrence subscribed -- Since ResultM is always called after the final height is reached, this will always be valid
1370− touch $ pushSubscribedSelf subscribed
1371− return result
1372−
1373−readMergeSubscribed :: MergeSubscribed x k -> IO (Maybe (DMap k Identity))
1374−readMergeSubscribed subscribed = do
1375− result <- readIORef $ mergeSubscribedOccurrence subscribed
1376− touch $ mergeSubscribedParents subscribed
1377− return result
1378−
1379−readFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> IO (Maybe a)
1380−readFanSubscribed k fs = do
1381− parentOcc <- readEventSubscribed $ _eventSubscription_subscribed $ fanSubscribedParent fs
1382− return $ coerce $ DMap.lookup k =<< parentOcc
1383−
1384−readSwitchSubscribed :: SwitchSubscribed x a -> IO (Maybe a)
1385−readSwitchSubscribed subscribed = do
1386− result <- readIORef $ switchSubscribedOccurrence subscribed
1387− touch $ switchSubscribedOwnInvalidator subscribed
1388− return result
1389−
1390−readCoincidenceSubscribed :: CoincidenceSubscribed x a -> IO (Maybe a)
1391−readCoincidenceSubscribed subscribed = do
1392− result <- readIORef $ coincidenceSubscribedOccurrence subscribed
1393− touch $ coincidenceSubscribedOuter subscribed
1394− --TODO: do we need to touch the inner subscriber?
1395− return result
1396−
1397-- Always refers to 0
1352-- Always refers to 0
1398{-# NOINLINE zeroRef #-}
1353{-# NOINLINE zeroRef #-}
1399zeroRef :: IORef Height
1354zeroRef :: IORef Height
@@ -1409,13 +1364,15 @@ type CanSubscribe x m =
1409 , m ~ EventM x
1364 , m ~ EventM x
1410 )
1365 )
1411
1366
1412−getRootSubscribed :: GCompare k => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a), RootSubscribed x a)
1367+getRootSubscribed :: GCompare k => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a), RootSubscribed x a, Maybe a)
1413getRootSubscribed k r sub = do
1368getRootSubscribed k r sub = do
1414 mSubscribed <- readIORef $ rootSubscribed r
1369 mSubscribed <- readIORef $ rootSubscribed r
1370+ let getOcc = fmap (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r
1415 case DMap.lookup k mSubscribed of
1371 case DMap.lookup k mSubscribed of
1416 Just subscribed -> {-# SCC "hitRoot" #-} do
1372 Just subscribed -> {-# SCC "hitRoot" #-} do
1417 sln <- subscribeRootSubscribed subscribed sub
1373 sln <- subscribeRootSubscribed subscribed sub
1374+ occ <- getOcc
1418− return (sln, subscribed)
1375+ return (sln, subscribed, occ)
1419 Nothing -> {-# SCC "missRoot" #-} do
1376 Nothing -> {-# SCC "missRoot" #-} do
1420 weakSelf <- newIORef $ error "getRootSubscribed: weakSelfRef not initialized"
1377 weakSelf <- newIORef $ error "getRootSubscribed: weakSelfRef not initialized"
1421 let !cached = rootSubscribed r
1378 let !cached = rootSubscribed r
@@ -1427,7 +1384,7 @@ getRootSubscribed k r sub = do
1427 let subscribed = RootSubscribed
1384 let subscribed = RootSubscribed
1428 { rootSubscribedKey = k
1385 { rootSubscribedKey = k
1429 , rootSubscribedCachedSubscribed = cached
1386 , rootSubscribedCachedSubscribed = cached
1430− , rootSubscribedOccurrence = fmap (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r
1387+ , rootSubscribedOccurrence = getOcc
1431 , rootSubscribedSubscribers = subs
1388 , rootSubscribedSubscribers = subs
1432 , rootSubscribedUninit = uninit
1389 , rootSubscribedUninit = uninit
1433 , rootSubscribedWeakSelf = weakSelf
1390 , rootSubscribedWeakSelf = weakSelf
@@ -1437,7 +1394,8 @@ getRootSubscribed k r sub = do
1437 }
1394 }
1438 writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "RootSubscribed"
1395 writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "RootSubscribed"
1439 modifyIORef' (rootSubscribed r) $ DMap.insertWith (error $ "getRootSubscribed: duplicate key inserted into Root") k subscribed --TODO: I think we can just write back mSubscribed rather than re-reading it
1396 modifyIORef' (rootSubscribed r) $ DMap.insertWith (error $ "getRootSubscribed: duplicate key inserted into Root") k subscribed --TODO: I think we can just write back mSubscribed rather than re-reading it
1397+ occ <- getOcc
1440− return (sln, subscribed)
1398+ return (sln, subscribed, occ)
1441
1399
1442{-# ANN cleanupRootSubscribed "HLint: ignore Redundant bracket" #-}
1400{-# ANN cleanupRootSubscribed "HLint: ignore Redundant bracket" #-}
1443cleanupRootSubscribed :: RootSubscribed x a -> IO ()
1401cleanupRootSubscribed :: RootSubscribed x a -> IO ()
@@ -1450,14 +1408,15 @@ subscribeRootSubscribed :: RootSubscribed x a -> Subscriber x a -> IO (WeakBagTi
1450subscribeRootSubscribed subscribed sub = WeakBag.insert sub (rootSubscribedSubscribers subscribed) (rootSubscribedWeakSelf subscribed) cleanupRootSubscribed
1408subscribeRootSubscribed subscribed sub = WeakBag.insert sub (rootSubscribedSubscribers subscribed) (rootSubscribedWeakSelf subscribed) cleanupRootSubscribed
1451
1409
1452-- When getPushSubscribed returns, the PushSubscribed returned will have a fully filled-in
1410-- When getPushSubscribed returns, the PushSubscribed returned will have a fully filled-in
1453−{-# SPECIALIZE getPushSubscribed :: Push x a b -> Subscriber x b -> EventM x (WeakBagTicket (Subscriber x b), PushSubscribed x a b) #-}
1411+{-# SPECIALIZE getPushSubscribed :: Push x a b -> Subscriber x b -> EventM x (WeakBagTicket (Subscriber x b), PushSubscribed x a b, Maybe b) #-}
1454−getPushSubscribed :: CanSubscribe x m => Push x a b -> Subscriber x b -> m (WeakBagTicket (Subscriber x b), PushSubscribed x a b)
1412+getPushSubscribed :: CanSubscribe x m => Push x a b -> Subscriber x b -> m (WeakBagTicket (Subscriber x b), PushSubscribed x a b, Maybe b)
1455getPushSubscribed p sub = do
1413getPushSubscribed p sub = do
1456 mSubscribed <- liftIO $ readIORef $ pushSubscribed p
1414 mSubscribed <- liftIO $ readIORef $ pushSubscribed p
1457 case mSubscribed of
1415 case mSubscribed of
1458− Just subscribed -> {-# SCC "hitPush" #-} do
1416+ Just subscribed -> {-# SCC "hitPush" #-} liftIO $ do
1459− sln <- liftIO $ subscribePushSubscribed subscribed sub
1417+ sln <- subscribePushSubscribed subscribed sub
1418+ occ <- readIORef $ pushSubscribedOccurrence subscribed
1460− return (sln, subscribed)
1419+ return (sln, subscribed, occ)
1461 Nothing -> {-# SCC "missPush" #-} do -- Not yet subscribed
1420 Nothing -> {-# SCC "missPush" #-} do -- Not yet subscribed
1462 subscribedRef <- liftIO $ newIORef $ error "getPushSubscribed: subscribed not yet intialized"
1421 subscribedRef <- liftIO $ newIORef $ error "getPushSubscribed: subscribed not yet intialized"
1463 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
1422 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
@@ -1484,7 +1443,7 @@ getPushSubscribed p sub = do
1484 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "PushSubscribed"
1443 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "PushSubscribed"
1485 liftIO $ writeIORef subscribedRef $! subscribed
1444 liftIO $ writeIORef subscribedRef $! subscribed
1486 liftIO $ writeIORef (pushSubscribed p) $ Just subscribed
1445 liftIO $ writeIORef (pushSubscribed p) $ Just subscribed
1487− return (sln, subscribed)
1446+ return (sln, subscribed, occ)
1488
1447
1489cleanupPushSubscribed :: PushSubscribed x a b -> IO ()
1448cleanupPushSubscribed :: PushSubscribed x a b -> IO ()
1490cleanupPushSubscribed self = do
1449cleanupPushSubscribed self = do
@@ -1495,14 +1454,15 @@ cleanupPushSubscribed self = do
1495subscribePushSubscribed :: PushSubscribed x a b -> Subscriber x b -> IO (WeakBagTicket (Subscriber x b))
1454subscribePushSubscribed :: PushSubscribed x a b -> Subscriber x b -> IO (WeakBagTicket (Subscriber x b))
1496subscribePushSubscribed subscribed sub = WeakBag.insert sub (pushSubscribedSubscribers subscribed) (pushSubscribedWeakSelf subscribed) cleanupPushSubscribed
1455subscribePushSubscribed subscribed sub = WeakBag.insert sub (pushSubscribedSubscribers subscribed) (pushSubscribedWeakSelf subscribed) cleanupPushSubscribed
1497
1456
1498−{-# SPECIALIZE getMergeSubscribed :: GCompare k => Merge x k -> Subscriber x (DMap k Identity) -> EventM x (WeakBagTicket (Subscriber x (DMap k Identity)), MergeSubscribed x k) #-}
1457+{-# 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)) #-}
1499−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)
1458+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))
1500getMergeSubscribed m sub = do
1459getMergeSubscribed m sub = do
1501 mSubscribed <- liftIO $ readIORef $ mergeSubscribed m
1460 mSubscribed <- liftIO $ readIORef $ mergeSubscribed m
1502 case mSubscribed of
1461 case mSubscribed of
1503− Just subscribed -> {-# SCC "hitMerge" #-} do
1462+ Just subscribed -> {-# SCC "hitMerge" #-} liftIO $ do
1504− sln <- liftIO $ subscribeMergeSubscribed subscribed sub
1463+ sln <- subscribeMergeSubscribed subscribed sub
1464+ occ <- readIORef $ mergeSubscribedOccurrence subscribed
1505− return (sln, subscribed)
1465+ return (sln, subscribed, occ)
1506 Nothing -> {-# SCC "missMerge" #-} do
1466 Nothing -> {-# SCC "missMerge" #-} do
1507 subscribedRef <- liftIO $ newIORef $ error "getMergeSubscribed: subscribedRef not yet initialized"
1467 subscribedRef <- liftIO $ newIORef $ error "getMergeSubscribed: subscribedRef not yet initialized"
1508 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
1468 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
@@ -1551,7 +1511,7 @@ getMergeSubscribed m sub = do
1551 liftIO $ writeIORef subscribedRef $! subscribed
1511 liftIO $ writeIORef subscribedRef $! subscribed
1552 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "MergeSubscribed"
1512 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "MergeSubscribed"
1553 liftIO $ writeIORef (mergeSubscribed m) $ Just subscribed
1513 liftIO $ writeIORef (mergeSubscribed m) $ Just subscribed
1554− return (sln, subscribed)
1514+ return (sln, subscribed, occ)
1555
1515
1556cleanupMergeSubscribed :: MergeSubscribed x k -> IO ()
1516cleanupMergeSubscribed :: MergeSubscribed x k -> IO ()
1557cleanupMergeSubscribed subscribed = do
1517cleanupMergeSubscribed subscribed = do
@@ -1564,24 +1524,28 @@ cleanupMergeSubscribed subscribed = do
1564subscribeMergeSubscribed :: MergeSubscribed x k -> Subscriber x (DMap k Identity) -> IO (WeakBagTicket (Subscriber x (DMap k Identity)))
1524subscribeMergeSubscribed :: MergeSubscribed x k -> Subscriber x (DMap k Identity) -> IO (WeakBagTicket (Subscriber x (DMap k Identity)))
1565subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed
1525subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed
1566
1526
1567−{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), FanSubscribed x k) #-}
1527+{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), FanSubscribed x k, Maybe a) #-}
1568−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)
1528+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, Maybe a)
1569getFanSubscribed k f sub = do
1529getFanSubscribed k f sub = do
1570 mSubscribed <- liftIO $ readIORef $ fanSubscribed f
1530 mSubscribed <- liftIO $ readIORef $ fanSubscribed f
1571 case mSubscribed of
1531 case mSubscribed of
1572− Just subscribed -> {-# SCC "hitFan" #-} do
1532+ Just subscribed -> {-# SCC "hitFan" #-} liftIO $ do
1573− sln <- liftIO $ subscribeFanSubscribed k subscribed sub
1533+ sln <- subscribeFanSubscribed k subscribed sub
1534+ occ <- readIORef $ fanSubscribedOccurrence subscribed
1574− return (sln, subscribed)
1535+ return (sln, subscribed, coerce $ DMap.lookup k =<< occ)
1575 Nothing -> {-# SCC "missFan" #-} do
1536 Nothing -> {-# SCC "missFan" #-} do
1576 subscribedRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribedRef not yet initialized"
1537 subscribedRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribedRef not yet initialized"
1577 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
1538 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
1578 s <- liftIO $ newSubscriberFan subscribedUnsafe
1539 s <- liftIO $ newSubscriberFan subscribedUnsafe
1579− subscription <- subscribe (fanParent f) s
1540+ (subscription, parentOcc) <- subscribeAndRead (fanParent f) s
1580 weakSelf <- liftIO $ newIORef $ error "getFanSubscribed: weakSelf not yet initialized"
1541 weakSelf <- liftIO $ newIORef $ error "getFanSubscribed: weakSelf not yet initialized"
1581 (subsForK, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupFanSubscribed
1542 (subsForK, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupFanSubscribed
1582 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
1543 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
1544+ occRef <- liftIO $ newIORef parentOcc
1545+ when (isJust parentOcc) $ scheduleClear occRef
1583 let subscribed = FanSubscribed
1546 let subscribed = FanSubscribed
1584 { fanSubscribedCachedSubscribed = fanSubscribed f
1547 { fanSubscribedCachedSubscribed = fanSubscribed f
1548+ , fanSubscribedOccurrence = occRef
1585 , fanSubscribedParent = subscription
1549 , fanSubscribedParent = subscription
1586 , fanSubscribedSubscribers = subscribersRef
1550 , fanSubscribedSubscribers = subscribersRef
1587#ifdef DEBUG_NODEIDS
1551#ifdef DEBUG_NODEIDS
@@ -1593,7 +1557,7 @@ getFanSubscribed k f sub = do
1593 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug self "FanSubscribed"
1557 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug self "FanSubscribed"
1594 liftIO $ writeIORef subscribedRef $! subscribed
1558 liftIO $ writeIORef subscribedRef $! subscribed
1595 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed
1559 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed
1596− return (slnForSub, subscribed)
1560+ return (slnForSub, subscribed, coerce $ DMap.lookup k =<< parentOcc)
1597
1561
1598cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k) -> IO ()
1562cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k) -> IO ()
1599cleanupFanSubscribed (k, subscribed) = do
1563cleanupFanSubscribed (k, subscribed) = do
@@ -1619,14 +1583,15 @@ subscribeFanSubscribed k subscribed sub = do
1619 return sln
1583 return sln
1620 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed
1584 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed
1621
1585
1622−{-# SPECIALIZE getSwitchSubscribed :: Switch x a -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), SwitchSubscribed x a) #-}
1586+{-# SPECIALIZE getSwitchSubscribed :: Switch x a -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), SwitchSubscribed x a, Maybe a) #-}
1623−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)
1587+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, Maybe a)
1624getSwitchSubscribed s sub = do
1588getSwitchSubscribed s sub = do
1625 mSubscribed <- liftIO $ readIORef $ switchSubscribed s
1589 mSubscribed <- liftIO $ readIORef $ switchSubscribed s
1626 case mSubscribed of
1590 case mSubscribed of
1627− Just subscribed -> {-# SCC "hitSwitch" #-} do
1591+ Just subscribed -> {-# SCC "hitSwitch" #-} liftIO $ do
1628− sln <- liftIO $ subscribeSwitchSubscribed subscribed sub
1592+ sln <- subscribeSwitchSubscribed subscribed sub
1593+ occ <- readIORef $ switchSubscribedOccurrence subscribed
1629− return (sln, subscribed)
1594+ return (sln, subscribed, occ)
1630 Nothing -> {-# SCC "missSwitch" #-} do
1595 Nothing -> {-# SCC "missSwitch" #-} do
1631 subscribedRef <- liftIO $ newIORef $ error "getSwitchSubscribed: subscribed has not yet been created"
1596 subscribedRef <- liftIO $ newIORef $ error "getSwitchSubscribed: subscribed has not yet been created"
1632 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
1597 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
@@ -1662,7 +1627,7 @@ getSwitchSubscribed s sub = do
1662 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
1627 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
1663 liftIO $ writeIORef subscribedRef $! subscribed
1628 liftIO $ writeIORef subscribedRef $! subscribed
1664 liftIO $ writeIORef (switchSubscribed s) $ Just subscribed
1629 liftIO $ writeIORef (switchSubscribed s) $ Just subscribed
1665− return (slnForSub, subscribed)
1630+ return (slnForSub, subscribed, parentOcc)
1666
1631
1667cleanupSwitchSubscribed :: SwitchSubscribed x a -> IO ()
1632cleanupSwitchSubscribed :: SwitchSubscribed x a -> IO ()
1668cleanupSwitchSubscribed subscribed = do
1633cleanupSwitchSubscribed subscribed = do
@@ -1674,14 +1639,15 @@ cleanupSwitchSubscribed subscribed = do
1674subscribeSwitchSubscribed :: SwitchSubscribed x a -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a))
1639subscribeSwitchSubscribed :: SwitchSubscribed x a -> Subscriber x a -> IO (WeakBagTicket (Subscriber x a))
1675subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed
1640subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed
1676
1641
1677−{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence x a -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), CoincidenceSubscribed x a) #-}
1642+{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence x a -> Subscriber x a -> EventM x (WeakBagTicket (Subscriber x a), CoincidenceSubscribed x a, Maybe a) #-}
1678−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)
1643+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, Maybe a)
1679getCoincidenceSubscribed c sub = do
1644getCoincidenceSubscribed c sub = do
1680 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c
1645 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c
1681 case mSubscribed of
1646 case mSubscribed of
1682− Just subscribed -> {-# SCC "hitCoincidence" #-} do
1647+ Just subscribed -> {-# SCC "hitCoincidence" #-} liftIO $ do
1683− sln <- liftIO $ subscribeCoincidenceSubscribed subscribed sub
1648+ sln <- subscribeCoincidenceSubscribed subscribed sub
1649+ occ <- readIORef $ coincidenceSubscribedOccurrence subscribed
1684− return (sln, subscribed)
1650+ return (sln, subscribed, occ)
1685 Nothing -> {-# SCC "missCoincidence" #-} do
1651 Nothing -> {-# SCC "missCoincidence" #-} do
1686 subscribedRef <- liftIO $ newIORef $ error "getCoincidenceSubscribed: subscribed has not yet been created"
1652 subscribedRef <- liftIO $ newIORef $ error "getCoincidenceSubscribed: subscribed has not yet been created"
1687 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
1653 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
@@ -1716,7 +1682,7 @@ getCoincidenceSubscribed c sub = do
1716 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
1682 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
1717 liftIO $ writeIORef subscribedRef $! subscribed
1683 liftIO $ writeIORef subscribedRef $! subscribed
1718 liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed
1684 liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed
1719− return (slnForSub, subscribed)
1685+ return (slnForSub, subscribed, occ)
1720
1686
1721cleanupCoincidenceSubscribed :: CoincidenceSubscribed x a -> IO ()
1687cleanupCoincidenceSubscribed :: CoincidenceSubscribed x a -> IO ()
1722cleanupCoincidenceSubscribed subscribed = do
1688cleanupCoincidenceSubscribed subscribed = do
@@ -2164,10 +2130,11 @@ instance R.ReflexHost (SpiderEnv x) where
2164 type HostFrame (SpiderEnv x) = SpiderHostFrame x
2130 type HostFrame (SpiderEnv x) = SpiderHostFrame x
2165
2131
2166instance R.MonadReadEvent (SpiderEnv x) (ReadPhase x) where
2132instance R.MonadReadEvent (SpiderEnv x) (ReadPhase x) where
2167− {-# INLINABLE readEvent #-}
2133+ {-# NOINLINE readEvent #-}
2168 readEvent h = ReadPhase $ fmap (fmap return) $ liftIO $ do
2134 readEvent h = ReadPhase $ fmap (fmap return) $ liftIO $ do
2135+ result <- readIORef $ spiderEventHandleValue h
2169 touch h
2136 touch h
2170− readIORef $ spiderEventHandleValue h
2137+ return result
2171
2138
2172instance MonadRef (EventM x) where
2139instance MonadRef (EventM x) where
2173 type Ref (EventM x) = Ref IO
2140 type Ref (EventM x) = Ref IO