[Haskell-cafe] turning an imperative loop to Haskell

Henning Thielemann lemming at henning-thielemann.de
Thu Sep 6 08:32:13 EDT 2007


On Thu, 6 Sep 2007, Axel Gerstenberger wrote:

> module Main where
>
> import System.IO
> import Text.Printf
>
> main :: IO ()
> main = do
>    let all_results1 = take 20000 $ step [1]
>    --print $ length all_results1 -- BTW: if not commented out,
>                                  --      all values of all_results
>                                  --      are already
>                                  --      calculated here
>    loop [1..50] $ \i -> do
>        let x = all_results1!!i
>        putStrLn $ show i ++ "  " ++ show x

The guilty thing is (!!). Better write

loop all_results1 $ \x -> do
       putStrLn $ show i ++ "  " ++ show x

In your program, the reference to the beginning of the list all_results1 
is kept throughout the loop and thus the garbage collector cannot free the 
memory.

('loop' is available as 'forM_' in GHC-6.6
    http://www.haskell.org/ghc/docs/latest/html/libraries/base/Control-Monad.html#v%3AforM_)


See also:
  http://www.haskell.org/haskellwiki/Things_to_avoid#Lists_are_not_arrays


More information about the Haskell-Cafe mailing list