[Haskell-cafe] Re: Space Leak Help

Dominic Steinitz dominic.steinitz at blueyonder.co.uk
Sun Feb 4 06:17:01 EST 2007


If anyone wants to play with this, here's a version of the leak that doesn't 
need any libraries or extensions.

pad causes a stack overflow and pad1 uses up about 6m of heap.

Dominic.

module Main(main) where

import Data.Word
import Data.Bits
import Data.List

pad = pad' 0
  where pad' l [] = [0x80] ++ ps
          where pl = (64-(l+9)) `mod` 64
                ps = replicate pl 0x00
        pad' l (x:xs) = x : pad' (l+1) xs

pad1 xs =
   xs ++ [0x80] ++ ps
   where
      l = length xs
      pl = (64-(l+9)) `mod` 64
      ps = replicate pl 0x00

test :: Int -> Word8
test n = foldl' xor 0x55 (pad (replicate n 0x55))

test1 :: Int -> Word8
test1 n = foldl' xor 0x55 (pad1 (replicate n 0x55))

main = putStrLn (show (test1 1000001))



More information about the Haskell-Cafe mailing list