a2ac059 · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Fix issue where fan children accumulate dead weak references

a2ac059Ryan Trinkle10 years ago

src/Data/WeakBag.hs+1−1

compare with develop

unifiedsplit

@@ -33,7 +33,7 @@ insert a (WeakBag nextId children) wbRef finalizer = do

33 wb <- readIORef wbRef'

34 mb <- deRefWeak wb

35 forM_ mb $ \b -> do

36− isLastNode <- atomically $ do

36+ isLastNode <- atomically $ do --TODO: Should this run even when mb is Nothing?

37 cs <- readTVar children

38 let csWithoutMe = IntMap.delete myId cs

39 writeTVar children $! csWithoutMe

src/Reflex/Spider/Internal.hs+10−6

@@ -474,6 +474,7 @@ data Merge k

474

475data FanSubscribedChildren k a = FanSubscribedChildren

476 { _fanSubscribedChildren_list :: !(SubscriberList a)

477+ , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed k)

477 , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed k)))

478 , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed k)))

478 }

479 }

479

480

@@ -1485,7 +1486,7 @@ getFanSubscribed k f sub = do

1485 subscription <- subscribe (fanParent f) s

1486 subscription <- subscribe (fanParent f) s

1486 weakSelf <- liftIO $ newIORef $ error "getFanSubscribed: weakSelf not yet initialized"

1487 weakSelf <- liftIO $ newIORef $ error "getFanSubscribed: weakSelf not yet initialized"

1487 (subsForK, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupFanSubscribed

1488 (subsForK, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupFanSubscribed

1488− subscribersRef <- liftIO $ newIORef $ DMap.singleton k $ FanSubscribedChildren subsForK weakSelf

1489+ subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"

1489 let subscribed = FanSubscribed

1490 let subscribed = FanSubscribed

1490 { fanSubscribedCachedSubscribed = fanSubscribed f

1491 { fanSubscribedCachedSubscribed = fanSubscribed f

1491 , fanSubscribedParent = subscription

1492 , fanSubscribedParent = subscription

@@ -1494,7 +1495,9 @@ getFanSubscribed k f sub = do

1494 , fanSubscribedNodeId = unsafeNodeId f

1495 , fanSubscribedNodeId = unsafeNodeId f

1495#endif

1496#endif

1496 }

1497 }

1497− liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug (k, subscribed) "FanSubscribed"

1498+ let !self = (k, subscribed)

1499+ liftIO $ writeIORef subscribersRef $! DMap.singleton k $ FanSubscribedChildren subsForK self weakSelf

1500+ liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug self "FanSubscribed"

1498 liftIO $ writeIORef subscribedRef $! subscribed

1501 liftIO $ writeIORef subscribedRef $! subscribed

1499 liftIO $ writeIORef (fanSubscribed f) $! Just subscribed

1502 liftIO $ writeIORef (fanSubscribed f) $! Just subscribed

1500 return (slnForSub, subscribed)

1503 return (slnForSub, subscribed)

@@ -1515,12 +1518,13 @@ subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed k -> Subscriber a -

1515subscribeFanSubscribed k subscribed sub = do

1518subscribeFanSubscribed k subscribed sub = do

1516 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1519 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1517 case DMap.lookup k subscribers of

1520 case DMap.lookup k subscribers of

1518− Nothing -> do

1521+ Nothing -> {-# SCC "missSubscribeFanSubscribed" #-} do

1519− weakSelf <- newIORef =<< mkWeakPtrWithDebug (k, subscribed) "FanSubscribed"

1522+ let !self = (k, subscribed)

1523+ weakSelf <- newIORef =<< mkWeakPtrWithDebug self "FanSubscribed"

1520 (list, sln) <- WeakBag.singleton sub weakSelf cleanupFanSubscribed

1524 (list, sln) <- WeakBag.singleton sub weakSelf cleanupFanSubscribed

1521− writeIORef (fanSubscribedSubscribers subscribed) $! DMap.insertWith (error "subscribeEventSubscribed: key that we just failed to find is present - should be impossible") k (FanSubscribedChildren list weakSelf) subscribers

1525+ writeIORef (fanSubscribedSubscribers subscribed) $! DMap.insertWith (error "subscribeEventSubscribed: key that we just failed to find is present - should be impossible") k (FanSubscribedChildren list self weakSelf) subscribers

1522 return sln

1526 return sln

1523− Just (FanSubscribedChildren list weakSelf) -> WeakBag.insert sub list weakSelf cleanupFanSubscribed

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

1524

1528

1525{-# SPECIALIZE getSwitchSubscribed :: Switch a -> Subscriber a -> EventM x (SubscriberListTicket a, SwitchSubscribed a) #-}

1529{-# SPECIALIZE getSwitchSubscribed :: Switch a -> Subscriber a -> EventM x (SubscriberListTicket a, SwitchSubscribed a) #-}

1526getSwitchSubscribed :: (Defer SomeHoldInit m, Defer SomeAssignment m, Defer SomeMergeInit m, Defer SomeClear m, Defer SomeResetCoincidence m, HasCurrentHeight m, HasSpiderEnv x m) => Switch a -> Subscriber a -> m (SubscriberListTicket a, SwitchSubscribed a)

1530getSwitchSubscribed :: (Defer SomeHoldInit m, Defer SomeAssignment m, Defer SomeMergeInit m, Defer SomeClear m, Defer SomeResetCoincidence m, HasCurrentHeight m, HasSpiderEnv x m) => Switch a -> Subscriber a -> m (SubscriberListTicket a, SwitchSubscribed a)