diff --git a/collects/tests/racket/benchmarks/common/auto.rkt b/collects/tests/racket/benchmarks/common/auto.rkt index ef12ae072e..f0078280ed 100755 --- a/collects/tests/racket/benchmarks/common/auto.rkt +++ b/collects/tests/racket/benchmarks/common/auto.rkt @@ -463,7 +463,7 @@ exec racket -qu "$0" ${1+"$@"} run-exe extract-bigloo-times clean-up-bin - (append '(cpstak nucleic2 takr2) + (append '(ctak cpstak nucleic2 takr2) racket-specific-progs)) (make-impl 'gambit void @@ -521,7 +521,9 @@ exec racket -qu "$0" ${1+"$@"} (define obsolete-impls '(racket3m racketcgc racket-j racketcgc-j racketcgc-tl mzc mz-old)) (define benchmarks - '(conform + '(collatz + collatz-q + conform cpstak ctak deriv diff --git a/collects/tests/racket/benchmarks/common/collatz-q.rkt b/collects/tests/racket/benchmarks/common/collatz-q.rkt new file mode 100644 index 0000000000..87927e133f --- /dev/null +++ b/collects/tests/racket/benchmarks/common/collatz-q.rkt @@ -0,0 +1 @@ +(module collatz-q "wrap.rkt") diff --git a/collects/tests/racket/benchmarks/common/collatz-q.sch b/collects/tests/racket/benchmarks/common/collatz-q.sch new file mode 100644 index 0000000000..60ab0e5161 --- /dev/null +++ b/collects/tests/racket/benchmarks/common/collatz-q.sch @@ -0,0 +1,15 @@ + +(define (cycle-length n) + (cond + [(= n 1) + 1] + [(odd? n) + (+ 1 (cycle-length (+ 1 (* 3 n))))] + [(even? n) + (+ 1 (cycle-length (quotient n 2)))])) + +(time (let loop ([i 1] [v #f]) + (if (= i 1000000) + v + (loop (+ i 1) (cycle-length i))))) + diff --git a/collects/tests/racket/benchmarks/common/collatz.rkt b/collects/tests/racket/benchmarks/common/collatz.rkt new file mode 100644 index 0000000000..5a5a96fbd7 --- /dev/null +++ b/collects/tests/racket/benchmarks/common/collatz.rkt @@ -0,0 +1 @@ +(module collatz "wrap.rkt") diff --git a/collects/tests/racket/benchmarks/common/collatz.sch b/collects/tests/racket/benchmarks/common/collatz.sch new file mode 100644 index 0000000000..2caf662fa7 --- /dev/null +++ b/collects/tests/racket/benchmarks/common/collatz.sch @@ -0,0 +1,18 @@ + +;; This variant of the benchmark uses `/'. +;; See "collatz-q.sch" for the `quotient' variant. + +(define (cycle-length n) + (cond + [(= n 1) + 1] + [(odd? n) + (+ 1 (cycle-length (+ 1 (* 3 n))))] + [(even? n) + (+ 1 (cycle-length (/ n 2)))])) + +(time (let loop ([i 1] [v #f]) + (if (= i 1000000) + v + (loop (+ i 1) (cycle-length i))))) + diff --git a/collects/tests/racket/benchmarks/common/earley.sch b/collects/tests/racket/benchmarks/common/earley.sch index 649b0c7f3c..6467f435b3 100644 --- a/collects/tests/racket/benchmarks/common/earley.sch +++ b/collects/tests/racket/benchmarks/common/earley.sch @@ -664,4 +664,4 @@ (let ((x (p (vector->list (make-vector k 'a))))) (length (parse->trees x 's 0 k))))) -(time (test 12)) +(time (test 14)) diff --git a/collects/tests/racket/benchmarks/common/maze.sch b/collects/tests/racket/benchmarks/common/maze.sch index 9aa61f249b..7e6a332877 100644 --- a/collects/tests/racket/benchmarks/common/maze.sch +++ b/collects/tests/racket/benchmarks/common/maze.sch @@ -671,7 +671,7 @@ ;------------------------------------------------------------------------------ (let ((input (with-input-from-file "input.txt" read))) - (time (let loop ((n 1000) (v 0)) + (time (let loop ((n 10000) (v 0)) (if (zero? n) v (begin diff --git a/collects/tests/racket/benchmarks/common/mk-bigloo.rktl b/collects/tests/racket/benchmarks/common/mk-bigloo.rktl index 614ebdecfb..59e86f7629 100644 --- a/collects/tests/racket/benchmarks/common/mk-bigloo.rktl +++ b/collects/tests/racket/benchmarks/common/mk-bigloo.rktl @@ -11,7 +11,7 @@ (newline)) #:exists 'truncate/replace) -(when (system (format "bigloo -static-bigloo -w -o ~a -copt -m32 -call/cc -copt -O3 -copt -fomit-frame-pointer -O6 ~a.scm" +(when (system (format "bigloo -static-bigloo -w -o ~a -call/cc -copt -O3 -copt -fomit-frame-pointer -O6 ~a.scm" name name)) (delete-file (format "~a.scm" name)) (delete-file (format "~a.o" name))) diff --git a/collects/tests/racket/benchmarks/common/scheme-c.sch b/collects/tests/racket/benchmarks/common/scheme-c.sch index 06820773d9..c4d92d1c46 100644 --- a/collects/tests/racket/benchmarks/common/scheme-c.sch +++ b/collects/tests/racket/benchmarks/common/scheme-c.sch @@ -361,6 +361,13 @@ (set! *env* (cons *env* (cons x (cons y (cons z def))))) (a))))) +;- -- evaluator --- + +(define (evaluate expr) + ((compile (list 'lambda '() expr)))) + +(define *env* '(dummy)) ; current environment + ;- -- global variable definition --- (define (define-global var val) @@ -380,13 +387,6 @@ ;- -- to evaluate an expression we compile it and then call the result --- -(define (evaluate expr) - ((compile (list 'lambda '() expr)))) - -(define *env* '(dummy)) ; current environment - - - (evaluate '(define 'fib (lambda (x) (if (< x 2) diff --git a/collects/tests/racket/benchmarks/common/scheme-i.sch b/collects/tests/racket/benchmarks/common/scheme-i.sch index 0d77991b94..b876d317bd 100644 --- a/collects/tests/racket/benchmarks/common/scheme-i.sch +++ b/collects/tests/racket/benchmarks/common/scheme-i.sch @@ -109,6 +109,11 @@ (lambda (x y . z) (int a (cons (cons b x) (cons (cons c y) (cons (cons d z) env)))))) +;- -- evaluator --- + +(define (evaluate expr) + (interpret expr)) + ;- -- global variable definition --- (define (define-global var val) @@ -130,10 +135,6 @@ ;- -- to evaluate an expression we call the interpreter --- -(define (evaluate expr) - (interpret expr)) - - (evaluate '(define 'fib (lambda (x) (if (< x 2)