;;; Gambit-style run-benchmark. ;;; ;;; Invoke this procedure to run a benchmark. ;;; The first argument is a string identifying the benchmark. ;;; The second argument is the number of times to run the benchmark. ;;; The third argument is a thunk that runs the benchmark. ;;; The fourth argument is a unary predicate that warns if the result ;;; returned by the benchmark is incorrect. ;;; ;;; Example: ;;; (run-benchmark "make-vector" ;;; 1 ;;; (lambda () (make-vector 1000000)) ;;; (lambda (v) (and (vector? v) (= (vector-length v) #e1e6)))) ;;; For backward compatibility, this procedure also works with the ;;; arguments that we once used to run benchmarks in Larceny. (define (run-benchmark name arg2 . rest) (let* ((old-style (procedure? arg2)) (thunk (if old-style arg2 (car rest))) (n (if old-style (if (null? rest) 1 (car rest)) arg2)) (ok? (if (or old-style (null? (cdr rest))) (lambda (result) #t) (cadr rest))) (result '*)) (define (loop n) (cond ((zero? n) #t) ((= n 1) (set! result (thunk))) (else (thunk) (loop (- n 1))))) (if old-style (begin (newline) (display "Warning: Using old-style run-benchmark") (newline))) (newline) (display "--------------------------------------------------------") (newline) (display name) (newline) ; time is a macro supplied by Chez Scheme (time (loop n)) (if (not (ok? result)) (begin (display "Error: Benchmark program returned wrong result: ") (write result) (newline)))))