suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Integrated the typed shootout benchmarks to the untyped harness.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-06-10 17:45:08 -04:00
parent d48f1bb6aa
commit 7f3db138e7
4 changed files with 78 additions and 197 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/racket/benchmarks/shootout/README.txt
View File

@ -2,4 +2,4 @@
The program "run" should know how to run each benchmark with its
standard input value. So run <benchmark.ss> like this:
racket run.rkt <benchmark.ss>
racket run.rkt <benchmark.ss> [racket|typed-scheme|typed-scheme-optimizing]

38
collects/tests/racket/benchmarks/shootout/typed/auto.rkt → collects/tests/racket/benchmarks/shootout/auto.rkt
View File

@ -9,7 +9,7 @@ exec racket -qu "$0" ${1+"$@"}
(module auto scheme/base
(require (for-syntax scheme/base)
mzlib/process
"../../common/cmdline.rkt"
"../common/cmdline.rkt"
mzlib/list
mzlib/compile
mzlib/inflate
@ -33,38 +33,38 @@ exec racket -qu "$0" ${1+"$@"}
(load script)))
(define (mk-racket bm)
(unless (directory-exists? "../compiled")
(make-directory "../compiled"))
(unless (directory-exists? "compiled")
(make-directory "compiled"))
(parameterize ([current-namespace (make-base-namespace)]
[read-accept-reader #t])
(let ([name (format "~a.rkt" bm)])
(compile-file (format "../~a" name)
(build-path "../compiled" (path-add-suffix name #".zo"))))))
(compile-file name
(build-path "compiled" (path-add-suffix name #".zo"))))))
(define (clean-up-zo bm)
(when (directory-exists? "../compiled")
(delete-directory/files "../compiled")))
(when (directory-exists? "compiled")
(delete-directory/files "compiled")))
(define (mk-typed-scheme bm)
(unless (directory-exists? "compiled")
(make-directory "compiled"))
(unless (directory-exists? "typed/compiled")
(make-directory "typed/compiled"))
(parameterize ([current-namespace (make-base-namespace)]
[read-accept-reader #t])
(let ([name (format "~a-non-optimizing.rkt" bm)])
(compile-file name
(build-path "compiled" (path-add-suffix name #".zo"))))))
(compile-file (format "typed/~a" name)
(build-path "typed/compiled" (path-add-suffix name #".zo"))))))
(define (mk-typed-scheme-optimizing bm)
(unless (directory-exists? "compiled")
(make-directory "compiled"))
(unless (directory-exists? "typed/compiled")
(make-directory "typed/compiled"))
(parameterize ([current-namespace (make-base-namespace)]
[read-accept-reader #t])
(let ([name (format "~a-optimizing.rkt" bm)])
(compile-file name
(build-path "compiled" (path-add-suffix name #".zo"))))))
(compile-file (format "typed/~a" name)
(build-path "typed/compiled" (path-add-suffix name #".zo"))))))
(define (clean-up-typed bm)
(when (directory-exists? "compiled")
(delete-directory/files "compiled")))
(when (directory-exists? "typed/compiled")
(delete-directory/files "typed/compiled")))
(define (extract-racket-times bm str)
(let ([m (regexp-match #rx#"cpu time: ([0-9]+) real time: ([0-9]+) gc time: ([0-9]+)" str)])
@ -136,7 +136,6 @@ exec racket -qu "$0" ${1+"$@"}
pidigits1
random
recursive
regexmatch
regexpdna
reversecomplement
reversefile
@ -148,7 +147,8 @@ exec racket -qu "$0" ${1+"$@"}
wordfreq))
(define without-input-benchmarks
'(spellcheck))
'(regexmatch
spellcheck))
(define (run-benchmark impl bm)
(let ([i (ormap (lambda (i)

107
collects/tests/racket/benchmarks/shootout/run.rkt
View File

@ -1,52 +1,53 @@
(module run mzscheme
(require (only scheme/runtime-path define-runtime-path))
(require (only scheme/runtime-path define-runtime-path)
racket/port)
(define input-map
`(
("ackermann.rkt" "11")
("ary.rkt" "9000")
("binarytrees.rkt" "16")
("chameneos.rkt" "1000000")
("cheapconcurrency.rkt" "15000")
("echo.rkt" "150000")
("except.rkt" "2500000")
("fannkuch.rkt" "10")
("fasta.rkt" "25000000")
("fibo.rkt" "32")
("hash.rkt" "100000")
("hash2.rkt" "200")
("heapsort.rkt" "100000")
("lists.rkt" "18")
("mandelbrot.rkt" "3000")
("matrix.rkt" "600")
("moments.rkt" #f ,(lambda () (mk-sumcol-input)))
("nbody.rkt" "20000000")
("nestedloop.rkt" "18")
("nsieve.rkt" "9")
("nsievebits.rkt" "11")
("partialsums.rkt" "2500000")
("pidigits.rkt" "2500")
("pidigits1.rkt" "2500")
("random.rkt" "900000")
("recursive.rkt" "11")
("regexmatch.rkt")
("regexpdna.rkt" #f ,(lambda () (mk-regexpdna-input)))
("reversecomplement.rkt" #f ,(lambda () (mk-revcomp-input)))
("k-nucleotide.rkt" #f ,(lambda () (mk-knuc-input)))
("reversefile.rkt" #f ,(lambda () (mk-sumcol-input)))
("sieve.rkt" "1200")
("spellcheck.rkt")
("spectralnorm.rkt" "5500")
("spectralnorm-unsafe.rkt" "5500")
("strcat.rkt" "40000")
("sumcol.rkt" #f ,(lambda () (mk-sumcol-input)))
("wc.rkt" #f ,(lambda () (mk-sumcol-input)))
("wordfreq.rkt" #f ,(lambda () (mk-sumcol-input)))
("ackermann" "11")
("ary" "9000")
("binarytrees" "16")
("chameneos" "1000000")
("cheapconcurrency" "15000")
("echo" "150000")
("except" "2500000")
("fannkuch" "10")
("fasta" "25000000")
("fibo" "32")
("hash" "100000")
("hash2" "200")
("heapsort" "100000")
("lists" "18")
("mandelbrot" "3000")
("matrix" "600")
("moments" #f ,(lambda () (mk-sumcol-input)))
("nbody" "20000000")
("nestedloop" "18")
("nsieve" "9")
("nsievebits" "11")
("partialsums" "2500000")
("pidigits" "2500")
("pidigits1" "2500")
("random" "900000")
("recursive" "11")
("regexmatch")
("regexpdna" #f ,(lambda () (mk-regexpdna-input)))
("reversecomplement" #f ,(lambda () (mk-revcomp-input)))
("k-nucleotide" #f ,(lambda () (mk-knuc-input)))
("reversefile" #f ,(lambda () (mk-sumcol-input)))
("sieve" "1200")
("spellcheck")
("spectralnorm" "5500")
("strcat" "40000")
("sumcol" #f ,(lambda () (mk-sumcol-input)))
("wc" #f ,(lambda () (mk-sumcol-input)))
("wordfreq" #f ,(lambda () (mk-sumcol-input)))
))
(define-runtime-path here ".")
(define (dynreq f)
(parameterize ([current-load-relative-directory here])
(parameterize ([current-load-relative-directory here]
[current-output-port (open-output-nowhere)])
(dynamic-require f #f)))
(define (mk-fasta n suffix)
@ -89,20 +90,28 @@
(define iters
(let ([len (vector-length (current-command-line-arguments))])
(unless (<= 1 len 2)
(printf "provide ~athe name of a benchmark on the command line and an optional iteration count\n"
(unless (<= 1 len 3)
(printf "provide ~athe name of a benchmark on the command line, an optional version of the benchmark to run, and an optional iteration count\n"
(if (zero? len) "" "ONLY "))
(exit))
(if (= len 2)
(string->number (vector-ref (current-command-line-arguments) 1))
(if (= len 3)
(string->number (vector-ref (current-command-line-arguments) 2))
1)))
(let ([prog (vector-ref (current-command-line-arguments) 0)])
(let ([m (assoc prog input-map)])
(let* ([version (if (< (vector-length (current-command-line-arguments)) 2)
"racket"
(vector-ref (current-command-line-arguments) 1))]
[bench (vector-ref (current-command-line-arguments) 0)]
[prog (cond
((string=? version "racket") (format "~a.rkt" bench))
((string=? version "typed-scheme") (format "typed/~a-non-optimizing.rkt" bench))
((string=? version "typed-scheme-optimizing") (format "typed/~a-optimizing.rkt" bench))
(else (error 'run "unknown version ~a" version)))])
(let ([m (assoc bench input-map)])
(unless m
(error 'run "cannot find input for ~a" prog))
(error 'run "cannot find input for ~a" bench))
(when (null? (cdr m))
(error 'run "don't know input for ~a" prog))
(error 'run "don't know input for ~a" bench))
(let loop ([n iters])
(parameterize ([current-command-line-arguments
(if (cadr m)

128
collects/tests/racket/benchmarks/shootout/typed/run.rkt
View File

@ -1,128 +0,0 @@
(module run mzscheme
(require (only scheme/runtime-path define-runtime-path)
racket/port)
(define input-map
`(
("ackermann" "11")
("ary" "9000")
("binarytrees" "16")
("chameneos" "1000000")
("cheapconcurrency" "15000")
("echo" "150000")
("except" "2500000")
("fannkuch" "10")
("fasta" "25000000")
("fibo" "32")
("hash" "100000")
("hash2" "200")
("heapsort" "100000")
("lists" "18")
("mandelbrot" "3000")
("matrix" "600")
("moments" #f ,(lambda () (mk-sumcol-input)))
("nbody" "20000000")
("nestedloop" "18")
("nsieve" "9")
("nsievebits" "11")
("partialsums" "2500000")
("pidigits" "2500")
("pidigits1" "2500")
("random" "900000")
("recursive" "11")
("regexmatch")
("regexpdna" #f ,(lambda () (mk-regexpdna-input)))
("reversecomplement" #f ,(lambda () (mk-revcomp-input)))
("k-nucleotide" #f ,(lambda () (mk-knuc-input)))
("reversefile" #f ,(lambda () (mk-sumcol-input)))
("sieve" "1200")
("spellcheck")
("spectralnorm" "5500")
("spectralnorm-unsafe" "5500")
("strcat" "40000")
("sumcol" #f ,(lambda () (mk-sumcol-input)))
("wc" #f ,(lambda () (mk-sumcol-input)))
("wordfreq" #f ,(lambda () (mk-sumcol-input)))
))
(define-runtime-path here ".")
(define (dynreq f)
(parameterize ([current-load-relative-directory here]
[current-output-port (open-output-nowhere)])
(dynamic-require f #f)))
(define (mk-fasta n suffix)
(let ([f (build-path (find-system-path 'temp-dir) (string-append "fasta-" suffix))])
(unless (file-exists? f)
(printf "Building FASTA ~a output for input: ~a\n" n f)
(with-output-to-file f
(lambda ()
(parameterize ([current-command-line-arguments (vector n)])
(dynreq "../fasta.rkt"))))) ; we can use the untyped version to generate inputs
f))
(define (mk-revcomp-input)
(mk-fasta "2500000" "2m5"))
(define (mk-knuc-input)
(mk-fasta "1000000" "1m"))
(define (mk-regexpdna-input)
(mk-fasta "5000000" "5m"))
(define (mk-sumcol-input)
(let ([f (build-path (find-system-path 'temp-dir) "sumcol-21k")])
(unless (file-exists? f)
(printf "Building sumcol 21000 input: ~a\n" f)
(let ([c (with-input-from-file (build-path (collection-path "tests")
"racket"
"benchmarks"
"shootout"
"sumcol-input.txt")
(lambda ()
(read-bytes 10000)))])
(with-output-to-file f
(lambda ()
(let loop ([n 21000])
(unless (zero? n)
(printf "~a" c)
(loop (sub1 n))))))))
f))
(define iters
(let ([len (vector-length (current-command-line-arguments))])
(unless (<= 2 len 3)
(printf "provide ~athe name of a benchmark on the command line, which version of the benchmark to run, and an optional iteration count\n"
(if (<= len 1) "" "ONLY "))
(exit))
(if (= len 3)
(string->number (vector-ref (current-command-line-arguments) 2))
1)))
(let* ([version (vector-ref (current-command-line-arguments) 1)] ; racket, typed-scheme, typed-scheme-optimizing
[bench (vector-ref (current-command-line-arguments) 0)]
[prog (cond
((string=? version "racket") (format "../~a.rkt" bench))
((string=? version "typed-scheme") (format "~a-non-optimizing.rkt" bench))
((string=? version "typed-scheme-optimizing") (format "~a-optimizing.rkt" bench))
(else (error 'run "unknown version ~a" version)))])
(let ([m (assoc bench input-map)])
(unless m
(error 'run "cannot find input for ~a" bench))
(when (null? (cdr m))
(error 'run "don't know input for ~a" bench))
(let loop ([n iters])
(parameterize ([current-command-line-arguments
(if (cadr m)
(vector (cadr m))
(vector))]
[current-input-port
(if (null? (cddr m))
(current-input-port)
(open-input-file ((caddr m))))])
(parameterize ([current-namespace (make-namespace)])
(collect-garbage)
(collect-garbage)
(time (dynreq prog))))
(unless (= n 1)
(loop (sub1 n)))))))