binary-trees Lisp SBCL program

;;   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:
64-bit Ubuntu quad core
SBCL 2.4.8


 Fri, 06 Sep 2024 20:58:00 GMT

MAKE:
cp: 'binarytrees.sbcl' and './binarytrees.sbcl' are the same file
SBCL built with: /opt/src/sbcl-2.4.8/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/all-benchmarksgame/benchmarksgame_i53330/binarytrees/tmp/binarytrees.sbcl" (written 24 NOV 2018 09:19:39 AM):

; file: /home/dunham/all-benchmarksgame/benchmarksgame_i53330/binarytrees/tmp/binarytrees.sbcl
; in: DEFUN CHECK-NODE
;     (DATA (CAR NODE))
; 
; caught STYLE-WARNING:
;   The variable DATA is defined but never used.
; 
; compilation unit finished
;   caught 1 STYLE-WARNING condition


; wrote /home/dunham/all-benchmarksgame/benchmarksgame_i53330/binarytrees/tmp/binarytrees.fasl
; compilation finished in 0:00:00.016
### START binarytrees.sbcl_run
(main) (quit)
### END binarytrees.sbcl_run


1.17s to complete and log all make actions

COMMAND LINE:
 /opt/src/sbcl-2.4.8/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