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

fix properties, refine auto

Browse Source 
svn: r4074
This commit is contained in:
Matthew Flatt 2006-08-16 23:10:31 +00:00
parent ca973ccae1
commit 732a319efe
3 changed files with 77 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/tests/mzscheme/benchmarks/common/README.txt
View File

@ -1,29 +1,38 @@
To run a benchmark:
mzscheme -qu auto.ss <impl-or-benchmark> ...
where <impl-or-benchmark> names an implementation as one of
mzscheme
mzscheme3m
bigloo
chicken
gambit
larceny
mzscheme [omitted by default]
mzscheme-j [omitted by default]
mzscheme-tl [omitted by default]
or a benchmark as one of
conform
cpstack
ctak
...
Naming no implementation/benchmark causes all of them to be run.
or any of the above prefixed by "no-" to skip the corresponding
<impl-or-benchmark>.
Naming no implementation/benchmark causes all of them to be run,
except ones omitted by default. Similarly, if the first named
implementation/benchmak starts with "no-", the default set is used
minus the "no-"-specified implementation/benchmark.
The output is series of lines of the form
[<impl> <benchmark> (<cpu-msec> <real-msec> <gc-msec>) <compile-msec>]
The bechmarks were obtained from
Most bechmarks were obtained from
http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/scheme/code/bench/gabriel/
http://www.ccs.neu.edu/home/will/GC/sourcecode.html
Files that end in ".sch" are supposed to be standard Scheme plus `time'.
Files that end in ".ss" are MzScheme wrapper modules or helper scripts.
To build <benchmark>.sch with Gambit, Bigloo, or Chicken:
To build <benchmark>.sch directly with Gambit, Bigloo, or Chicken:
mzscheme -qr mk-gambit.ss <banchmark>
mzscheme -qr mk-bigloo.ss <banchmark>
mzscheme -qr mk-chicken.ss <banchmark>

66
collects/tests/mzscheme/benchmarks/common/auto.ss Normal file → Executable file
View File

@ -7,7 +7,8 @@ exec mzscheme -qu "$0" ${1+"$@"}
(require (lib "process.ss")
(lib "cmdline.ss")
(lib "list.ss")
(lib "compile.ss"))
(lib "compile.ss")
(lib "file.ss" "dynext"))
(define (bytes->number b)
(string->number (bytes->string/latin-1 b)))
@ -18,11 +19,17 @@ exec mzscheme -qu "$0" ${1+"$@"}
(parameterize ([current-command-line-arguments (vector (symbol->string bm))])
(load script)))
(define (clean-up-bin bm)
(delete-file (symbol->string bm)))
(define (mk-mzscheme bm)
;; To get compilation time:
(parameterize ([current-namespace (make-namespace)])
(load (format "~a.ss" bm))))
(define (clean-up-nothing bm)
(void))
(define (mk-mzscheme-tl bm)
;; To get compilation time:
(parameterize ([current-namespace (make-namespace)])
@ -31,6 +38,9 @@ exec mzscheme -qu "$0" ${1+"$@"}
(eval '(define null #f)) ; for dynamic.sch
(compile-file (format "~a.sch" bm))))
(define (clean-up-zo bm)
(delete-file (build-path "compiled" (format "~a.zo" bm))))
(define (mk-larceny bm)
(parameterize ([current-input-port (open-input-string
(format "(compile-file \"~a.sch\")\n"
@ -38,10 +48,16 @@ exec mzscheme -qu "$0" ${1+"$@"}
[current-output-port (open-output-bytes)])
(system "larceny")))
(define (clean-up-fasl bm)
(delete-file (build-path "compiled" (format "~a.fasl"))))
(define (mk-mzc bm)
(parameterize ([current-output-port (open-output-bytes)])
(system (format "mzc ~a.ss" bm))))
(define (clean-up-extension bm)
(delete-file (append-extension-suffix (symbol->string bm))))
(define (run-exe bm)
(system (symbol->string bm)))
@ -99,7 +115,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
[sys (ms->milliseconds (cadddr m))])
(list (+ user sys) real #f))))
(define-struct impl (name make run extract-result skips))
(define-struct impl (name make run extract-result clean-up skips))
(define impls
(list
@ -108,51 +124,61 @@ exec mzscheme -qu "$0" ${1+"$@"}
(lambda (bm)
(system (format "mzscheme -qu ~a.ss" bm)))
extract-mzscheme-times
clean-up-nothing
'())
(make-impl 'mzscheme3m
mk-mzscheme
(lambda (bm)
(system (format "mzscheme3m -qu ~a.ss" bm)))
extract-mzscheme-times
clean-up-nothing
'())
(make-impl 'mzc
mk-mzc
(lambda (bm)
(system (format "mzscheme -mvqee '(load-extension \"~a.dylib\")' '(require ~a)'"
bm bm)))
(system (format "mzscheme -mvqee '(load-extension \"~a\")' '(require ~a)'"
(append-extension-suffix (symbol->string bm))
bm)))
extract-mzscheme-times
'(conform nucleic2 takr))
clean-up-extension
'(takr))
(make-impl 'mzscheme-j
mk-mzscheme
(lambda (bm)
(system (format "mzscheme -jqu ~a.ss" bm)))
extract-mzscheme-times
clean-up-nothing
'())
(make-impl 'mzscheme3m-tl
mk-mzscheme-tl
(lambda (bm)
(system (format "mzscheme3m -qr compiled/~a.zo" bm)))
extract-mzscheme-times
clean-up-zo
'(nucleic2))
(make-impl 'chicken
(run-mk "mk-chicken.ss")
run-exe
extract-chicken-times
clean-up-bin
'(nucleic2))
(make-impl 'bigloo
(run-mk "mk-bigloo.ss")
run-exe/time
extract-time-times
clean-up-bin
'(cpstack ctak puzzle triangle))
(make-impl 'gambit
(run-mk "mk-gambit.ss")
run-gambit-exe
extract-gambit-times
clean-up-bin
'(nucleic2))
(make-impl 'larceny
mk-larceny
run-larceny
extract-larceny-times
clean-up-fasl
'())))
(define obsolte-impls '(mzscheme mzscheme-j mzscheme3m-tl mzc))
@ -169,6 +195,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
earley
fft
nboyer
nestedloop
nfa
nucleic2
puzzle
@ -203,11 +230,25 @@ exec mzscheme -qu "$0" ${1+"$@"}
bm
((impl-extract-result i) bm (get-output-bytes out))
(inexact->exact (round (- end start)))))
(loop (sub1 n)))))))))
(loop (sub1 n)))))))
((impl-clean-up i) bm)))
(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 args
(command-line
"auto"
@ -229,10 +270,20 @@ exec mzscheme -qu "$0" ${1+"$@"}
(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)
@ -243,5 +294,4 @@ exec mzscheme -qu "$0" ${1+"$@"}
(or run-benchmarks
benchmarks)))
(or run-implementations
(remq* obsolte-impls
(map impl-name impls)))))
default-implementations)))

11
collects/tests/mzscheme/benchmarks/common/nestedloop.sch
View File

@ -1,4 +1,5 @@
;; Imperative body:
(define (loops n)
(let ((result 0))
(let loop1 ((i1 1))
@ -34,7 +35,7 @@
(loop1 (+ i1 1)))))
result))
;; Functional body:
(define (func-loops n)
(let loop1 ((i1 1)(result 0))
(if (> i1 n)
@ -56,8 +57,8 @@
(loop5 (+ i5 1) result)
(loop6 (+ i6 1) (+ result 1)))))))))))))))
(define cnt 18)
(display (time (loops cnt))) (newline)
(display (time (func-loops cnt))) (newline)
(define cnt (if (with-input-from-file "input.txt" read) 18 1))
(time (list
(loops cnt)
(func-loops cnt)))