benchmark tweaks and addition

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

collects/tests/racket/benchmarks/common/collatz-q.rkt

@@ -0,0 +1 @@
+(module collatz-q "wrap.rkt")

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)))))
+

collects/tests/racket/benchmarks/common/collatz.rkt

@@ -0,0 +1 @@
+(module collatz "wrap.rkt")

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)))))
+

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))

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

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)))

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)

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)