Hello all, I hope I am not asking for too much, as to explain my problem, you need to read my code, which may not be a pleasure. I am trying to write a "Logger", which formats and accumulates log-entries in a monoid. From there I went to writing an "accumulating" logger, i.e. one which can accumulate (sum/avg) over entries made with a certain timespan. My problen is memory consumption. In the test below I stress the logger with 1 million values, but in the end result, there are only 10 entries left, because it accumulates over 100,000. Memory goes up to apx 100MB. When I comment out the line, which logs the accumulated value (see -- > below), memory stays below 10MB. I dont understand why this is so. After all, the difference is only whether or not those 10 entries are logged or not. Can someone explain this? {-# LANGUAGE BangPatterns#-} import Data.Monoid import Control.Monad.State.Strict import System.TimeIt import Text.Show.Pretty import Debug.Trace ------------------------------------------------------------ -- Simple Time Stuff ------------------------------------------------------------ type Instant = Double type Interval = Double type Timed a = (Instant, a) instant = fst ------------------------------------------------------------ -- Logger based on State monad ------------------------------------------------------------ data SLogger a l = SLgr {runSLogger :: a ->State l (SLogger a l)} type SLogFormatter a l = a -> l accLogger :: (Monoid c, Show a) => (Instant, Interval, [Timed b]) -> SLogFormatter (Timed a) [Timed b] -> SLogFormatter [Timed b] [Timed c] -> SLogger (Timed a) [Timed c] accLogger (tx, dt, tas) fmt1 fmt2 = SLgr $ \(!ta) -> let x = fmt1 ta !tas' = x <> tas in if instant ta < tx then do -- keep accumulating return $ accLogger (tx, dt, tas') fmt1 fmt2 else do -- compute new log and reset accumulator !l0 <- get -- > put $ fmt2 tas' <> l0 return $ accLogger ((tx+dt), dt, []) fmt1 fmt2 accFmt1 ta = [ta] accFmt2 tas = [(fst $ head tas, "hello from accFormatter")] -- apply logger to a list of as stest lgr [] = return lgr stest lgr (a:as) = do lgr' <- (runSLogger lgr) a stest lgr' as main2 = do let as = zip [1.0 .. 1000000.0] [1..1000000] :: [(Instant, Int)] log = execState (stest (accLogger (100000.0,100000.0,[]) accFmt1 accFmt2 ) as) [(0,"init")] timeIt $ putStrLn $ ppShow log putStrLn "done" main = main2