@@ -1730,9 +1730,10 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do
17301730 return (maybeToList (SomeEventSubscription . mergeSubscribedParentSubscription <$> mOldSubd) ++ subscriptionsToKill, newPs)
17311731 (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
17321732 writeIORef (mergeSubscribedParents m) $! newParents
1733− invalidateMergeHeight m
17341733 return subscriptionsToKill
1734+ when debugPropagate $ putStrLn "Updating merges"
17351735 mergeSubscriptionsToKill <- concat <$> mapM updateMerge mergeUpdates
1736+ when debugPropagate $ putStrLn "Updating merges done"
17361737 toReconnect <- readIORef toReconnectRef
17371738 switchSubscriptionsToKill <- forM toReconnect $ \(SomeSwitchSubscribed subscribed) -> {-# SCC "switchSubscribed" #-} do
17381739 oldSubscription <- readIORef $ switchSubscribedCurrentParent subscribed
@@ -1748,7 +1749,7 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do
17481749 runEventM (runHoldInits holdInitRef mergeInitRef) env --TODO: Is this actually OK? It seems like it should be, since we know that no events are firing at this point, but it still seems inelegant
17491750 --TODO: Make sure we touch the pieces of the SwitchSubscribed at the appropriate times
17501751 sub <- newSubscriberSwitch subscribed
1751− subscription@(EventSubscription _ subd') <- runReaderT (unSpiderHost (runFrame ({-# SCC "subscribeSwitch" #-} subscribe e sub))) spiderEnv --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient
1752+ subscription <- runReaderT (unSpiderHost (runFrame ({-# SCC "subscribeSwitch" #-} subscribe e sub))) spiderEnv --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient
17521753 {-
17531754 stackTrace <- liftIO $ liftM renderStack $ ccsToStrings =<< (getCCSOf $! switchSubscribedParent subscribed)
17541755 liftIO $ putStrLn $ (++stackTrace) $ "subd' subscribed to " ++ case e of
@@ -1757,17 +1758,21 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do
17571758 _ -> "something else"
17581759 -}
17591760 writeIORef (switchSubscribedCurrentParent subscribed) $! subscription
1761+ return $ SomeEventSubscription oldSubscription
1762+ forM_ mergeSubscriptionsToKill $ \(SomeEventSubscription oldSubscription) -> liftIO $ unsubscribe oldSubscription
1763+ forM_ switchSubscriptionsToKill $ \(SomeEventSubscription oldSubscription) -> liftIO $ unsubscribe oldSubscription
1764+ forM_ toReconnect $ \(SomeSwitchSubscribed subscribed) -> {-# SCC "switchSubscribed" #-} do
1765+ EventSubscription _ subd' <- readIORef $ switchSubscribedCurrentParent subscribed
17601766 parentHeight <- readIORef $ eventSubscribedHeightRef subd'
17611767 myHeight <- readIORef $ switchSubscribedHeight subscribed
17621768 when (parentHeight /= myHeight) $ do
17631769 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
17641770 WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight
1765− return $ SomeEventSubscription oldSubscription
1771+ forM_ mergeUpdates $ \(SomeMergeUpdate _ m) -> do
1772+ invalidateMergeHeight m --TODO: In addition to when the patch is completely empty, we should also not run this if it has some Nothing values, but none of them have actually had any effect; potentially, we could even check for Just values with no effect (e.g. by comparing their IORefs and ignoring them if they are unchanged); actually, we could just check if the new height is different
17661773 forM_ coincidenceInfos $ \(SomeResetCoincidence subscription mcs) -> do
17671774 unsubscribe subscription
17681775 mapM_ invalidateCoincidenceHeight mcs
1769− forM_ mergeSubscriptionsToKill $ \(SomeEventSubscription oldSubscription) -> liftIO $ unsubscribe oldSubscription
1770− forM_ switchSubscriptionsToKill $ \(SomeEventSubscription oldSubscription) -> liftIO $ unsubscribe oldSubscription
17711776 forM_ coincidenceInfos $ \(SomeResetCoincidence _ mcs) -> mapM_ recalculateCoincidenceHeight mcs
17721777 forM_ mergeUpdates $ \(SomeMergeUpdate _ m) -> revalidateMergeHeight m
17731778 forM_ toReconnect $ \(SomeSwitchSubscribed subscribed) -> do
@@ -1835,6 +1840,7 @@ invalidateSubscriberHeight old s = case s of
18351840
18361841removeMergeHeight :: Height -> MergeSubscribed k -> IO ()
18371842removeMergeHeight oldParentHeight subscribed = do
1843+ when debugInvalidateHeight $ putStrLn $ "removeMergeHeight: " <> show oldParentHeight <> " Merge" <> showNodeId subscribed
18381844 oldHeights <- readIORef $ mergeSubscribedHeightBag subscribed
18391845 let newHeights = heightBagRemove oldParentHeight oldHeights
18401846 writeIORef (mergeSubscribedHeightBag subscribed) $! newHeights
@@ -1849,20 +1855,26 @@ invalidateMergeHeight subscribed = do
18491855
18501856addMergeHeight :: Height -> MergeSubscribed k -> IO ()
18511857addMergeHeight newParentHeight subscribed = do
1858+ when debugInvalidateHeight $ putStrLn $ "addMergeHeight: " <> show newParentHeight <> " Merge" <> showNodeId subscribed
18521859 oldHeights <- readIORef $ mergeSubscribedHeightBag subscribed
18531860 let newHeights = heightBagAdd newParentHeight oldHeights
18541861 writeIORef (mergeSubscribedHeightBag subscribed) $! newHeights
18551862
18561863revalidateMergeHeight :: MergeSubscribed k -> IO ()
18571864revalidateMergeHeight subscribed = do
1858− heights <- readIORef $ mergeSubscribedHeightBag subscribed
1859− parents <- readIORef $ mergeSubscribedParents subscribed
1860− -- When the number of heights in the bag reaches the number of parents, we should have a valid height
1861− when (heightBagSize heights == DMap.size parents) $ do
1862− let height = succHeight $ heightBagMax heights
1863− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: height: " <> show height
1864− writeIORef (mergeSubscribedHeight subscribed) $! height
1865− WeakBag.traverse (mergeSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height
1865+ currentHeight <- readIORef $ mergeSubscribedHeight subscribed
1866+ when (currentHeight == invalidHeight) $ do -- revalidateMergeHeight may be called multiple times; perhaps the's a way to finesse it to avoid this check
1867+ heights <- readIORef $ mergeSubscribedHeightBag subscribed
1868+ parents <- readIORef $ mergeSubscribedParents subscribed
1869+ -- When the number of heights in the bag reaches the number of parents, we should have a valid height
1870+ case heightBagSize heights `compare` DMap.size parents of
1871+ LT -> return ()
1872+ EQ -> do
1873+ let height = succHeight $ heightBagMax heights
1874+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: height: " <> show height
1875+ writeIORef (mergeSubscribedHeight subscribed) $! height
1876+ WeakBag.traverse (mergeSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height
1877+ GT -> error $ "revalidateMergeHeight: more heights than parents for Merge" <> showNodeId subscribed
18661878
18671879invalidateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()
18681880invalidateCoincidenceHeight subscribed = do