The Computer Language
Benchmarks Game

binary-trees Lisp SBCL #3 program

source code

;;   The Computer Language Benchmarks Game
;;; contributed by Roman Kashitsyn

(deftype uint () '(unsigned-byte 62))

(defconstant min-depth 4 "Minimal depth of the binary tree.")
(defparameter num-workers 4 "Number of concurrent workers.")

(defun build-tree (depth)
    "Build a binary tree of the specified DEPTH. Leaves are represented by NIL,
branches are represented by a cons cell."
  (declare (ftype (function (uint) list) build-tree)
           (uint depth)
           (optimize (speed 3) (safety 0)))
  (if (zerop depth) (cons nil nil)
      (cons (build-tree (1- depth))
            (build-tree (1- depth)))))

(defun check-node (node)
  (declare (ftype (function (list) uint) check-node)
           (optimize (speed 3) (safety 0)))
  (if (null (car node))
      (the uint (+ 1 (check-node (car node)) (check-node (cdr node))))))

(defun check-trees-of-depth (depth max-depth)
  (declare (uint depth max-depth)
           (optimize (speed 3) (safety 0)))
  (loop with iterations of-type uint = (ash 1 (+ max-depth min-depth (- depth)))
        for i of-type uint from 1 upto iterations
        sum (check-node (build-tree depth))
        into result of-type uint
        finally (return (format nil "~d~c trees of depth ~d~c check: ~d~%"
                                iterations #\Tab depth #\Tab result))))

(defun loop-depths-async (max-depth)
  (declare (fixnum max-depth))
  (let* ((tasks (sb-concurrency:make-queue
                 (loop for depth from min-depth by 2 upto max-depth
                       collect depth)))
         (outputs (sb-concurrency:make-queue))
         (threads (loop for i of-type fixnum from 1 to num-workers
                        collect (sb-thread:make-thread
                                 #'(lambda ()
                                     (loop for task = (sb-concurrency:dequeue tasks)
                                           then (sb-concurrency:dequeue tasks)
                                           if task
                                             do (sb-concurrency:enqueue
                                                 (cons task
                                                       (check-trees-of-depth task max-depth))
                                           else do (return)))))))
    (mapc #'sb-thread:join-thread threads)
    (let ((results (sb-concurrency:list-queue-contents outputs)))
      (sort results #'< :key #'car)
      (loop for (k . v) in results
            do (format t "~a" v)))))

(defun binary-trees-upto-size (n)
  (declare (type (integer 0 255) n))
  (format t "stretch tree of depth ~d~c check: ~d~%" (1+ n) #\Tab
          (check-node (build-tree (1+ n))))
  (let ((long-lived-tree (build-tree n)))
    (loop-depths-async n)
    (format t "long lived tree of depth ~d~c check: ~d~%" n #\Tab
            (check-node long-lived-tree))))

(defun main (&optional (n (parse-integer (or (car (last sb-ext:*posix-argv*))
  (binary-trees-upto-size n))

notes, command-line, and program output

64-bit Ubuntu quad core
SBCL 1.4.0

Fri, 08 Dec 2017 23:41:16 GMT

cp: 'binarytrees.sbcl-3.sbcl' and './binarytrees.sbcl-3.sbcl' are the same file
SBCL built with: /opt/src/sbcl-1.4.0/bin/sbcl --userinit /dev/null --batch --eval '(load "binarytrees.sbcl-3.sbcl_compile")'
### START binarytrees.sbcl-3.sbcl_compile
(handler-bind ((sb-ext:defconstant-uneql      (lambda (c) (abort c))))      (require :sb-concurrency)      (load (compile-file "binarytrees.sbcl-3.sbcl" ))) (save-lisp-and-die "sbcl.core" :purify t)
### END binarytrees.sbcl-3.sbcl_compile

; compiling file "/home/dunham/benchmarksgame/bench/binarytrees/binarytrees.sbcl-3.sbcl" (written 08 DEC 2017 03:11:47 PM):
; compiling (DEFTYPE UINT ...)
; compiling (DEFCONSTANT MIN-DEPTH ...)
; compiling (DEFUN BUILD-TREE ...)
; compiling (DEFUN CHECK-NODE ...)
; compiling (DEFUN CHECK-TREES-OF-DEPTH ...)
; compiling (DEFUN LOOP-DEPTHS-ASYNC ...)
; compiling (DEFUN MAIN ...)

; /home/dunham/benchmarksgame_quadcore/binarytrees/tmp/binarytrees.sbcl-3.fasl written
; compilation finished in 0:00:00.026
### START binarytrees.sbcl-3.sbcl_run
(main) (quit)
### END binarytrees.sbcl-3.sbcl_run

3.52s to complete and log all make actions

/opt/src/sbcl-1.4.0/bin/sbcl  --noinform --core sbcl.core --userinit /dev/null --load binarytrees.sbcl-3.sbcl_run 21

stretch tree of depth 22	 check: 8388607
2097152	 trees of depth 4	 check: 65011712
524288	 trees of depth 6	 check: 66584576
131072	 trees of depth 8	 check: 66977792
32768	 trees of depth 10	 check: 67076096
8192	 trees of depth 12	 check: 67100672
2048	 trees of depth 14	 check: 67106816
512	 trees of depth 16	 check: 67108352
128	 trees of depth 18	 check: 67108736
32	 trees of depth 20	 check: 67108832
long lived tree of depth 21	 check: 4194303