a2ac059 · patch · git.iko.soy

git.iko.soy/patch

Fix issue where fan children accumulate dead weak references

Need to retain a reference to the (key, subscribed fan node) pairs so that the fan child nodes can clean up the parent when they die

commita2ac059e2e79ca20affc3c6dbfa15508af18020b authorRyan Trinkle <ryan.trinkle@gmail.com> dateSat 16 Jul 2016, 10:50 (10 years ago) parent8d51b9d

2 files changed+11−7

compare with develop

unifiedsplit

src/Data/WeakBag.hs+1−1 src/Reflex/Spider/Internal.hs+10−6

src/Data/WeakBag.hs+1−1

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

3333 wb <- readIORef wbRef'

3434 mb <- deRefWeak wb

3535 forM_ mb $ \b -> do

36− isLastNode <- atomically $ do

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

3737 cs <- readTVar children

3838 let csWithoutMe = IntMap.delete myId cs

3939 writeTVar children $! csWithoutMe

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

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

474474

475475data FanSubscribedChildren k a = FanSubscribedChildren

476476 { _fanSubscribedChildren_list :: !(SubscriberList a)

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

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

478479 }

479480

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

14851486 subscription <- subscribe (fanParent f) s

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

14871488 (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"

14891490 let subscribed = FanSubscribed

14901491 { fanSubscribedCachedSubscribed = fanSubscribed f

14911492 , fanSubscribedParent = subscription

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

14941495 , fanSubscribedNodeId = unsafeNodeId f

14951496#endif

14961497 }

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"

14981501 liftIO $ writeIORef subscribedRef $! subscribed

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

15001503 return (slnForSub, subscribed)

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

15151518subscribeFanSubscribed k subscribed sub = do

15161519 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

15171520 case DMap.lookup k subscribers of

1518− Nothing -> do

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

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

1522+ let !self = (k, subscribed)

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

15201524 (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

15221526 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

15241528

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

15261530getSwitchSubscribed :: (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)