lift out common benchmark support

svn: r4326

collects/tests/mzscheme/benchmarks/common/auto.ss

@@ -5,7 +5,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
 
 (module auto mzscheme
   (require (lib "process.ss")
-           (lib "cmdline.ss")
+           "../utils/auto-drive.ss"
            (lib "list.ss")
            (lib "compile.ss")
            (lib "inflate.ss")
@@ -226,8 +226,6 @@ exec mzscheme -qu "$0" ${1+"$@"}
       takr
       triangle))
 
-  (define num-iterations 3)
-
   (define (run-benchmark impl bm)
     (let ([i (ormap (lambda (i)
                       (and (eq? impl (impl-name i))
@@ -254,96 +252,14 @@ exec mzscheme -qu "$0" ${1+"$@"}
             ((impl-clean-up i) bm)))
       (flush-output)))
 
-  (define (rprintf . args)
-    (apply printf args)
-    (when (current-output-file)
-      (with-output-to-file (current-output-file)
-        (lambda ()
-          (apply printf args))
-        'append)))
-
-  (define no-implementations (map (lambda (s)
-                                    (cons (string->symbol (format "no-~a" s))
-                                          s))
-                                  (map impl-name impls)))
-  (define no-benchmarks (map (lambda (s)
-                               (cons (string->symbol (format "no-~a" s))
-                                     s))
-                             benchmarks))
-
-  (define run-benchmarks #f)
-  (define run-implementations #f)
-
-  (define default-benchmarks benchmarks)
-  (define default-implementations (remq* obsolte-impls
-                                         (map impl-name impls)))
-
-  (define current-output-file (make-parameter #f))
-
   ;; Extract command-line arguments --------------------
 
-  (define args
+  (define-values (actual-benchmarks-to-run 
-    (command-line
+                  actual-implementations-to-run 
-     "auto"
+                  num-iterations)
-     (current-command-line-arguments)
+    (process-command-line benchmarks
-     (once-each
+                          (map impl-name impls) obsolte-impls
-      [("--show") "show implementations and benchmarks"
+                          3))
-       (printf "Implementations:\n")
-       (for-each (lambda (impl)
-                   (printf " ~a\n" impl))
-                 default-implementations)
-       (for-each (lambda (impl)
-                   (printf " ~a [skipped by default]\n" impl))
-                 obsolte-impls)
-       (printf "Benchmarks:\n")
-       (for-each (lambda (bm)
-                   (printf " ~a\n" bm))
-                 benchmarks)]
-      [("-o" "--out") filename "append output to <filename>"
-       (current-output-file filename)]
-      [("-n" "--iters") n "set number of run iterations"
-       (let ([v (string->number n)])
-         (unless (and (number? v)
-                      (exact? v)
-                      (positive? v))
-           (error 'auto "bad interation count: ~a" n))
-         (set! num-iterations v))])
-     (args impl-or-benchmark impl-or-benchmark)))
-
-  ;; Process arguments ------------------------------
-
-  (for-each (lambda (arg)
-              (let ([s (string->symbol arg)])
-                (cond
-                 [(memq s (map impl-name impls))
-                  (set! run-implementations
-                        (append (or run-implementations null)
-                                (list s)))]
-                 [(assq s no-implementations)
-                  => (lambda (a)
-                       (set! run-implementations
-                             (remq (cdr a)
-                                   (or run-implementations default-implementations))))]
-                 [(memq s benchmarks)
-                  (set! run-benchmarks
-                        (append (or run-benchmarks null)
-                                (list s)))]
-                 [(assq s no-benchmarks)
-                  => (lambda (a)
-                       (set! run-benchmarks
-                             (remq (cdr a)
-                                   (or run-benchmarks default-benchmarks))))]
-                 [else
-                  (error 'auto "mysterious argument: ~a" arg)])))
-            args)
-
-  (define actual-benchmarks-to-run 
-    (or run-benchmarks
-        benchmarks))
-
-  (define actual-implementations-to-run 
-    (or run-implementations
-        default-implementations))
   
   ;; Benchmark-specific setup --------------------
 

collects/tests/mzscheme/benchmarks/rx/auto.ss

@@ -8,7 +8,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
            (lib "port.ss")
            (lib "list.ss")
            (lib "date.ss")
-           (lib "cmdline.ss"))
+           "../utils/auto-drive.ss")
 
   (define (test-mzscheme input rx iterations)
     (let ([rx (byte-pregexp rx)])
@@ -151,88 +151,17 @@ exec mzscheme -qu "$0" ${1+"$@"}
           (list 'perl test-perl)
           (list 'pcre test-pcre)))
 
-  (define impls (map car testers))
-
-  (define no-benchmarks (map (lambda (s)
-                               (cons (string->symbol (format "no-~a" s))
-                                     s))
-                             benchmark-names))
-  (define no-implementations (map (lambda (s)
-                                    (cons (string->symbol (format "no-~a" s))
-                                          s))
-                                  impls))
-  
-  (define run-benchmarks #f)
-  (define run-implementations #f)
-
-  (define default-benchmarks benchmark-names)
-
-  (define default-implementations impls)
-  (define current-output-file (make-parameter #f))
-
   ;; Extract command-line arguments --------------------
 
-  (define args
+  (define-values (actual-benchmarks-to-run 
-    (command-line
+                  actual-implementations-to-run 
-     "auto"
+                  num-iterations)
-     (current-command-line-arguments)
+    (process-command-line benchmark-names
-     (once-each
+                          (map car testers) null
-      [("--show") "show implementations and benchmarks"
+                          1))
-       (printf "Implementations:\n")
-       (for-each (lambda (impl)
-                   (printf " ~a\n" impl))
-                 default-implementations)
-       (printf "Benchmarks: 1 - ~a\n"
-               (length inputs))]
-      [("-o" "--out") filename "append output to <filename>"
-       (current-output-file filename)])
-     (args impl-or-benchmark impl-or-benchmark)))
-
-  ;; Process arguments ------------------------------
-
-  (for-each (lambda (arg)
-              (let ([s (string->symbol arg)])
-                (cond
-                 [(memq s impls)
-                  (set! run-implementations
-                        (append (or run-implementations null)
-                                (list s)))]
-                 [(assq s no-implementations)
-                  => (lambda (a)
-                       (set! run-implementations
-                             (remq (cdr a)
-                                   (or run-implementations default-implementations))))]
-                 [(memq s benchmark-names)
-                  (set! run-benchmarks
-                        (append (or run-benchmarks null)
-                                (list s)))]
-                 [(assq s no-benchmarks)
-                  => (lambda (a)
-                       (set! run-benchmarks
-                             (remq (cdr a)
-                                   (or run-benchmarks default-benchmarks))))]
-                 [else
-                  (error 'auto "mysterious argument: ~a" arg)])))
-            args)
-
-  (define actual-benchmarks-to-run 
-    (or run-benchmarks
-        default-benchmarks))
-
-  (define actual-implementations-to-run 
-    (or run-implementations
-        default-implementations))
   
   ;; Run benchmarks -------------------------------
 
-  (define (rprintf . args)
-    (apply printf args)
-    (when (current-output-file)
-      (with-output-to-file (current-output-file)
-        (lambda ()
-          (apply printf args))
-        'append)))
-
   (define (run who which)
     (let ([t (assoc (symbol->string which) inputs)])
       (let-values ([(index input rx iterations skips) (apply values t)])

collects/tests/mzscheme/benchmarks/utils/auto-drive.ss

@@ -0,0 +1,104 @@
+
+(module auto-drive mzscheme
+  (require (lib "process.ss")
+           (lib "cmdline.ss")
+           (lib "list.ss")
+           (lib "compile.ss")
+           (lib "inflate.ss")
+           (lib "date.ss")
+           (lib "file.ss" "dynext"))
+
+  (provide process-command-line
+           rprintf)
+
+  (define current-output-file (make-parameter #f))
+  
+  (define (process-command-line benchmarks 
+                                implementations non-default-implementations
+                                num-iterations)
+    
+    (define no-implementations (map (lambda (s)
+                                      (cons (string->symbol (format "no-~a" s))
+                                            s))
+                                    implementations))
+    (define no-benchmarks (map (lambda (s)
+                                 (cons (string->symbol (format "no-~a" s))
+                                       s))
+                               benchmarks))
+
+    (define run-benchmarks #f)
+    (define run-implementations #f)
+
+    (define default-benchmarks benchmarks)
+    (define default-implementations (remq* non-default-implementations implementations))
+
+    ;; Extract command-line arguments --------------------
+
+    (define args
+      (command-line
+       "auto"
+       (current-command-line-arguments)
+       (once-each
+        [("--show") "show implementations and benchmarks"
+         (printf "Implementations:\n")
+         (for-each (lambda (impl)
+                     (printf " ~a\n" impl))
+                   default-implementations)
+         (for-each (lambda (impl)
+                     (printf " ~a [skipped by default]\n" impl))
+                   non-default-implementations)
+         (printf "Benchmarks:\n")
+         (for-each (lambda (bm)
+                     (printf " ~a\n" bm))
+                   benchmarks)]
+        [("-o" "--out") filename "append output to <filename>"
+         (current-output-file filename)]
+        [("-n" "--iters") n "set number of run iterations"
+         (let ([v (string->number n)])
+           (unless (and (number? v)
+                        (exact? v)
+                        (positive? v))
+             (error 'auto "bad interation count: ~a" n))
+           (set! num-iterations v))])
+       (args impl-or-benchmark impl-or-benchmark)))
+
+    ;; Process arguments ------------------------------
+
+    (for-each (lambda (arg)
+                (let ([s (string->symbol arg)])
+                  (cond
+                   [(memq s implementations)
+                    (set! run-implementations
+                          (append (or run-implementations null)
+                                  (list s)))]
+                   [(assq s no-implementations)
+                    => (lambda (a)
+                         (set! run-implementations
+                               (remq (cdr a)
+                                     (or run-implementations default-implementations))))]
+                   [(memq s benchmarks)
+                    (set! run-benchmarks
+                          (append (or run-benchmarks null)
+                                  (list s)))]
+                   [(assq s no-benchmarks)
+                    => (lambda (a)
+                         (set! run-benchmarks
+                               (remq (cdr a)
+                                     (or run-benchmarks default-benchmarks))))]
+                   [else
+                    (error 'auto "mysterious argument: ~a" arg)])))
+              args)
+
+    (values (or run-benchmarks
+                benchmarks)
+            (or run-implementations
+                default-implementations)
+            num-iterations))
+
+  (define (rprintf . args)
+    (apply printf args)
+    (when (current-output-file)
+      (with-output-to-file (current-output-file)
+        (lambda ()
+          (apply printf args))
+        'append))))