levels.fullgist

{-# LANGUAGE BangPatterns #-}
import Control.DeepSeq

data Tree a = Leaf | Node (Tree a, a, Tree a)

--  -------  the original code  -----------------
zipAppend [] xs = xs
zipAppend xs [] = xs
zipAppend (x:xs) (y:ys) = (x ++ y) : zipAppend xs ys

levels Leaf = []
levels (Node (l,a,r)) = [a] : zipAppend (levels l) (levels r)
--  ---------------------------------------------

-- A degenerate "stick" tree of height n, all on the right
stick :: Int -> Tree Int
stick 0 = Leaf
stick n = Node (Leaf, n, stick (n-1))

perfect :: Int -> a -> Tree a
perfect 0 x = Node (Leaf, x, Leaf)
perfect h x =
  let sub = perfect (h - 1) x
  in  Node (sub, x, sub)

main :: IO ()
main = do
  let n   = 200000000          -- change until it blows
      t   = stick n
      t' = perfect 18 (18::Int)
  -- evaluate the *entire* list-of-lists before printing
  levels t `deepseq` putStrLn "fully evaluated"


-- and result of running it the minimum 1K stack you can set 
-- time ./levels       +RTS -K1K    -T -s -RTS

fully evaluated
  56,000,055,944 bytes allocated in the heap
       3,933,952 bytes copied during GC
          45,960 bytes maximum residency (2 sample(s))
          31,864 bytes maximum slop
               7 MiB total memory in use (0 MiB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0     13468 colls,     0 par    0.026s   0.028s     0.0000s    0.0060s
  Gen  1         2 colls,     0 par    0.000s   0.000s     0.0002s    0.0002s

  INIT    time    0.001s  (  0.001s elapsed)
  MUT     time    7.887s  (  7.839s elapsed)
  GC      time    0.026s  (  0.028s elapsed)
  RP      time    0.000s  (  0.000s elapsed)
  PROF    time    0.000s  (  0.000s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time    7.913s  (  7.867s elapsed)

  %GC     time       0.0%  (0.0% elapsed)

  Alloc rate    7,100,686,480 bytes per MUT second

  Productivity  99.7% of total user, 99.6% of total elapsed