binary-trees Lisp SBCL program
source code
;; The Computer Language Benchmarks Game
;; https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
;;;
;;; contributed by Manuel Giraud
;;; modified by Nicolas Neuss
;;; modified by Juho Snellman 2005-10-26
;;;
;;; modified by Witali Kusnezow 2009-01-20
;;; * simplified structure of leaf nodes
;;; * optimize GC usage
;;; * optimize all functions
;;;
;;; modified by Witali Kusnezow 2009-08-20
;;; * remove GC hacks to satisfy new versions of the sbcl
;;;
;;; *reset*
;;; Node is either (DATA) (for leaf nodes) or an improper list (DATA LEFT . RIGHT)
(defun build-btree (item depth)
(declare (fixnum item depth))
(if (zerop depth) (list item)
(let ((item2 (+ item item))
(depth-1 (1- depth)))
(declare (fixnum item2 depth-1))
(cons item
(cons (build-btree (the fixnum (1- item2)) depth-1)
(build-btree item2 depth-1))))))
(defun check-node (node)
(declare (values fixnum))
(let ((data (car node))
(kids (cdr node)))
(declare (fixnum data))
(if kids
(+ (+ 1 (check-node (car kids)))
(check-node (cdr kids)))
1)))
(defun loop-depths (max-depth &key (min-depth 4))
(declare (type fixnum max-depth min-depth))
(loop for d of-type fixnum from min-depth by 2 upto max-depth do
(loop with iterations of-type fixnum = (ash 1 (+ max-depth min-depth (- d)))
for i of-type fixnum from 1 upto iterations
sum (the fixnum (check-node (build-btree i d)))
into result of-type fixnum
finally
(format t "~D trees of depth ~D check: ~D~%"
(the fixnum iterations) d result))))
(defun main (&optional (n (parse-integer
(or (car (last #+sbcl sb-ext:*posix-argv*
#+cmu extensions:*command-line-strings*
#+gcl si::*command-args*))
"1"))))
(declare (type (integer 0 255) n))
(format t "stretch tree of depth ~D check: ~D~%" (1+ n) (check-node (build-btree 0 (1+ n))))
(let ((*print-pretty* nil) (long-lived-tree (build-btree 0 n)))
; (purify)
(loop-depths n)
(format t "long lived tree of depth ~D check: ~D~%" n (check-node long-lived-tree))))
notes, command-line, and program output
NOTES:
64-bit Ubuntu quad core
SBCL 2.0.4
Thu, 21 May 2020 23:02:13 GMT
MAKE:
cp: 'binarytrees.sbcl' and './binarytrees.sbcl' are the same file
SBCL built with: /usr/local/bin/sbcl --userinit /dev/null --batch --eval '(load "binarytrees.sbcl_compile")'
### START binarytrees.sbcl_compile
(handler-bind ((sb-ext:defconstant-uneql (lambda (c) (abort c)))) (require :sb-concurrency) (load (compile-file "binarytrees.sbcl" ))) (save-lisp-and-die "sbcl.core" :purify t)
### END binarytrees.sbcl_compile
; compiling file "/home/dunham/8000-benchmarksgame/bench/binarytrees/binarytrees.sbcl" (written 24 NOV 2018 09:19:39 AM):
; compiling (DEFUN BUILD-BTREE ...)
; compiling (DEFUN CHECK-NODE ...)
; file: /home/dunham/8000-benchmarksgame/bench/binarytrees/binarytrees.sbcl
; in: DEFUN CHECK-NODE
; (LET ((DATA (CAR NODE)) (KIDS (CDR NODE)))
; (DECLARE (FIXNUM DATA))
; (IF KIDS
; (+ (+ 1 (CHECK-NODE #)) (CHECK-NODE (CDR KIDS)))
; 1))
;
; caught STYLE-WARNING:
; The variable DATA is defined but never used.
; compiling (DEFUN LOOP-DEPTHS ...)
; compiling (DEFUN MAIN ...);
; compilation unit finished
; caught 1 STYLE-WARNING condition
; wrote /home/dunham/benchmarksgame_quadcore/binarytrees/tmp/binarytrees.fasl
; compilation finished in 0:00:00.170
### START binarytrees.sbcl_run
(main) (quit)
### END binarytrees.sbcl_run
4.49s to complete and log all make actions
COMMAND LINE:
/usr/local/bin/sbcl --noinform --core sbcl.core --userinit /dev/null --load binarytrees.sbcl_run 21
PROGRAM OUTPUT:
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