mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
46 lines
1.4 KiB
Text
Executable file
46 lines
1.4 KiB
Text
Executable file
#! /usr/bin/env chibi-scheme
|
|
|
|
;;; The Computer Language Benchmarks Game
|
|
;;; http://shootout.alioth.debian.org/
|
|
|
|
(import (chibi) (srfi 9))
|
|
|
|
(define-record-type node
|
|
(make-node value left right)
|
|
node?
|
|
(value node-value node-value-set!)
|
|
(left node-left node-left-set!)
|
|
(right node-right node-right-set!))
|
|
|
|
(define (make value depth)
|
|
(if (zero? depth)
|
|
(make-node value #f #f)
|
|
(let ((v (* value 2))
|
|
(d (- depth 1)))
|
|
(make-node value (make (- v 1) d) (make v d)))))
|
|
|
|
(define (check n)
|
|
(if n
|
|
(+ (node-value n) (- (check (node-left n)) (check (node-right n))))
|
|
0))
|
|
|
|
(define (print . args) (for-each display args) (newline))
|
|
|
|
(let* ((args (command-line))
|
|
(n (string->number (cadr args)))
|
|
(min-depth 4)
|
|
(max-depth (max (+ min-depth 2) n))
|
|
(stretch-depth (+ max-depth 1)))
|
|
(print "stretch tree of depth " stretch-depth "\t check: "
|
|
(check (make 0 stretch-depth)))
|
|
(let ((long-lived-tree (make 0 max-depth)))
|
|
(do ((d min-depth (+ d 2)))
|
|
((>= d max-depth))
|
|
(let ((iterations (* 2 (+ (- max-depth d) min-depth))))
|
|
(print (* 2 iterations) "\t trees of depth " d "\t check: "
|
|
(do ((i 0 (+ i 1))
|
|
(c 0 (+ c (check (make i d)) (check (make (- i) d)))))
|
|
((>= i iterations)
|
|
c)))))
|
|
(print "long lived tree of depth " max-depth "\t check: "
|
|
(check long-lived-tree))))
|