defsubst
[bpt/guile.git] / gc-benchmarks / larceny / run-benchmark.chez
CommitLineData
1b706edf
LC
1;;; Gambit-style run-benchmark.
2;;;
3;;; Invoke this procedure to run a benchmark.
4;;; The first argument is a string identifying the benchmark.
5;;; The second argument is the number of times to run the benchmark.
6;;; The third argument is a thunk that runs the benchmark.
7;;; The fourth argument is a unary predicate that warns if the result
8;;; returned by the benchmark is incorrect.
9;;;
10;;; Example:
11;;; (run-benchmark "make-vector"
12;;; 1
13;;; (lambda () (make-vector 1000000))
14;;; (lambda (v) (and (vector? v) (= (vector-length v) #e1e6))))
15
16;;; For backward compatibility, this procedure also works with the
17;;; arguments that we once used to run benchmarks in Larceny.
18
19(define (run-benchmark name arg2 . rest)
20 (let* ((old-style (procedure? arg2))
21 (thunk (if old-style arg2 (car rest)))
22 (n (if old-style
23 (if (null? rest) 1 (car rest))
24 arg2))
25 (ok? (if (or old-style (null? (cdr rest)))
26 (lambda (result) #t)
27 (cadr rest)))
28 (result '*))
29 (define (loop n)
30 (cond ((zero? n) #t)
31 ((= n 1)
32 (set! result (thunk)))
33 (else
34 (thunk)
35 (loop (- n 1)))))
36 (if old-style
37 (begin (newline)
38 (display "Warning: Using old-style run-benchmark")
39 (newline)))
40 (newline)
41 (display "--------------------------------------------------------")
42 (newline)
43 (display name)
44 (newline)
45 ; time is a macro supplied by Chez Scheme
46 (time (loop n))
47 (if (not (ok? result))
48 (begin (display "Error: Benchmark program returned wrong result: ")
49 (write result)
50 (newline)))))