Partial fix for HeinrichApfelmus#261

circuithub · Oct 5, 2022 · 2d3a7a5 · 2d3a7a5
1 parent b22757f
commit 2d3a7a5
Showing 1 changed file with 6 additions and 0 deletions.
diff --git a/reactive-banana/src/Reactive/Banana/Prim/Low/Dependencies.hs b/reactive-banana/src/Reactive/Banana/Prim/Low/Dependencies.hs
@@ -59,6 +59,12 @@ doAddChild (P parent) (P child) = do
     level2 <- _levelP <$> readRef parent
     let level = level1 `max` (level2 + 1)
     w <- parent `connectChild` P child
+
+    -- Remove any dead children. These three lines are new.
+    let alive w = maybe False (const True) <$> deRefWeak w
+    children' <- filterM alive . _childrenP =<< readRef parent
+    modify' parent $ set childrenP children'
+
     modify' child $ set levelP level . update parentsP (w:)
 doAddChild (P parent) node = void $ parent `connectChild` node
 doAddChild (L _) _ = error "doAddChild: Cannot add children to LatchWrite"