From: Manuel Giraud
Subject: Computer Language Shootout submission
Date: 
Message-ID: <87vf44rz4h.fsf@pc-m-ronsard.cetp.ipsl.fr>
Hi,

I'd like to submit an entry in Common Lisp for this benchmark:
http://shootout.alioth.debian.org/benchmark.php?test=binarytrees

Here's what I get so far (mostly translation from the OCaml version +
simple optimisation):

--8<---------------------------------
;;; -*- mode: lisp -*-
;;;
;;; http://shootout.alioth.debian.org/
;;;
;;; From: Manuel Giraud

(defstruct node 
  l
  (c 0 :type fixnum)
  r)

(defun build-node (item depth)
  (declare (fixnum item depth))
  (cond ((zerop depth) (make-node :c item))
	(t (let ((d (1- depth))
		 (item2 (* 2 item)))
	     (make-node :l (build-node (1- item2) d) :c item :r (build-node item2 d))))))

(defun empty-node-p (node)
  (and (null (node-l node)) (null (node-r node))))

(defun check-node (node)
  (the fixnum
    (cond ((empty-node-p node) (the fixnum (node-c node)))
	  (t (+ (node-c node) (- (the fixnum (check-node (node-l node))) (the fixnum (check-node (node-r node)))))))))

(defvar *min-depth* 4)
(defvar *max-depth* (handler-case (parse-integer (car (last #+sbcl sb-ext:*posix-argv*
							    #+cmu  extensions:*command-line-strings*
							    #+gcl  si::*command-args*)))
				  (t () 10)))
(defvar *stretch-depth* (1+ *max-depth*))

(let ((c (check-node (build-node 0 *stretch-depth*))))
  (format t "stretch tree of depth ~A~T  check: ~A~%" *stretch-depth* c))

(defvar *long-lived-tree* (build-node 0 *max-depth*))

(defun loop-depths (d)
  (when (<= d *max-depth*) 
    (let ((iterations (ash 1 (+ *max-depth* *min-depth* (- d))))
	  (c 0))
      (loop for i from 1 to iterations do
	    (incf c (+ (check-node (build-node i d)) (check-node (build-node (- i) d)))))
      (format t "~A~T  trees of depth ~A~T  check: ~A~%" (* 2 iterations) d c)
      (loop-depths (+ d 2)))))

(loop-depths *min-depth*)
(format t "long lived tree of depth ~A~T  check: ~A~%" *max-depth* (check-node *long-lived-tree*))
--8<---------------------------------

It takes about 9secs of CPU time of execution on a faster machine than
they use, so I can expect something between Oberon-2 and Forth in
execution time. How can this be optimize further?

-- 
Manuel Giraud

From: William D Clinger
Subject: Re: Computer Language Shootout submission
Date: 
Message-ID: <1119638283.074463.86270@g14g2000cwa.googlegroups.com>
Manuel Giraud wrote:
> Hi,
>
> I'd like to submit an entry in Common Lisp for this benchmark:
> http://shootout.alioth.debian.org/benchmark.php?test=binarytrees

This is a simplified and shorter-running version of the
Java gcbench benchmark, which (as if you couldn't guess)
is primarily a garbage collection benchmark.

> It takes about 9secs of CPU time of execution on a faster machine than
> they use, so I can expect something between Oberon-2 and Forth in
> execution time. How can this be optimize further?

Larceny's three-generational collector performs well on
the original gcbench, partly because proper tail recursion
is a big win for the destructive phases, which can discard
portions of the tree while it is being created.  (One of
the problems with the benchmark is that it does nothing
realistic with the constructed trees.)  You might look at
the Scheme version of the original gcbench:

http://www.ccs.neu.edu/home/will/GC/Benchmarks/gcbench.sch

Will
From: William D Clinger
Subject: Re: Computer Language Shootout submission
Date: 
Message-ID: <1119642206.061907.141740@g44g2000cwa.googlegroups.com>
Out of curiosity, I translated the benchmark into Scheme:
http://www.ccs.neu.edu/home/will/GC/Benchmarks/binary-trees.sch

On a SunBlade 1500, (binary-trees-benchmark 16) runs in
about 6 seconds (as safe code).  I haven't tried it on
other machines yet.

Will
From: William D Clinger
Subject: Re: Computer Language Shootout submission
Date: 
Message-ID: <1119643505.333257.72300@z14g2000cwz.googlegroups.com>
Regarding the Scheme version of a benchmark, I wrote:

> On a SunBlade 1500, (binary-trees-benchmark 16) runs in
> about 6 seconds (as safe code).

With the suggested compiler options for gcc, the C version
of that benchmark runs in about 12 seconds on that machine
(as unsafe code).

Will
From: Nicolas Neuss
Subject: Re: Computer Language Shootout submission
Date: 
Message-ID: <87br5sxb5c.fsf@ortler.iwr.uni-heidelberg.de>
IMO, the following version is better (nicer structure and variable names,
less declarations, better overall structure, ...).

Nicolas.


(defstruct node
  (item 0 :type fixnum)
  left right)

(defun build-btree (item depth)
  (declare (fixnum item depth))
  (if (zerop depth)
      (make-node :item item)
      (let ((item2 (* 2 item))
            (depth-1 (1- depth)))
        (make-node :item item
                   :left (build-btree (1- item2) depth-1)
                   :right (build-btree item2 depth-1)))))

(defun check-node (node)
  (declare (values fixnum) (optimize speed (safety 0)))
  (if node
      (+ (node-item node)
         (- (check-node (node-left node))
            (check-node (node-right node))))
      0))

(defun loop-depths (max-depth &key (min-depth 4))
  (loop for d from min-depth by 2 upto max-depth do
        (let ((iterations (ash 1 (+ max-depth min-depth (- d)))))
          (format t "~A~T  trees of depth ~A~T  check: ~A~%"
                  iterations d
                  (loop for i from 1 upto iterations 
                        sum (check-node (build-btree i d))
                        sum (check-node (build-btree (- i) d)))))))

(defun main (&optional (n (parse-integer (car (last ext:*command-line-strings*)))))
  (format t "stretch tree of depth ~A~T  check: ~A~%" (1+ n)
          (check-node (build-btree 0 (1+ n))))
  (let ((long-lived-tree (build-btree 0 n)))
    (loop-depths n)
    (format t "long lived tree of depth ~A~T  check: ~A~%"
            n (check-node long-lived-tree))))

;;; (time (main 16))