[Haskell-beginners] How to hunt this space-leak

[martin]

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