From 19888f42137b804d55993e952a2440e581c4e8f7 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Mon, 21 May 2018 10:09:58 +0200 Subject: [PATCH 1/3] use tailRecM in make loopthis shuold avoid Memory leak #10 --- src/Control/Monad/Aff/Bus.purs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Control/Monad/Aff/Bus.purs b/src/Control/Monad/Aff/Bus.purs index 138a326..e6975a4 100644 --- a/src/Control/Monad/Aff/Bus.purs +++ b/src/Control/Monad/Aff/Bus.purs @@ -36,8 +36,10 @@ import Control.Monad.Aff.AVar (AVAR, AVar, killVar, makeEmptyVar, putVar, takeVa import Control.Monad.Eff.AVar as EffAvar import Control.Monad.Eff.Class (class MonadEff, liftEff) import Control.Monad.Eff.Exception as Exn +import Control.Monad.Rec.Class (Step(..), tailRecM) +import Data.Either (Either(..)) import Data.Foldable (foldl, sequence_, traverse_) -import Data.List (List, (:)) +import Data.List (List(..), (:)) import Data.Monoid (mempty) import Data.Tuple (Tuple(..)) @@ -60,14 +62,13 @@ make ∷ ∀ m eff a. MonadEff (avar ∷ AVAR | eff) m => m (BusRW a) make = liftEff do cell ← EffAvar.makeEmptyVar consumers ← EffAvar.makeVar mempty - let - loop = attempt (takeVar cell) >>= traverse_ \res → do + launchAff_ $ flip tailRecM unit \_ → attempt (takeVar cell) >>= case _ of + Left _ → pure $ Done unit + Right res → do vars ← takeVar consumers putVar mempty consumers sequence_ (foldl (\xs a → putVar res a : xs) mempty vars) - loop - launchAff_ loop - + pure $ Loop unit pure $ Bus cell consumers -- | Blocks until a new value is pushed to the Bus, returning the value. From 2ad741e7c2dbd178cb1ffb26d71103182724ea4e Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Mon, 21 May 2018 10:25:50 +0200 Subject: [PATCH 2/3] no need for `attempt` if `var` is killed with an error, `takeVar var` will throw that same error so the loop will be terminated. note: before #6 attempt was not used --- src/Control/Monad/Aff/Bus.purs | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/src/Control/Monad/Aff/Bus.purs b/src/Control/Monad/Aff/Bus.purs index e6975a4..aaa404d 100644 --- a/src/Control/Monad/Aff/Bus.purs +++ b/src/Control/Monad/Aff/Bus.purs @@ -31,13 +31,12 @@ module Control.Monad.Aff.Bus import Prelude -import Control.Monad.Aff (Aff, attempt, launchAff_) +import Control.Monad.Aff (Aff, launchAff_) import Control.Monad.Aff.AVar (AVAR, AVar, killVar, makeEmptyVar, putVar, takeVar) import Control.Monad.Eff.AVar as EffAvar import Control.Monad.Eff.Class (class MonadEff, liftEff) import Control.Monad.Eff.Exception as Exn -import Control.Monad.Rec.Class (Step(..), tailRecM) -import Data.Either (Either(..)) +import Control.Monad.Rec.Class (forever) import Data.Foldable (foldl, sequence_, traverse_) import Data.List (List(..), (:)) import Data.Monoid (mempty) @@ -62,13 +61,11 @@ make ∷ ∀ m eff a. MonadEff (avar ∷ AVAR | eff) m => m (BusRW a) make = liftEff do cell ← EffAvar.makeEmptyVar consumers ← EffAvar.makeVar mempty - launchAff_ $ flip tailRecM unit \_ → attempt (takeVar cell) >>= case _ of - Left _ → pure $ Done unit - Right res → do - vars ← takeVar consumers - putVar mempty consumers - sequence_ (foldl (\xs a → putVar res a : xs) mempty vars) - pure $ Loop unit + launchAff_ $ forever do + res ← takeVar cell + vars ← takeVar consumers + putVar Nil consumers + sequence_ (foldl (\xs a → putVar res a : xs) mempty vars) pure $ Bus cell consumers -- | Blocks until a new value is pushed to the Bus, returning the value. From 9896632de5459963a1ba2684c7057a39ce47d36a Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Mon, 21 May 2018 23:23:57 +0200 Subject: [PATCH 3/3] wrap forever with attempt --- src/Control/Monad/Aff/Bus.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Control/Monad/Aff/Bus.purs b/src/Control/Monad/Aff/Bus.purs index aaa404d..3b028f5 100644 --- a/src/Control/Monad/Aff/Bus.purs +++ b/src/Control/Monad/Aff/Bus.purs @@ -31,7 +31,7 @@ module Control.Monad.Aff.Bus import Prelude -import Control.Monad.Aff (Aff, launchAff_) +import Control.Monad.Aff (Aff, attempt, launchAff_) import Control.Monad.Aff.AVar (AVAR, AVar, killVar, makeEmptyVar, putVar, takeVar) import Control.Monad.Eff.AVar as EffAvar import Control.Monad.Eff.Class (class MonadEff, liftEff) @@ -61,7 +61,7 @@ make ∷ ∀ m eff a. MonadEff (avar ∷ AVAR | eff) m => m (BusRW a) make = liftEff do cell ← EffAvar.makeEmptyVar consumers ← EffAvar.makeVar mempty - launchAff_ $ forever do + launchAff_ $ attempt $ forever do res ← takeVar cell vars ← takeVar consumers putVar Nil consumers