diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,9 +1,21 @@ -Changelog for the `reactive-banana** package +Changelog for the `reactive-banana` package ------------------------------------------- -**Unreleased** +**Version 1.3.1.0** (2002-08-11) -* Increased upper bounds of `transformers`, `semigroups` and `hashable` +* Various internal performance improvements. [#257][], [#258][] +* Fix a space leak in dynamic event switching. [#256][] +* Reduce memory usage of `stepper`/`accumB`. [#260][] +* Prevent a deadlock if the network crashes when evaluating a `Behavior` or `Event`. [#262][] + + [#257]: https://github.com/HeinrichApfelmus/reactive-banana/pull/257 + [#258]: https://github.com/HeinrichApfelmus/reactive-banana/pull/258 + [#256]: https://github.com/HeinrichApfelmus/reactive-banana/pull/256 + [#262]: https://github.com/HeinrichApfelmus/reactive-banana/pull/262 + [#260]: https://github.com/HeinrichApfelmus/reactive-banana/pull/260 + +**Version 1.3.0.0** (2022-03-28) + * Added `Semigroup` and `Monoid` instances to `Moment` and `MomentIO`. [#223][] * Add `@>` operator. [#229][] * `switchE` now takes an initial event. This is breaking change. The previous behavior can be restored by using `switchE never`. [#165][] diff --git a/reactive-banana.cabal b/reactive-banana.cabal --- a/reactive-banana.cabal +++ b/reactive-banana.cabal @@ -1,5 +1,5 @@ Name: reactive-banana -Version: 1.3.0.0 +Version: 1.3.1.0 Synopsis: Library for functional reactive programming (FRP). Description: Reactive-banana is a library for Functional Reactive Programming (FRP). diff --git a/src/Reactive/Banana/Prim/High/Combinators.hs b/src/Reactive/Banana/Prim/High/Combinators.hs --- a/src/Reactive/Banana/Prim/High/Combinators.hs +++ b/src/Reactive/Banana/Prim/High/Combinators.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances, NamedFieldPuns, NoMonomorphismRestriction #-} module Reactive.Banana.Prim.High.Combinators where +import Control.Exception import Control.Concurrent.MVar import Control.Event.Handler import Control.Monad @@ -50,11 +51,15 @@ runStep :: EventNetwork -> Prim.Step -> IO () runStep EventNetwork{ actuated, s } f = whenFlag actuated $ do - s1 <- takeMVar s -- read and take lock - -- pollValues <- sequence polls -- poll mutable data - (output, s2) <- f s1 -- calculate new state - putMVar s s2 -- write state - output -- run IO actions afterwards + output <- mask $ \restore -> do + s1 <- takeMVar s -- read and take lock + -- pollValues <- sequence polls -- poll mutable data + (output, s2) <- + restore (f s1) -- calculate new state + `onException` putMVar s s1 -- on error, restore the original state + putMVar s s2 -- write state + return output + output -- run IO actions afterwards where whenFlag flag action = readIORef flag >>= \b -> when b action diff --git a/src/Reactive/Banana/Prim/Low/Dependencies.hs b/src/Reactive/Banana/Prim/Low/Dependencies.hs --- a/src/Reactive/Banana/Prim/Low/Dependencies.hs +++ b/src/Reactive/Banana/Prim/Low/Dependencies.hs @@ -72,7 +72,18 @@ forM_ _parentsP $ \w -> do Just (P parent) <- deRefWeak w -- get parent node finalize w -- severe connection in garbage collector - let isGoodChild w = not . maybe True (== P child) <$> deRefWeak w + let isGoodChild w = deRefWeak w >>= \x -> + case x of + Just y | y /= P child -> return True + _ -> do + -- The old parent refers to this child. In this case we'll remove + -- this child from the parent, but we also need to finalize the + -- weak pointer that points to the child. We need to do this because + -- otherwise the weak pointer will stay alive (even though it's + -- unreachable) for as long as the child is alive + -- https://github.com/HeinrichApfelmus/reactive-banana/pull/256 + finalize w + return False new <- filterM isGoodChild . _childrenP =<< readRef parent modify' parent $ set childrenP new -- replace parents by empty list diff --git a/src/Reactive/Banana/Prim/Low/Evaluation.hs b/src/Reactive/Banana/Prim/Low/Evaluation.hs --- a/src/Reactive/Banana/Prim/Low/Evaluation.hs +++ b/src/Reactive/Banana/Prim/Low/Evaluation.hs @@ -1,6 +1,7 @@ {----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE RecordWildCards #-} module Reactive.Banana.Prim.Low.Evaluation ( step @@ -45,7 +46,7 @@ actions = OB.inOrder outputs outputs1 -- EvalO actions in proper order state2 :: Network - state2 = Network + !state2 = Network { nTime = next time1 , nOutputs = OB.inserts outputs1 os , nAlwaysP = alwaysP @@ -113,7 +114,7 @@ then go xs q -- pulse has already been put into the queue once else do -- pulse needs to be scheduled for evaluation put p $! (let p = Pulse{..} in p { _seenP = time }) - go xs (Q.insert _levelP node q) - go (node:xs) q = go xs (Q.insert ground node q) + go xs $! Q.insert _levelP node q + go (node:xs) q = go xs $! Q.insert ground node q -- O and L nodes have only one parent, so -- we can insert them at an arbitrary level diff --git a/src/Reactive/Banana/Prim/Mid/Combinators.hs b/src/Reactive/Banana/Prim/Mid/Combinators.hs --- a/src/Reactive/Banana/Prim/Mid/Combinators.hs +++ b/src/Reactive/Banana/Prim/Mid/Combinators.hs @@ -98,7 +98,11 @@ accumL :: a -> Pulse (a -> a) -> Build (Latch a, Pulse a) accumL a p1 = do (updateOn, x) <- newLatch a - p2 <- applyP (mapL (\x f -> f x) x) p1 + p2 <- newPulse "accumL" $ do + a <- readLatchP x + f <- readPulseP p1 + return $ fmap (\g -> g a) f + p2 `dependOn` p1 updateOn p2 return (x,p2)