[Haskell-cafe] Space usage problems

[Ian Lynagh]

Hi all,

I am having space issues with some decompression code; I've attached a
much simplified version as Test1.hs.

At the bottom (foo/bar) is the equivalent of deflate. This should be a
standalone module which doesn't know about the rest.

In the middle (readChunks) is the equivalent of gunzip. It repeatedly
calls foo until there is no more input left.

At the top is a simple main function that calls them.

If I do

    dd if=/dev/zero of=data bs=1000 count=3000" # making data around 3MB
    ghc --make Test1 -o Test1 -O -Wall
    ./Test1

then in top I see Test1 increasing memory usage to around 150MB. I think
this is because the "let (ys, zs) = foo xs" means zs holds on to xs
(it's hard to be sure as compiling for profiling is too happy to change
the behaviour).

I tried (Test2) changing foo to be a monad transformer over the calling
monad, so the caller's remaining input was updated as we went along, but
(as well as memory usage not obviously being fixed) this is giving me a
stack overflow.


Has anyone got any suggestions for making a constant space, constant
stack version?


Thanks
Ian

-------------- next part --------------

module Main (main) where

import Control.Monad (liftM)
import Control.Monad.State (State, runState, evalState, get, put)

main :: IO ()
main = do xs <- readFile "data"
          ys <- readFile "data"
          print (evalState readChunks xs == ys)

---

type FirstMonad = State String

readChunks :: FirstMonad String
readChunks = do xs <- get
                if null xs then return []
                           else do let (ys, zs) = foo xs
                                   put zs
                                   rest <- readChunks
                                   return (ys ++ rest)

---

type SecondMonad = State String

foo :: String -> (String, String)
foo = runState bar

bar :: SecondMonad String
bar = do inp <- get
         case inp of
             [] -> return []
             x:xs -> do put xs
                        liftM (x:) bar

-------------- next part --------------

module Main (main) where

import Control.Monad (liftM)
import Control.Monad.Trans (lift)
import Control.Monad.State (StateT, evalStateT, State, evalState, get, put)

main :: IO ()
main = do xs <- readFile "data"
          ys <- readFile "data"
          print (evalState readChunks xs == ys)

---

type InnerMonad = State String

readChunks :: InnerMonad String
readChunks = do xs <- get
                if null xs then return []
                           else do ys <- foo get put
                                   rest <- readChunks
                                   return (ys ++ rest)

---

data St m = St { get_inp :: m String, put_inp :: String -> m () }
type OuterMonad m = StateT (St m) m

foo :: Monad m => m String -> (String -> m ()) -> m String
foo getter putter = evalStateT bar (St getter putter)

bar :: Monad m => OuterMonad m String
bar = do st <- get
         inp <- lift $ get_inp st
         case inp of
             [] -> return []
             x:xs -> do lift $ put_inp st xs
                        liftM (x:) bar