Hi Sakari,

I've been putting all of my working energy into paper writing (see http://conal.net/blog) and so haven't had focus for Reactive lately.  The paper deadline is Monday, so I'll get back to Reactive soon.

  - Conal

On Mon, Feb 23, 2009 at 12:23 PM, Sakari Jokinen <sakariij@gmail.com> wrote:
Hi,

I have a somewhat larger program using reactive which seems to leak
memory. I have narrowed at least one possible cause to justE.  If I
run main_justE  in ghci it eats all the memory while main_filterE
seems to run fine in constant.

What am I missing here? I'm using ghc 6.10 and reactive 0.10.5.

> module Main where
> import Control.Monad.Trans(MonadIO, liftIO)
> import Control.Concurrent
> import Control.Monad
> import FRP.Reactive
> import FRP.Reactive.LegacyAdapters
> import Data.Monoid(mappend)
> import Data.Maybe

> main_justE = do
>  clock <- makeClock
>  (sink, taskevents) <- makeEvent clock
>  let go _ = Just $ sink $ Nothing
>  adaptE $ justE $ fmap go (atTimes [0, 0.1 .. ]) `mappend` taskevents

> instance Show (IO a) where
>     show _ = "IO"

> main_filterE = do
>   clock <- makeClock
>   (sink, taskevents) <- makeEvent clock
>   let go _ = Just $ sink $ Nothing
>       justE' = fmap fromJust . filterE (maybe False (const True))
>   adaptE $ justE' $ fmap go (atTimes [0, 0.1 ..]) `mappend` taskevents


Br,
Sakari
_______________________________________________
Reactive mailing list
Reactive@haskell.org
http://www.haskell.org/mailman/listinfo/reactive