From 7f043225317d8fd0eac4f92973666aa925d035cb Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 10 Oct 2019 10:06:11 -0600
Subject: [PATCH] adjust ctak benchmark

The ctak benchmark had lost a `(lambda (k) ...)`, which made it a
slightly different benchamrk than it was supposed to be. There's not a
good option here; changing it is a break with past Racket
benchmarking, but leaving it broken is misleading. Since the repaired
benchmark runs about the same in traditional Racket, it seems the
lesser evil to repair the benchmark. But also increase the number of
iterations, which makes the benchmark better for Racket CS (which runs
10 titmes as fast) and will help highlight the adjustment if someone
is trying to compare.
---
 .../tests/racket/benchmarks/common/auto.rkt   | 25 +++++++----
 .../tests/racket/benchmarks/common/ctak.sch   | 43 ++++++++++---------
 2 files changed, 38 insertions(+), 30 deletions(-)

diff --git a/pkgs/racket-benchmarks/tests/racket/benchmarks/common/auto.rkt b/pkgs/racket-benchmarks/tests/racket/benchmarks/common/auto.rkt
index 6928723763..91544cfa4e 100755
--- a/pkgs/racket-benchmarks/tests/racket/benchmarks/common/auto.rkt
+++ b/pkgs/racket-benchmarks/tests/racket/benchmarks/common/auto.rkt
@@ -282,6 +282,9 @@ exec racket -qu "$0" ${1+"$@"}
             (s (bytes->number (cadddr m)))
             (if (caddr m) (s (bytes->number (caddr m))) 0))))
 
+  (define (clean-up-chez bm)
+    (delete-file (format "~a.so" bm)))
+
   (define (setup-chez-sps bm)
     (setup-sps bm "(only (chezscheme) time)"))
 
@@ -336,14 +339,18 @@ exec racket -qu "$0" ${1+"$@"}
   (define (extract-gambit-times bm str)
     (let ([m (regexp-match (byte-regexp
                             (bytes-append
-                             #"([0-9]+) ms real.*[^0-9]"
-                             #"([0-9]+) ms cpu.*"
-                             #"(?:no collections|collections? accounting for ([0-9]+) ms.*)"))
+                             #"([0-9][0-9.]*) (secs|ms) real[^0-9]*"
+                             #"([0-9][0-9.]*) (?:secs|ms) cpu.*"
+                             #"(?:no collections|collections? accounting for ([0-9][0-9.]*) (?:secs|ms).*)"))
                            str)])
-      (map bytes->number
-           (list (caddr m)
-                 (cadr m)
-                 (or (cadddr m) #"0")))))
+      (map (lambda (i)
+             (if (equal? #"secs" (caddr m))
+                 (inexact->exact (round (* i 1000)))
+                 i))
+           (map bytes->number
+                (list (cadddr m)
+                      (cadr m)
+                      (or (cadddr (cdr m)) #"0"))))))
 
   (define (extract-racket-times bm str)
     (let ([m (regexp-match #rx#"cpu time: ([0-9]+) real time: ([0-9]+) gc time: ([0-9]+)" str)])
@@ -575,14 +582,14 @@ exec racket -qu "$0" ${1+"$@"}
                 void
                 run-petite
                 extract-chez-times
-                void
+                clean-up-chez
                 racket-specific-progs)
      (make-impl 'chez
                 void
                 mk-chez
                 run-chez
                 extract-chez-times
-                void
+                clean-up-chez
                 racket-specific-progs)
      (make-impl 'chez-sps
                 setup-chez-sps
diff --git a/pkgs/racket-benchmarks/tests/racket/benchmarks/common/ctak.sch b/pkgs/racket-benchmarks/tests/racket/benchmarks/common/ctak.sch
index 30264d86b9..d80a317e18 100644
--- a/pkgs/racket-benchmarks/tests/racket/benchmarks/common/ctak.sch
+++ b/pkgs/racket-benchmarks/tests/racket/benchmarks/common/ctak.sch
@@ -29,31 +29,32 @@
   (cond ((not (< y x))  ;xy
          (k z))
         (else (call-with-current-continuation
-               (ctak-aux
-                k
-                (call-with-current-continuation
-                 (lambda (k)
-                   (ctak-aux k
-                             (- x 1)
-                             y
-                             z)))
-                (call-with-current-continuation
-                 (lambda (k)
-                   (ctak-aux k
-                             (- y 1)
-                             z
-                             x)))
-                (call-with-current-continuation
-                 (lambda (k)
-                   (ctak-aux k
-                             (- z 1)
-                             x
-                             y))))))))
+               (lambda (k)
+                 (ctak-aux
+                  k
+                  (call-with-current-continuation
+                   (lambda (k)
+                     (ctak-aux k
+                               (- x 1)
+                               y
+                               z)))
+                  (call-with-current-continuation
+                   (lambda (k)
+                     (ctak-aux k
+                               (- y 1)
+                               z
+                               x)))
+                  (call-with-current-continuation
+                   (lambda (k)
+                     (ctak-aux k
+                               (- z 1)
+                               x
+                               y)))))))))
 
 ;;; call: (ctak 18 12 6)
 
 (let ((input (with-input-from-file "input.txt" read)))
-  (time (let loop ((n 25) (v 0))
+  (time (let loop ((n 125) (v 0))
           (if (zero? n)
               v
               (loop (- n 1)