binary_trees.84

\   Binary trees benchmark from the Computer Language Benchmarks Game.
\
\   Sample run with argument 18:
\
\   Language 84:
\
\       real    0m1.542s
\       user    0m1.540s
\       sys     0m0.000s
\
\   C with GCC -O3 (http://benchmarksgame.alioth.debian.org/u64q/program.php?test=binarytrees&lang=gcc&id=1):
\
\       real    0m2.205s
\       user    0m2.183s
\       sys     0m0.020s
\
\   The Language 84 program cheats in that it uses less memory but it's difficult
\   to construct a significantly more fair comparison because the languages are
\   quite different in terms of how they represent data.

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)
    For (rec rec min_depth)
        Define (rec rec depth)
            If [depth > max_depth] `nil [depth & (rec rec [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)
    For (rec rec depth)
        Define (rec rec depth)
            If [depth = 0]
                `leaf
                `branch.{
                    (rec rec [depth - 1])
                    (rec rec [depth - 1])
                }

Define (tree_checksum tree)
    For (rec rec tree)
        Define (rec rec tree)
            Match tree
            | `branch.{left right} [1 + (rec rec left) + (rec rec 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"