Block
    Let n (parse_command_line)
    In
    Let max_depth (Z.max n [min_depth + 2])
    In
    Let stretch_depth [max_depth + 1]
    In
    Do  (report 1 stretch_depth (tree_checksum (create_tree stretch_depth)))
    Let long_lived_tree (create_tree max_depth)
    Let counter (create_register)
    In
    Begin
        (LIST.for_each (depths min_depth max_depth)
            Func depth
                Let num_trees (Z.pow 2 [max_depth - depth + min_depth])
                In
                Begin
                    (counter.store 0)
                    (repeat num_trees
                        Func {} (incr counter (tree_checksum (create_tree depth))))
                    (report num_trees depth (counter.fetch))
                End)
        (report 1 max_depth (tree_checksum long_lived_tree))
    End

Where

Let min_depth 4

Define (depths min_depth max_depth)
    Unfold depth From min_depth
        If [depth > max_depth] 'nil [depth & (Fold [depth + 2])]

Define (parse_command_line)
    Let argc (OS.fetch_argc)
    In
    Cond
    | [argc > 2] (OS.die "Usage error.")
    | [argc = 2]
        Match (Z.read (OS.fetch_arg 1))
        | 'nothing (OS.die "Invalid argument.")
        | 'just.n n
        ;
    | True 0
    ;

Define (create_register)
    Let p (SCRATCHPAD.new 4)
    In
    {
    : fetch Func {} (SCRATCHPAD.fetch_uint32_le p 0)
    : store Func n (SCRATCHPAD.store_uint32_le p 0 n)
    }

Define (incr reg n)
    (reg.store [(reg.fetch) + n])

Define (repeat i f)
    Iterate i
        When [i > 0]
            (f)
            (Continue [i - 1])
        End

Define (report num_trees depth sum)
    (STDIO.print_line
        (STRING.concat
            [Right (Z.show num_trees) & " trees; depth: " & (Z.show depth) &
                "; sum: " & (Z.show sum) & 'nil]))

Define (create_tree depth)
    Unfold depth
        If [depth = 0]
            'leaf
            'branch.{
                (Fold [depth - 1])
                (Fold [depth - 1])
            }

Define (tree_checksum tree)
    Unfold tree
        Match tree
        | 'branch.{left right} [1 + (Fold left) + (Fold right)]
        | 'leaf 1
        ;

Where

Let LIST Package "list"
Let OS Package "os"
Let SCRATCHPAD Package "scratchpad"
Let STDIO Package "stdio"
Let STRING Package "string"
Let Z Package "z"