From c9a3432d41ffc5d9eae1d043049825c0d9a91353 Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Sun, 9 Jan 2022 12:22:03 +0000 Subject: [PATCH 1/2] Redefine EventNetwork to reduce allocations --- .../Reactive/Banana/Internal/Combinators.hs | 41 +++++++++++-------- 1 file changed, 23 insertions(+), 18 deletions(-) diff --git a/reactive-banana/src/Reactive/Banana/Internal/Combinators.hs b/reactive-banana/src/Reactive/Banana/Internal/Combinators.hs index ac8e7556..dbd0a624 100644 --- a/reactive-banana/src/Reactive/Banana/Internal/Combinators.hs +++ b/reactive-banana/src/Reactive/Banana/Internal/Combinators.hs @@ -1,7 +1,7 @@ {----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} -{-# LANGUAGE FlexibleInstances, NoMonomorphismRestriction #-} +{-# LANGUAGE FlexibleInstances, NamedFieldPuns, NoMonomorphismRestriction #-} module Reactive.Banana.Internal.Combinators where import Control.Concurrent.MVar @@ -43,30 +43,35 @@ interpret f = Prim.interpret $ \pulse -> runReaderT (g pulse) undefined ------------------------------------------------------------------------------} -- | Data type representing an event network. data EventNetwork = EventNetwork - { runStep :: Prim.Step -> IO () - , actuate :: IO () - , pause :: IO () + { actuated :: IORef Bool + , s :: MVar Prim.Network } + +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 + where + whenFlag flag action = readIORef flag >>= \b -> when b action + + +actuate :: EventNetwork -> IO () +actuate EventNetwork{ actuated } = writeIORef actuated True + +pause :: EventNetwork -> IO () +pause EventNetwork{ actuated } = writeIORef actuated False + -- | Compile to an event network. compile :: Moment () -> IO EventNetwork compile setup = do actuated <- newIORef False -- flag to set running status s <- newEmptyMVar -- setup callback machinery - let - whenFlag flag action = readIORef flag >>= \b -> when b action - runStep 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 - - eventNetwork = EventNetwork - { runStep = runStep - , actuate = writeIORef actuated True - , pause = writeIORef actuated False - } + + let eventNetwork = EventNetwork{ actuated, s } (_output, s0) <- -- compile initial graph Prim.compile (runReaderT setup eventNetwork) Prim.emptyNetwork From b0b030880ea52f078adb824942d5390fbfa5a69b Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Sun, 9 Jan 2022 14:32:00 +0000 Subject: [PATCH 2/2] Update reactive-banana/src/Reactive/Banana/Internal/Combinators.hs Co-authored-by: Heinrich Apfelmus --- reactive-banana/src/Reactive/Banana/Internal/Combinators.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/reactive-banana/src/Reactive/Banana/Internal/Combinators.hs b/reactive-banana/src/Reactive/Banana/Internal/Combinators.hs index dbd0a624..c34f05d1 100644 --- a/reactive-banana/src/Reactive/Banana/Internal/Combinators.hs +++ b/reactive-banana/src/Reactive/Banana/Internal/Combinators.hs @@ -55,8 +55,8 @@ runStep EventNetwork{ actuated, s } f = whenFlag actuated $ do (output, s2) <- f s1 -- calculate new state putMVar s s2 -- write state output -- run IO actions afterwards - where - whenFlag flag action = readIORef flag >>= \b -> when b action + where + whenFlag flag action = readIORef flag >>= \b -> when b action actuate :: EventNetwork -> IO ()