From d13057d8c43940a9933fd20a070c92ff7ae98271 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 14 Dec 2009 23:51:09 +0000 Subject: [PATCH] add psyntax as a kind of realistic-program benchmark (I'd like to have more) svn: r17298 --- .../tests/mzscheme/benchmarks/common/auto.ss | 4 + .../mzscheme/benchmarks/common/cmdline.ss | 9 +- .../benchmarks/common/psyntax-input.txt | 4295 ++++++ .../mzscheme/benchmarks/common/psyntax.sch | 10996 ++++++++++++++++ .../mzscheme/benchmarks/common/psyntax.ss | 5 + 5 files changed, 15307 insertions(+), 2 deletions(-) create mode 100644 collects/tests/mzscheme/benchmarks/common/psyntax-input.txt create mode 100644 collects/tests/mzscheme/benchmarks/common/psyntax.sch create mode 100644 collects/tests/mzscheme/benchmarks/common/psyntax.ss diff --git a/collects/tests/mzscheme/benchmarks/common/auto.ss b/collects/tests/mzscheme/benchmarks/common/auto.ss index 425760d007..ca28e04bbd 100755 --- a/collects/tests/mzscheme/benchmarks/common/auto.ss +++ b/collects/tests/mzscheme/benchmarks/common/auto.ss @@ -317,6 +317,9 @@ exec mzscheme -qu "$0" ${1+"$@"} takr2 triangle)) + (define extra-benchmarks + '(psyntax)) + (define (run-benchmark impl bm) (let ([i (ormap (lambda (i) (and (eq? impl (impl-name i)) @@ -349,6 +352,7 @@ exec mzscheme -qu "$0" ${1+"$@"} actual-implementations-to-run num-iterations) (process-command-line benchmarks + extra-benchmarks (map impl-name impls) obsolte-impls 3)) diff --git a/collects/tests/mzscheme/benchmarks/common/cmdline.ss b/collects/tests/mzscheme/benchmarks/common/cmdline.ss index cb58173cce..2bebd7d4c1 100644 --- a/collects/tests/mzscheme/benchmarks/common/cmdline.ss +++ b/collects/tests/mzscheme/benchmarks/common/cmdline.ss @@ -14,6 +14,7 @@ (define current-output-file (make-parameter #f)) (define (process-command-line benchmarks + extra-benchmarks implementations non-default-implementations num-iterations) @@ -50,7 +51,10 @@ (printf "Benchmarks:\n") (for-each (lambda (bm) (printf " ~a\n" bm)) - benchmarks)] + benchmarks) + (for-each (lambda (bm) + (printf " ~a (not run by default)\n" bm)) + extra-benchmarks)] [("-o" "--out") filename "append output to " (current-output-file filename)] [("-n" "--iters") n "set number of run iterations" @@ -80,7 +84,8 @@ (remq (cdr a) (or run-implementations default-implementations))) (loop (cdr args)))] - [(memq s benchmarks) + [(or (memq s benchmarks) + (memq s extra-benchmarks)) => (lambda (l) (let* ([...? (and (pair? (cdr args)) diff --git a/collects/tests/mzscheme/benchmarks/common/psyntax-input.txt b/collects/tests/mzscheme/benchmarks/common/psyntax-input.txt new file mode 100644 index 0000000000..4c1e8e1c31 --- /dev/null +++ b/collects/tests/mzscheme/benchmarks/common/psyntax-input.txt @@ -0,0 +1,4295 @@ +;;; Portable implementation of syntax-case +;;; Extracted from Chez Scheme Version 7.3 (Feb 26, 2007) +;;; Authors: R. Kent Dybvig, Oscar Waddell, Bob Hieb, Carl Bruggeman + +;;; Copyright (c) 1992-2002 Cadence Research Systems +;;; Permission to copy this software, in whole or in part, to use this +;;; software for any lawful purpose, and to redistribute this software +;;; is granted subject to the restriction that all copies made of this +;;; software must include this copyright notice in full. This software +;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED, +;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY +;;; OR FITNESS FOR ANY PARTICULAR PURPOSE. IN NO EVENT SHALL THE +;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY +;;; NATURE WHATSOEVER. + +;;; Before attempting to port this code to a new implementation of +;;; Scheme, please read the notes below carefully. + +;;; This file defines the syntax-case expander, sc-expand, and a set +;;; of associated syntactic forms and procedures. Of these, the +;;; following are documented in The Scheme Programming Language, +;;; Third Edition (R. Kent Dybvig, MIT Press, 2003), which can be +;;; found online at http://www.scheme.com/tspl3/. Most are also documented +;;; in the R4RS and draft R5RS. +;;; +;;; bound-identifier=? +;;; datum->syntax-object +;;; define-syntax +;;; fluid-let-syntax +;;; free-identifier=? +;;; generate-temporaries +;;; identifier? +;;; identifier-syntax +;;; let-syntax +;;; letrec-syntax +;;; syntax +;;; syntax-case +;;; syntax-object->datum +;;; syntax-rules +;;; with-syntax +;;; +;;; All standard Scheme syntactic forms are supported by the expander +;;; or syntactic abstractions defined in this file. Only the R4RS +;;; delay is omitted, since its expansion is implementation-dependent. + +;;; Also defined are three forms that support modules: module, import, +;;; and import-only. These are documented in the Chez Scheme User's +;;; Guide (R. Kent Dybvig, Cadence Research Systems, 1998), which can +;;; also be found online at http://www.scheme.com/csug/. They are +;;; described briefly here as well. + +;;; All are definitions and may appear where and only where other +;;; definitions may appear. modules may be named: +;;; +;;; (module id (ex ...) defn ... init ...) +;;; +;;; or anonymous: +;;; +;;; (module (ex ...) defn ... init ...) +;;; +;;; The latter form is semantically equivalent to: +;;; +;;; (module T (ex ...) defn ... init ...) +;;; (import T) +;;; +;;; where T is a fresh identifier. +;;; +;;; In either form, each of the exports in (ex ...) is either an +;;; identifier or of the form (id ex ...). In the former case, the +;;; single identifier ex is exported. In the latter, the identifier +;;; id is exported and the exports ex ... are "implicitly" exported. +;;; This listing of implicit exports is useful only when id is a +;;; keyword bound to a transformer that expands into references to +;;; the listed implicit exports. In the present implementation, +;;; listing of implicit exports is necessary only for top-level +;;; modules and allows the implementation to avoid placing all +;;; identifiers into the top-level environment where subsequent passes +;;; of the compiler will be unable to deal effectively with them. +;;; +;;; Named modules may be referenced in import statements, which +;;; always take one of the forms: +;;; +;;; (import id) +;;; (import-only id) +;;; +;;; id must name a module. Each exported identifier becomes visible +;;; within the scope of the import form. In the case of import-only, +;;; all other identifiers become invisible in the scope of the +;;; import-only form, except for those established by definitions +;;; that appear textually after the import-only form. + +;;; import and import-only also support a variety of identifier +;;; selection and renaming forms: only, except, add-prefix, +;;; drop-prefix, rename, and alias. +;;; +;;; (import (only m x y)) +;;; +;;; imports x and y (and nothing else) from m. +;;; +;;; (import (except m x y)) +;;; +;;; imports all of m's imports except for x and y. +;;; +;;; (import (add-prefix (only m x y) m:)) +;;; +;;; imports x and y as m:x and m:y. +;;; +;;; (import (drop-prefix m foo:)) +;;; +;;; imports all of m's imports, dropping the common foo: prefix +;;; (which must appear on all of m's exports). +;;; +;;; (import (rename (except m a b) (m-c c) (m-d d))) +;;; +;;; imports all of m's imports except for x and y, renaming c +;;; m-c and d m-d. +;;; +;;; (import (alias (except m a b) (m-c c) (m-d d))) +;;; +;;; imports all of m's imports except for x and y, with additional +;;; aliases m-c for c and m-d for d. +;;; +;;; multiple imports may be specified with one import form: +;;; +;;; (import (except m1 x) (only m2 x)) +;;; +;;; imports all of m1's exports except for x plus x from m2. + +;;; Another form, meta, may be used as a prefix for any definition and +;;; causes any resulting variable bindings to be created at expansion +;;; time. Meta variables (variables defined using meta) are available +;;; only at expansion time. Meta definitions are often used to create +;;; data and helpers that can be shared by multiple macros, for example: + +;;; (module (alpha beta) +;;; (meta define key-error +;;; (lambda (key) +;;; (syntax-error key "invalid key"))) +;;; (meta define parse-keys +;;; (lambda (keys) +;;; (let f ((keys keys) (c #'white) (s 10)) +;;; (syntax-case keys (color size) +;;; (() (list c s)) +;;; (((color c) . keys) (f #'keys #'c s)) +;;; (((size s) . keys) (f #'keys c #'s)) +;;; ((k . keys) (key-error #'k)))))) +;;; (define-syntax alpha +;;; (lambda (x) +;;; (syntax-case x () +;;; ((_ (k ...) ) +;;; (with-syntax (((c s) (parse-keys (syntax (k ...))))) +;;; ---))))) +;;; (define-syntax beta +;;; (lambda (x) +;;; (syntax-case x () +;;; ((_ (k ...) ) +;;; (with-syntax (((c s) (parse-keys (syntax (k ...))))) +;;; ---)))))) + +;;; As with define-syntax rhs expressions, meta expressions can evaluate +;;; references only to identifiers whose values are (already) available +;;; in the compile-time environment, e.g., macros and meta variables. +;;; They can, however, like define-syntax rhs expressions, build syntax +;;; objects containing occurrences of any identifiers in their scope. + +;;; meta definitions propagate through macro expansion, so one can write, +;;; for example: +;;; +;;; (module (a) +;;; (meta define-structure (foo x)) +;;; (define-syntax a +;;; (let ((q (make-foo (syntax 'q)))) +;;; (lambda (x) +;;; (foo-x q))))) +;;; a -> q +;;; +;;; where define-record is a macro that expands into a set of defines. +;;; +;;; It is also sometimes convenient to write +;;; +;;; (meta begin defn ...) +;;; +;;; or +;;; +;;; (meta module {exports} defn ...) +;;; +;;; to create groups of meta bindings. + +;;; Another form, alias, is used to create aliases from one identifier +;;; to another. This is used primarily to support the extended import +;;; syntaxes (add-prefix, drop-prefix, rename, and alias). + +;;; (let ((x 3)) (alias y x) y) -> 3 + +;;; The remaining exports are listed below. sc-expand, eval-when, and +;;; syntax-error are described in the Chez Scheme User's Guide. +;;; +;;; (sc-expand datum) +;;; if datum represents a valid expression, sc-expand returns an +;;; expanded version of datum in a core language that includes no +;;; syntactic abstractions. The core language includes begin, +;;; define, if, lambda, letrec, quote, and set!. +;;; (eval-when situations expr ...) +;;; conditionally evaluates expr ... at compile-time or run-time +;;; depending upon situations +;;; (syntax-error object message) +;;; used to report errors found during expansion +;;; ($syntax-dispatch e p) +;;; used by expanded code to handle syntax-case matching +;;; ($sc-put-cte symbol val top-token) +;;; used to establish top-level compile-time (expand-time) bindings. + +;;; The following nonstandard procedures must be provided by the +;;; implementation for this code to run. +;;; +;;; (void) +;;; returns the implementation's cannonical "unspecified value". The +;;; following usually works: +;;; +;;; (define void (lambda () (if #f #f))). +;;; +;;; (andmap proc list1 list2 ...) +;;; returns true if proc returns true when applied to each element of list1 +;;; along with the corresponding elements of list2 .... The following +;;; definition works but does no error checking: +;;; +;;; (define andmap +;;; (lambda (f first . rest) +;;; (or (null? first) +;;; (if (null? rest) +;;; (let andmap ((first first)) +;;; (let ((x (car first)) (first (cdr first))) +;;; (if (null? first) +;;; (f x) +;;; (and (f x) (andmap first))))) +;;; (let andmap ((first first) (rest rest)) +;;; (let ((x (car first)) +;;; (xr (map car rest)) +;;; (first (cdr first)) +;;; (rest (map cdr rest))) +;;; (if (null? first) +;;; (apply f (cons x xr)) +;;; (and (apply f (cons x xr)) (andmap first rest))))))))) +;;; +;;; (ormap proc list1) +;;; returns the first non-false return result of proc applied to +;;; the elements of list1 or false if none. The following definition +;;; works but does no error checking: +;;; +;;; (define ormap +;;; (lambda (proc list1) +;;; (and (not (null? list1)) +;;; (or (proc (car list1)) (ormap proc (cdr list1)))))) +;;; +;;; The following nonstandard procedures must also be provided by the +;;; implementation for this code to run using the standard portable +;;; hooks and output constructors. They are not used by expanded code, +;;; and so need be present only at expansion time. +;;; +;;; (eval x) +;;; where x is always in the form ("noexpand" expr). +;;; returns the value of expr. the "noexpand" flag is used to tell the +;;; evaluator/expander that no expansion is necessary, since expr has +;;; already been fully expanded to core forms. +;;; +;;; eval will not be invoked during the loading of psyntax.pp. After +;;; psyntax.pp has been loaded, the expansion of any macro definition, +;;; whether local or global, results in a call to eval. If, however, +;;; sc-expand has already been registered as the expander to be used +;;; by eval, and eval accepts one argument, nothing special must be done +;;; to support the "noexpand" flag, since it is handled by sc-expand. +;;; +;;; (error who format-string why what) +;;; where who is either a symbol or #f, format-string is always "~a ~s", +;;; why is always a string, and what may be any object. error should +;;; signal an error with a message something like +;;; +;;; "error in : " +;;; +;;; (gensym) +;;; returns a unique symbol each time it's called. In Chez Scheme, gensym +;;; returns a symbol with a "globally" unique name so that gensyms that +;;; end up in the object code of separately compiled files cannot conflict. +;;; This is necessary only if you intend to support compiled files. +;;; +;;; (gensym? x) +;;; returns #t if x is a gensym, otherwise false. +;;; +;;; (putprop symbol key value) +;;; (getprop symbol key) +;;; (remprop symbol key) +;;; key is always a symbol; value may be any object. putprop should +;;; associate the given value with the given symbol and key in some way +;;; that it can be retrieved later with getprop. getprop should return +;;; #f if no value is associated with the given symbol and key. remprop +;;; should remove the association between the given symbol and key. + +;;; When porting to a new Scheme implementation, you should define the +;;; procedures listed above, load the expanded version of psyntax.ss +;;; (psyntax.pp, which should be available whereever you found +;;; psyntax.ss), and register sc-expand as the current expander (how +;;; you do this depends upon your implementation of Scheme). You may +;;; change the hooks and constructors defined toward the beginning of +;;; the code below, but to avoid bootstrapping problems, do so only +;;; after you have a working version of the expander. + +;;; Chez Scheme allows the syntactic form (syntax