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

Just getting this done -- no humor today, sorry, Sam!

Browse Source 
svn: r11833
This commit is contained in:
Stevie Strickland 2008-09-22 14:09:20 +00:00
commit e4ec7694a3
64 changed files with 3176 additions and 2316 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/compiler/zo-parse.ss
View File

@ -194,7 +194,7 @@
(define (read-module v)
(match v
[`(,name ,self-modidx ,functional? ,et-functional?
[`(,name ,self-modidx ,lang-info ,functional? ,et-functional?
,rename ,max-let-depth ,dummy
,prefix ,kernel-exclusion ,reprovide-kernel?
,indirect-provides ,num-indirect-provides ,protects

23
collects/framework/private/scheme.ss
View File

@ -369,7 +369,8 @@
set-tab-size
introduce-let-ans
move-sexp-out))
move-sexp-out
kill-enclosing-parens))
(define init-wordbreak-map
(λ (map)
@ -1042,6 +1043,21 @@
[else (bell)]))
(end-edit-sequence))
(define/public (kill-enclosing-parens begin-inner)
(begin-edit-sequence)
(let ([begin-outer (find-up-sexp begin-inner)])
(cond
[begin-outer
(let ([end-outer (get-forward-sexp begin-outer)])
(cond
[(and end-outer (> (- end-outer begin-outer) 2))
(delete (- end-outer 1) end-outer)
(delete begin-outer (+ begin-outer 1))
(tabify-selection begin-outer (- end-outer 2))]
[else (bell)]))]
[else (bell)]))
(end-edit-sequence))
(inherit get-fixed-style)
(define/public (mark-matching-parenthesis pos)
(let ([open-parens (map car (scheme-paren:get-paren-pairs))]
@ -1238,6 +1254,8 @@
(λ (e p) (send e introduce-let-ans p)))
(add-pos-function "move-sexp-out"
(λ (e p) (send e move-sexp-out p)))
(add-pos-function "kill-enclosing-parens"
(lambda (e p) (send e kill-enclosing-parens p)))
(let ([add-edit-function
(λ (name call-method)
@ -1359,7 +1377,8 @@
)
(send keymap map-function "c:c;c:b" "remove-parens-forward")
(send keymap map-function "c:c;c:l" "introduce-let-ans")
(send keymap map-function "c:c;c:o" "move-sexp-out")))
(send keymap map-function "c:c;c:o" "move-sexp-out")
(send keymap map-function "c:c;c:e" "kill-enclosing-parens")))
(define keymap (make-object keymap:aug-keymap%))
(setup-keymap keymap)

2
collects/handin-server/info.ss
View File

@ -1,5 +1,3 @@
#lang setup/infotab
(define scribblings '(("scribblings/handin-server.scrbl" (user-doc))))
(define compile-omit-paths '("status-web-root"))

13
collects/handin-server/private/config.ss
View File

@ -4,7 +4,11 @@
;; This module should be invoked when we're in the server directory
(provide server-dir)
(define server-dir (or (getenv "PLT_HANDINSERVER_DIR") (current-directory)))
(define server-dir
(let ([dir (or (getenv "PLT_HANDINSERVER_DIR") (current-directory))])
(if (directory-exists? dir)
dir
(error 'config "handin server directory does not exist: ~e" dir))))
(define config-file (path->complete-path "config.ss" server-dir))
@ -96,10 +100,11 @@
(define (paths->map dirs)
(define (path->name dir)
(unless (directory-exists? dir)
(error 'get-conf
"directory entry for an inexistent directory: ~e" dir))
(if (file-exists? dir)
(error 'get-conf "directory entry points at a file: ~e" dir)
(make-directory* dir)))
(let-values ([(_1 name _2) (split-path dir)])
(bytes->string/locale (path-element->bytes name))))
(path-element->string name)))
(let ([names (map path->name dirs)])
(append (map list names dirs) (map list dirs names))))

83
collects/handin-server/private/lock.ss
View File

@ -20,44 +20,45 @@
(define-struct req (thread-dead-evt user sema cleanup-thunk))
(thread
(lambda ()
(let loop ([locks null]
[reqs null])
(let-values ([(locks reqs)
;; Try to satisfy lock requests:
(let loop ([reqs (reverse reqs)]
[locks locks]
[new-reqs null])
(if (null? reqs)
(values locks new-reqs)
(let ([req (car reqs)]
[rest (cdr reqs)])
(if (assoc (req-user req) locks)
;; Lock not available:
(loop rest locks (cons req new-reqs))
;; Lock is available, so take it:
(begin (semaphore-post (req-sema req))
(loop (cdr reqs)
(cons (cons (req-user req) req) locks)
new-reqs))))))])
(sync
(handle-evt req-ch (lambda (req) (loop locks (cons req reqs))))
;; Release a lock whose thread is gone:
(apply choice-evt
(map (lambda (name+req)
(handle-evt
(req-thread-dead-evt (cdr name+req))
(lambda (v)
;; releasing a lock => run cleanup
(cond [(req-cleanup-thunk (cdr name+req))
=> (lambda (t) (t))])
(loop (remq name+req locks) reqs))))
locks))
;; Throw away a request whose thread is gone:
(apply choice-evt
(map (lambda (req)
(handle-evt
(req-thread-dead-evt req)
(lambda (v) (loop locks (remq req reqs)))))
reqs)))))))
(define (lock-loop)
(let loop ([locks null]
[reqs null])
(let-values ([(locks reqs)
;; Try to satisfy lock requests:
(let loop ([reqs (reverse reqs)]
[locks locks]
[new-reqs null])
(if (null? reqs)
(values locks new-reqs)
(let ([req (car reqs)]
[rest (cdr reqs)])
(if (assoc (req-user req) locks)
;; Lock not available:
(loop rest locks (cons req new-reqs))
;; Lock is available, so take it:
(begin (semaphore-post (req-sema req))
(loop (cdr reqs)
(cons (cons (req-user req) req) locks)
new-reqs))))))])
(sync
(handle-evt req-ch (lambda (req) (loop locks (cons req reqs))))
;; Release a lock whose thread is gone:
(apply choice-evt
(map (lambda (name+req)
(handle-evt
(req-thread-dead-evt (cdr name+req))
(lambda (v)
;; releasing a lock => run cleanup
(cond [(req-cleanup-thunk (cdr name+req))
=> (lambda (t) (t))])
(loop (remq name+req locks) reqs))))
locks))
;; Throw away a request whose thread is gone:
(apply choice-evt
(map (lambda (req)
(handle-evt
(req-thread-dead-evt req)
(lambda (v) (loop locks (remq req reqs)))))
reqs))))))
(define lock-thread (thread lock-loop))

6
collects/handin-server/private/logger.ss
View File

@ -35,11 +35,7 @@
;; output the line on the output port
(define (make-logger-port out log)
(if (and (not out) (not log))
;; /dev/null-like output port
(make-output-port 'nowhere
always-evt
(lambda (buf start end imm? break?) (- end start))
void)
(open-output-nowhere)
(let ([prompt? #t]
[sema (make-semaphore 1)]
[outp (cond [(not log) out]

35
collects/handin-server/scribblings/checker-utils.scrbl Normal file
View File

@ -0,0 +1,35 @@
#lang scribble/doc
@(require "common.ss")
@title[#:style 'toc]{Checker Utilities}
The checker utilities are provided to make writing checker functions.
They are provided in a few layers, each layer provides new
functionality in addition to the lower one. These modules are (in
order):
@itemize[
@item{@schememodname[scheme/sandbox]: contains basic sandbox
evaluation utilities. This is in MzLib since it can be used
independently.}
@item{@schememodname[handin-server/sandbox]: contains a wrapper that
configures MzLib's sandbox for the handin server.}
@item{@schememodname[handin-server/utils]: contains additional
utilities for dealing with handin submissions, as well as a few
helpers for testing code.}
@item{@schememodname[handin-server/checker]: automates the task of
creating a checker function (in
@filepath{<active-assignment>/checker.ss} modules) to cope with
common submission situations.}]
The following sections describe each of these modules.
@local-table-of-contents[]
@include-section["sandbox.scrbl"]
@include-section["utils.scrbl"]
@include-section["checker.scrbl"]

351
collects/handin-server/scribblings/checker.scrbl Normal file
View File

@ -0,0 +1,351 @@
#lang scribble/doc
@(require "common.ss")
@title{checker}
@defmodulelang[handin-server/checker]{
The @schememodname[handin-server/checker] module provides a
higher-level of utilities, helpful in implementing `checker' functions
that are intended for a more automated system. This module is a
language module---a typical checker that uses it looks like this:
@schemeblock[
(module checker (lib "checker.ss" "handin-server")
(check: :language 'intermediate
:users pairs-or-singles-with-warning
:coverage? #t
(!procedure Fahrenheit->Celsius 1)
(!test (Fahrenheit->Celsius 32) 0)
(!test (Fahrenheit->Celsius 212) 100)
(!test (Fahrenheit->Celsius -4) -20)
...))]
}
@defform/subs[(check: keys-n-vals body ...)
([keys-n-vals code:blank
(code:line :key val keys-n-vals)])]{
Constructs (and provides) an appropriate checker function, using
keywords for features that you want, the body of the checker can
contain arbitrary code, using all utilities from
@schememodname[handin-server/utils], as well as additional ones (see
below).}
Keywords for configuring @scheme[check:]:
@itemize[
@item{@indexed-scheme[:users]---specification of users that are
acceptable for submission. Can be either a list of user lists, each
representing a known team, or procedure which will accept a list of
users and throw an exception if they are unacceptable. The default
is to accept only single-user submissions. The
@scheme[pairs-or-singles-with-warning] procedure is a useful value
for pair submission where the pairs are unknown.}
@item{@indexed-scheme[:eval?]---whether submissions should be
evaluated. Defaults to @scheme[#t]. Note that if it is specified
as @scheme[#f], then the checker body will not be able to run any
tests on the code, unless it contains code that performs some
evaluation (e.g., using the facilities of
@schememodname[handin-server/utils]).}
@item{@indexed-scheme[:language]---the language that is used for
evaluating submissions, same as the @scheme[_language] argument for
@scheme[make-evaluator] (see @schememodname[handin-server/sandbox]).
There is no default for this, so it must be set or an error is
raised.}
@item{@indexed-scheme[:teachpacks]---teachpacks for evaluating
submissions, same as the @scheme[_teachpacks] argument for
@scheme[make-evaluator] (see @schememodname[handin-server/sandbox]).
This defaults to null---no teachpacks.}
@item{@indexed-scheme[:create-text?]---if true, then a textual version
of the submission is saved as @filepath{text.scm} in a
@filepath{grading} subdirectory (or any suffix that is specified by
@scheme[:output] below, for example @filepath{hw.java} is converted
into a textual @filepath{grading/text.java}). This is intended for
printouts and grading, and is in a subdirectory so students will not
see it on the status web server. Defaults to @scheme[#t].}
@item{@indexed-scheme[:untabify?]---if true, then tabs are converted
to spaces, assuming a standard tab width of 8 places. This is
needed for a correct computation of line lengths, but note that
DrScheme does not insert tabs in Scheme mode. Defaults to
@scheme[#t].}
@item{@indexed-scheme[:textualize?]---if true, then all submissions
are converted to text, trying to convert objects like comment boxes
and test cases to some form of text. Defaults to @scheme[#f],
meaning that an exception is raised for submissions that are not all
text.}
@item{@indexed-scheme[:maxwidth]---a number that specifies maximum
line lengths for submissions (a helpful feature for reading student
code). Defaults to 79. This feature can be disabled if set to
@scheme[#f]. (This is effective only when saving a textual version
of the submission files.)}
@item{@indexed-scheme[:output]---the name of the original handin file
(unrelated to the text-converted files). Defaults to
@filepath{hw.scm}. (The suffix changes the defaults of
@scheme[:markup-prefix] and @scheme[:prefix-re].) Can be
@scheme[#f] for removing the original file after processing.}
@item{@indexed-scheme[:multi-file]---by default, this is set to
@scheme[#f], which means that only DrScheme is used to send
submissions as usual. See @secref{multi-file} for setting up
multi-file submissions.}
@item{@indexed-scheme[:names-checker]---used for multi-file
submissions; see @secref{multi-file} for details.}
@item{@indexed-scheme[:markup-prefix]---used as the prefix for
@scheme[:student-lines] and @scheme[:extra-lines] below. The
default is @scheme[";;> "] or @scheme["//> "], depending on the
suffix of @scheme[:output] above. (Note: if you change this, make
sure to change @scheme[:prefix-re] too.)}
@item{@indexed-scheme[:prefix-re]---used to identify lines with markup
(@scheme[";>"] or @scheme["//>"] etc), so students cannot fool the
system by writing marked-up code. The default is @scheme[";>"] or
@scheme["//>"], depending on the suffix of :output above.}
@item{@indexed-scheme[:student-line]---when a submission is converted
to text, it begins with lines describing the students that have
submitted it; this is used to specify the format of these lines. It
is a string with holes that that @scheme[user-substs] fills out.
The default is @scheme["Student: {username} ({Full Name} <{Email}>)"],
which requires @scheme["Full Name"] and @scheme["Email"] entries in
the server's extra-fields configuration. These lines are prefixed
with @scheme[";;> "] or the prefix specified by
@scheme[:makup-prefix] above.}
@item{@indexed-scheme[:extra-lines]---a list of lines to add after the
student lines, all with a @scheme[";;> "] or :markup-prefix too.
Defaults to a single line:
@scheme["Maximum points for this assignment: <+100>"]. (Can use
@scheme["{submission}"] for the submission directory.) See also
@scheme[add-header-line!].}
@item{@indexed-scheme[:user-error-message]---a string that is used to
report an error that occurred during evaluation of the submitted
code (not during additional tests). It can be a plain string which
will be used as the error message, or a string with single a
@scheme["~a"] (or @scheme["~e"], @scheme["~s"], @scheme["~v"]) that
will be used as a format string with the actual error message. The
default is @scheme["Error in your code --\n~a"]. Useful examples of
these messages:
@scheme["There is an error in your program, hit \"Run\" to debug"]
@scheme["There is an error in your program:\n----\n~a\n----\nHit \"Run\" and debug your code."]
Alternatively, the value can be a procedure that will be invoked
with the error message. The procedure can do anything it wants, and
if it does not raise an exception, then the checker will proceed as
usual. For example:
@schemeblock{
(lambda (msg)
(add-header-line! "Erroneous submission!")
(add-header-line! (format " --> ~a" msg))
(message (string-append
"You have an error in your program -- please hit"
" \"Run\" and debug your code.\n"
"Email the course staff if you think your code is"
" fine.\n"
"(The submission has been saved but marked as"
" erroneous.)")
'(ok))
(message "Handin saved as erroneous." 'final))}
(Note that if you do this, then additional tests should be adjusted
to not raise an exception too.)}
@item{@indexed-scheme[:value-printer]---if specified, this will be
used for @scheme[current-value-printer].}
@item{@indexed-scheme[:coverage?]---collect coverage information when
evaluating the submission. This will cause an error if some input
is not covered. This check happens after checker tests are run, but
the information is collected and stored before, so checker tests do
not change the result. Also, you can use the @scheme[!all-covered]
procedure in the checker before other tests, if you want that
feedback earlier.}]
Within the body of @scheme[check:], @scheme[users] and
@scheme[submission] will be bound to the checker arguments---a
(sorted) list of usernames and the submission as a byte string. In
addition to the functionality below, you can use
@scheme[((submission-eval) expr)] to evaluate expressions in the
submitted code context, and you can use
@scheme[(with-submission-bindings (id ...) body ...)] to evaluate the
body when @scheme[id]'s are bound to their values from the submission
code.}
@deftogether[(@defform[(pre: body ...)]
@defform[(post: body ...)])]{
These two macros define a pre- and a post-checker. In their bodies,
@scheme[_users] and @scheme[_submission] are bound as in
@scheme[check:], but there is nothing else special about these. See
the description of the @scheme[pre-checker] and
@scheme[post-checker] values for what can be done with these, and
note that the check for valid users is always first. An example for
a sophisticated @scheme[post:] block is below---it will first
disable timeouts for this session, then it will send a email with a
submission receipt, with CC to the TA (assuming a single TA), and
pop-up a message telling the student about it:
@schemeblock[
(require net/sendmail)
(post:
(define info
(format "hw.scm: ~a ~a"
(file-size "hw.scm")
(file-or-directory-modify-seconds "hw.scm")))
(timeout-control 'disable)
(log-line "Sending a receipt: ~a" info)
(send-mail-message
"course-staff@university.edu"
"Submission Receipt"
(map (lambda (user) (user-substs user "{Full Name} <{Email}>"))
users)
(list (user-substs (car users) "{TA Name} <{TA Email}>"))
null
`("Your submission was received" ,info))
(message (string-append
"Your submission was successfully saved."
" You will get an email receipt within 30 minutes;"
" if not, please contact the course staff.")
'(ok)))]}
@defparam[submission-eval eval (any/c . -> . any)]{
Holds an evaluation procedure for evaluating code in the submission
context.}
@; JBC: is this always just a list of strings?
@defproc[(user-data [user string?]) (listof string?)]{
Returns a user information given a username. The returned
information is a list of strings that corresponds to the configured
@scheme[extra-fields].}
@defproc[(user-substs [user string?] [fmt string?]) string]{
Uses the mappings in @scheme[user-data] to substitute user
information for substrings of the form ``@tt{{some-field-name}}'' in
@scheme[fmt]. This procedure signals an error if a field name is
missing in the user data. Also, ``@tt{{username}}'' will always be
replaced by the username and ``@tt{{submission}}'' by the current
submission directory.
This is used to process the @scheme[:student-line] value in the
checker, but it is provided for additional uses. See the above
sample code for @scheme[post:] for using this procedure.}
@defproc[(pairs-or-singles-with-warning [users (listof string?)])
any]{
Intended for use as the @scheme[:users] entry in a checker. It will
do nothing if there are two users, and throw an error if there are
more. If there is a single user, then the user will be asked to
verify a single submission. If the student cancels, then an
exception is raised so the submission directory is retracted. If
the student approves this, the question is not repeated (this is
marked by creating a directory with a known name). This is useful
for cases where you want to allow free pair submissions---students
will often try to submit their work alone, and later on re-submit
with a partner.}
@defproc[(teams-in-file [team-file path-string?])
((listof string?) . -> . void?)]{
@italic{Returns} a procedure that can be used for the :users entry
in a checker. The team file (relative from the server's main
directory) is expected to have user entries---a sequence of
s-expressions, each one a string or a list of strings. The
resulting procedure will allow submission only by teams that are
specified in this file. Furthermore, if this file is modified, the
new contents will be used immediately, so there is no need to
restart the server of you want to change student teams. (But
remember that if you change @scheme[("foo" "bar")] to
@scheme[("foo" "baz")], and there is already a @filepath{bar+foo}
submission directory, then the system will not allow ``@tt{foo}'' to
submit with ``@tt{bar}''.)}
@defproc[(add-header-line! [line string?]) void?]{
During the checker operation, can be used to add header lines to the
text version of the submitted file (in addition to the
@scheme[:extra-lines] setting). It will not have an effect if
@scheme[:create-text?] is false.}
@defproc[(procedure/arity? [proc procedure?] [arity number?])
boolean?]{
Returns @scheme[#t] if @scheme[proc] is a procedure that accepts
@scheme[arity] arguments.}
@defform[(!defined id ...)]{
Checks that the given identifiers are defined in the (evaluated)
submission, and throws an error otherwise.}
@defform[(!procedure id arity)]{
Checks that @scheme[id] is defined, and is bound to a procedure.}
@defform[(!procedure* expr arity)]{
Similar to @scheme[!procedure] but omits the defined check, making
it usable with any expression, which is then evaluated in the
submission context.}
@deftogether[(@defform[(!integer id)]
@defform[(!integer* expr)])]{
Similar to @scheme[!procedure] and @scheme[!procedure*] for
integers.}
@defform*[((!test expr)
(!test expr result)
(!test expr result equal?))]{
The first form checks that the given expression evaluates to a
non-@scheme[#f] value in the submission context, throwing an error
otherwise. The second form compares the result of evaluation,
requiring it to be equal to @scheme[result]. The third allows
specifying an equality procedure. Note that the @scheme[result] and
@scheme[equal?] forms are @italic{not} evaluated in the submission
context.}
@defproc*[([(!all-covered) void?]
[(!all-covered [proc (string? . -> . any)]) void?])]{
When coverage information is enabled (see @scheme[:coverage?]
above), checks the collected coverage information and throws an
error with source information if some code is left uncovered. If
@scheme[proc] is provided, it is applied to a string argument that
describes the location of the uncovered expression
(@scheme["<line>:<col>"], @scheme["#<char-pos>"], or
@scheme["(unknown position)"]) instead of throwing an error. The
collected information includes only execution coverage by submission
code, excluding additional checker tests. You do not have to call
this explicitly---it is called at the end of the process
automatically when @scheme[:coverage?] is enabled. It is made
available so you can call it earlier (e.g., before testing) to show
clients a coverage error first, or if you want to avoid an error.
For example, you can do this:
@schemeblock[
(!all-covered
(lambda (where)
(case (message (string-append
"Incomplete coverage at "where", do you want"
" to save this submission with 10% penalty?"))
[(yes) (add-header-line! "No full coverage <*90%>")
(message "Handin saved with penalty.")]
[else (error "aborting submission")])))]}

61
collects/handin-server/scribblings/client-customization.scrbl Normal file
View File

@ -0,0 +1,61 @@
#lang scribble/doc
@(require "common.ss")
@title{Client Customization}
@itemize[
@item{Rename (or make a copy of) the @filepath{handin-client}
collection directory. The new name should describe your class
uniquely. For example, @filepath{uu-cpsc2010} is a good name for CPSC
2010 at the University of Utah.}
@item{Edit the first three definitions of @filepath{info.ss} in your
renamed client collection:
@itemize[
@item{For @scheme[name], choose a name for the handin tool as it
will appear in DrScheme's interface (e.g., the @onscreen{XXX} for
the @onscreen{Manage XXX Handin Account...} menu item). Again,
make the name specific to the course, in case a student installs
multiple handin tools. Do not use @onscreen{Handin} as the last
part of the name, since @onscreen{Handin} is always added for
button and menu names.}
@item{Uncomment the definitions of @scheme[tools],
@scheme[tool-names], and @scheme[tool-icons]. (But leave the
latter field's definition as @filepath{icon.png}.)}
@item{For @scheme[server:port], uncomment the line, and use the
hostname and port where the server will be running to accept
handin submissions.}]
Optionally uncomment and edit the next two definitions,
@scheme[web-menu-name] and @scheme[web-address], to add an item to
the @onscreen{Help} menu that opens a (course-specific) web page.}
@item{Replace @filepath{icon.png} in your renamed directory with a new
32x32 icon. This icon is displayed on startup with DrScheme's
splash screen, and it is included at half size on the
@onscreen{Handin} button. A school logo is typically useful, as it
provides a recognizably local visual cue. If students might use
multiple installed handin tools, then make sure to vary the icon
according to the course.}
@item{Replace @filepath{server-cert.pem} in your renamed directory
with a server certificate. The file @filepath{server-cert.pem} in
@filepath{handin-client} collection is ok for testing, but the point
of this certificate is to make handins secure, so you should
generate a new (self-certifying) certificate and keep its key
private. (See @secref{server-setup}.)}
@item{Run @commandline{mzc --collection-plt <name>.plt <name>} where
@tt{<name>} is the name that you chose for your directory (i.e.,
whatever you changed @filepath{handin-client} to).}
@item{Distribute @filepath{<name>.plt} to students for installation
into their copies of DrScheme. The students need not have access to
the DrScheme installation directory; the tool will be installed on
the filesystem in the student's personal space. If you want to
install it once on a shared installation, use setup-plt with the
@DFlag{all-users} flag.}
]

20
collects/handin-server/scribblings/common.ss Normal file
View File

@ -0,0 +1,20 @@
#lang scheme/base
(require scheme/require)
(require scribble/manual
(for-label scheme
(subtract-in handin-server/checker scheme)
;; scheme/sandbox
handin-server/sandbox
handin-server/utils
mred
"hook-dummy.ss"))
(provide (all-from-out scribble/manual)
(for-label (all-from-out scheme
handin-server/checker
handin-server/sandbox
handin-server/utils
mred
"hook-dummy.ss")))

1341
collects/handin-server/scribblings/handin-server.scrbl
View File

File diff suppressed because it is too large Load Diff

3
collects/handin-server/scribblings/info.ss Normal file
View File

@ -0,0 +1,3 @@
#lang setup/infotab
(define scribblings '(("handin-server.scrbl" (multi-page user-doc))))

58
collects/handin-server/scribblings/multifile.scrbl Normal file
View File

@ -0,0 +1,58 @@
#lang scribble/doc
@(require "common.ss")
@title[#:tag "multi-file"]{Multiple-File Submissions}
By default, the system is set up for submissions of single a single
file, straight fom DrScheme using the handin-client. There is some
support for multi-file submissions in
@schememodname[handin-server/checker] and in the handin-client. It is
possible to submit multiple files, and have the system generate a
single file that is the concatenation of all submission files (used
only with text files). To set up multi-file submissions, do the
following:
@itemize[
@item{Add a @scheme[:multi-file] keyword in @scheme[check:], and as a
value, use the suffix that should be used for the single
concatenated output file.}
@item{You can also add a @scheme[:names-checker] keyword--the value
can be a regexp that all submitted files must follow (e.g.,
@scheme[".*[.]scm$"]), or a list of expected file names.
Alternatively, it can be a 1-argument procedure that will receive
the (sorted) list of submitted files and can throw an error if some
files are missing or some files are forbidden.}
@item{In the @filepath{info.ss} file of the handin-client you need to
set @scheme[enable-multifile-handin] to @scheme[#t], and adjust
@scheme[selection-default] to patterns that are common to your
course. (It can be a single pattern, or a list of them.)}]
On the server side, each submission is saved in a file called
@filepath{raw}, which contains all submitted files. In the
@filepath{grading} directory, you will get a @filepath{text.<sfx>}
file (@filepath{<sfx>} is the suffix that is used as a value for
@scheme[:multi-file]) that contains all submitted files with clear
separators. A possible confusion is that every submission is a
complete set of files that overwrites any existing submission, whereas
students may think that the server accumulates incoming files. To
avoid such confusion, when a submission arrives an there is already an
existing previous submission, the contents is compared, and if there
are files that existed in the old submission but not in the new ones,
the student will see a warning pop-up that allows aborting the
submission.
On the client side, students will have an additional file-menu entry
for submitting multiple files, which pops up a dialog that can be used
to submit multiple files. In this dialog, students choose their
working directory, and the @scheme[selection-default] entry from the
@filepath{handin-client/info.ss} file specifies a few patterns that
can be used to automatically select files. The dialog provides all
handin-related functionality that is available in DrScheme. For
further convenience, it can be used as a standalone application: in
the account management dialog, the @onscreen{Un/Install} tab has a
button that will ask for a directory where it will create an
executable for the multi-file submission utility---the resulting
executable can be used outside of DrScheme (but PLT Scheme is still
required, so it cannot be uninstalled).

10
collects/handin-server/scribblings/other-utils.scrbl Normal file
View File

@ -0,0 +1,10 @@
#lang scribble/doc
@(require "common.ss")
@title{Additional Utilities}
These are additional utilities that are useful in the context of a
homework submission system.
@include-section["multifile.scrbl"]
@include-section["updater.scrbl"]

60
collects/handin-server/scribblings/quick-start.scrbl Normal file
View File

@ -0,0 +1,60 @@
#lang scribble/doc
@(require "common.ss")
@title{Quick Start for a Test Drive}
@itemize[
@item{Create a new directory.}
@item{Copy @filepath{server-cert.pem} from the
@filepath{handin-client} collection to the new directory.
NOTE: For real use, you need a new certificate.
NOTE: See also @secref{wheres-the-collection}.}
@item{Copy @filepath{private-key.pem} from the
@filepath{handin-server} collection to the new directory.
NOTE: For real use, you need a new key.}
@item{Create a file @filepath{users.ss} with the following content:
@schemeblock[
((tester ("8fe4c11451281c094a6578e6ddbf5eed"
"Tester" "1" "test@cs")))]}
@item{Make a @filepath{test} subdirectory in your new directory.}
@item{Create a file @filepath{config.ss} with the following content:
@schemeblock[((active-dirs ("test"))
(https-port-number 9780))]}
@item{In your new directory, run @commandline{mred -l handin-server}}
@item{In the @filepath{handin-client} collection, edit
@filepath{info.ss} and uncomment the lines that define
@scheme[server:port], @scheme[tools], @scheme[tool-names], and
@scheme[tool-icons].}
@item{Run @commandline{setup-plt -l handin-client}
NOTE: Under Windows, the executable is @exec{Setup PLT} instead of
@exec{setup-plt}.
NOTE: The command line arguments are optional, it restricts the
setup work to the specified collection.}
@item{Start DrScheme, click @onscreen{Handin} to run the client,
submit with username ``@tt{tester}'' and password ``@tt{pw}''.
The submitted file will be @filepath{.../test/tester/handin.scm}.}
@item{Check the status of your submission by pointing a web browser at
@tt{https://localhost:7980/servlets/status.ss}. Note the ``s'' in
``https''. Use the ``@tt{tester}'' username and ``@tt{pw}''
password, as before.
NOTE: The @scheme[https-port-number] line in the
@filepath{config.ss} file enables the embedded secure server. You
can remove it if you don't want it.}
]

9
collects/handin-server/scribblings/sandbox.scrbl Normal file
View File

@ -0,0 +1,9 @@
#lang scribble/doc
@(require "common.ss")
@title{Sandbox}
@defmodule[handin-server/sandbox]
This is just a wrapper around the sandbox engine from MzLib. It
configures it for use with the handin server.

36
collects/handin-server/scribblings/server-client.scrbl Normal file
View File

@ -0,0 +1,36 @@
#lang scribble/doc
@(require "common.ss")
@title{Handin-Server and Client}
The @filepath{handin-server} directory contains a server to be run by a
course instructor for accepting homework assignments and reporting on
submitted assignments.
The @filepath{handin-client} directory contains a client to be
customized then re-distributed to students in the course. The
customized client will embed a particular hostname and port where the
server is running, as well as a server certificate.
With a customized client, students simply install a @filepath{.plt}
file---so there's no futzing with configuration dialogs and
certificates. A student can install any number of clients at once
(assuming that the clients are properly customized, as described
below).
The result, on the student's side, is a @onscreen{Handin} button in
DrScheme's toolbar. Clicking the @onscreen{Handin} button allows the
student to type a password and upload the current content of the
definitions and interactions window to the course instructor's server.
The @onscreen{File} menu is also extended with a @onscreen{Manage...}
menu item for managing a handin account (i.e., changing the password
and other information, or creating a new account if the instructor
configures the server to allow new accounts). Students can submit
joint work by submitting with a concatenation of usernames separated
by a ``@tt{+}''.
On the instructor's side, the handin server can be configured to check
the student's submission before accepting it.
The handin process uses SSL, so it is effectively as secure as the
server and each user's password.

490
collects/handin-server/scribblings/server-setup.scrbl Normal file
View File

@ -0,0 +1,490 @@
#lang scribble/doc
@(require "common.ss")
@title[#:tag "server-setup"]{Server Setup}
@declare-exporting[#:use-sources (handin-server/scribblings/hook-dummy)]
You must prepare a special directory to host the handin server. To
run the server, you should either be in this directory, or you should
set the @envvar{PLT_HANDINSERVER_DIR} environment variable.
This directory contains the following files and sub-directories:
@itemize[
@item{@filepath{server-cert.pem}: the server's certificate. To create
a certificate and key with openssl:
@commandline{openssl req -new -nodes -x509 -days 365
-out server-cert.pem -keyout private-key.pem}}
@item{@filepath{private-key.pem}: the private key to go with
@filepath{server-cert.pem}. Whereas @filepath{server-cert.pem} gets
distributed to students with the handin client,
@filepath{private-key.pem} is kept private.}
@item{@filepath{config.ss}: configuration options. The file format is
@schemeblock[((<key> <val>) ...)]
The following keys can be used:
@itemize[
@item{@indexed-scheme[active-dirs] --- a list of directories that
are active submissions, relative to the current directory or
absolute; the last path element for each of these (and
@scheme[inactive-dirs] below) should be unique, and is used to
identify the submission (for example, in the client's submission
dialog and in the status servlet). If a specified directory does
not exist, it will be created.}
@item{@indexed-scheme[inactive-dirs] --- a list of inactive
submission directories (see above for details).}
@item{@indexed-scheme[port-number] --- the port for the main handin
server; the default is 7979.}
@item{@indexed-scheme[https-port-number] --- the port number for the
handin-status HTTPS server; the default is @scheme[#f] which
indicates that no HTTPS server is started.}
@item{@indexed-scheme[session-timeout] --- number of seconds before
the session times-out. The client is given this many seconds for
the login stage and then starts again so the same number of
seconds is given for the submit-validation process; the default is
300.}
@item{@indexed-scheme[session-memory-limit] --- maximum size in
bytes of memory allowed for per-session computation, if
per-session limits are supported (i.e., when using MrEd and
MzScheme with the (default) exact garbage collector and memory
accounting); the default is 40000000.}
@item{@indexed-scheme[default-file-name] --- the default filename
that will be saved with the submission contents. The default is
@filepath{handin.scm}.}
@item{@indexed-scheme[max-upload] --- maximum size in bytes of an
acceptable submission; the default is 500000.}
@item{@indexed-scheme[max-upload-keep] --- maximum index of
submissions to keep; the most recent submission is
@filepath{handin.scm} (by default), the next oldest is in
@filepath{BACKUP-0/handin.scm}, next oldest is
@filepath{BACKUP-1/handin.scm}, etc. The default is 9.}
@item{@indexed-scheme[user-regexp] --- a regular expression that is
used to validate usernames; alternatively, this can be @scheme[#f]
meaning no restriction, or a list of permitted strings. Young
students often choose exotic usernames that are impossible to
remember, and forget capitalization, so the default is fairly
strict--- @scheme[#rx"^[a-z][a-z0-9]+$"]; a @scheme["+"] is always
disallowed in a username, since it is used in a submission
username to specify joint work.}
@item{@indexed-scheme[user-desc] --- a plain-words description of
the acceptable username format (according to user-regexp above);
@scheme[#f] stands for no description; the default is
@scheme["alphanumeric string"] which matches the default
user-regexp.}
@item{@indexed-scheme[username-case-sensitive] --- a boolean; when
@scheme[#f], usernames are case-folded for all purposes; defaults
to @scheme[#f] (note that you should not set this to @scheme[#t]
on Windows or when using other case-insensitive filesystems, since
usernames are used as directory names).}
@item{@indexed-scheme[allow-new-users] --- a boolean indicating
whether to allow new-user requests from a client tool; the default
is @scheme[#f].}
@item{@indexed-scheme[allow-change-info] --- a boolean indicating
whether to allow changing user information from a client tool
(changing passwords is always possible); the default is
@scheme[#f].}
@item{@indexed-scheme[master-password] --- a string for an MD5 hash
for a password that allows login as any user; the default is
@scheme[#f], which disables the password.}
@item{@indexed-scheme[log-output] --- a boolean that controls
whether the handin server log is written on the standard output;
defaults to @scheme[#t].}
@item{@indexed-scheme[log-file] --- a path (relative to handin
server directory or absolute) that specifies a filename for the
handin server log (possibly combined with the @scheme[log-output]
option), or @scheme[#f] for no log file; defaults to
@filepath{log}.}
@item{@indexed-scheme[web-base-dir] --- if @scheme[#f] (the
default), the built-in web server will use the
@filepath{status-web-root} in this collection for its
configuration; to have complete control over the built in server,
you can copy and edit @filepath{status-web-root}, and add this
configuration entry with the name of your new copy (relative to
the handin server directory, or absolute).}
@item{@indexed-scheme[web-log-file] --- a path (relative to handin
server directory or absolute) that specifies a filename for
logging the internal HTTPS status web server; or @scheme[#f] (the
default) to disable this log.}
@item{@indexed-scheme[extra-fields] --- a list that describes extra
string fields of information for student records; each element in
this list is a list of three values: the name of the field, the
regexp (or @scheme[#f], or a list of permitted string values), and
a string describing acceptable strings. The default is
@schemeblock[
'(("Full Name" #f #f)
("ID#" #f #f)
("Email" #rx"^[^@<>\"`',]+@[a-zA-Z0-9_.-]+[.][a-zA-Z]+$"
"a valid email address"))]
You can set this to a list of fields that you are interested in
keeping, for example:
@schemeblock[
'(("Full Name"
#rx"^[A-Z][a-zA-Z]+(?: [A-Z][a-zA-Z]+)+$"
"full name, no punctuations, properly capitalized")
("Utah ID Number"
#rx"^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$"
"Utah ID Number with exactly nine digits")
("Email"
#rx"^[^@<>\"`',]+@cs\\.utah\\.edu$"
"A Utah CS email address"))]
The order of these fields will be used both on the client GUI side
and in the @filepath{users.ss} file (see below).
@; JBC: a hyperlink here for users.ss?
The second item in a field description can also be the symbol
@scheme['-], which marks this field as one that is hidden from the
user interface: students will not see it and will not be able to
provide or modify it; when a new student creates an account, such
fields will be left empty. This is useful for adding information
that you have on students from another source, for example, adding
information from a course roster. You should manually edit the
@filepath{users.ss} file and fill in such information. (The third
element for such descriptors is ignored.)}
@item{@indexed-scheme[hook-file] --- a path (relative to handin
server directory or absolute) that specifies a filename that
contains a `hook' module. This is useful as a general device for
customizing the server through Scheme code. The file is expected
to contain a module that provides a @scheme[hook] function, which
should be receiving three arguments:
@defproc[(hook [operation symbol?]
[connection-context (or/c number? symbol? false?)]
[relevant-info (listof (list/c symbol? any))])
void?]{
The @scheme[operation] argument indicates the operation that is
now taking place. It can be one of the following:
@indexed-scheme['server-start],
@indexed-scheme['server-connect], @indexed-scheme['user-create],
@indexed-scheme['user-change], @indexed-scheme['login],
@indexed-scheme['submission-received],
@indexed-scheme['submission-committed],
@indexed-scheme['submission-retrieved],
@indexed-scheme['status-login], or
@indexed-scheme['status-file-get].
The @scheme[connection-context] argument is a datum that
specifies the connection context (a number for handin
connections, a @scheme['wN] symbol for servlet connections, and
@scheme[#f] for other server operations).
The @scheme[relevant-info] contains an alist of information
relevant to this operation. Currently, the hook is used in
several places after an operation has completed.
For example, here is a simple hook module that sends
notification messages when users are created or their
information has changed:
@schememod[
mzscheme
(provide hook)
(require net/sendmail)
(define (hook what session alist)
(when (memq what '(user-create user-change))
(send-mail-message
"course-staff@university.edu"
(format "[server] ~a (~a)" what session)
'("course-staff@university.edu") '() '()
(map (lambda (key+val)
(apply format "~a: ~s" key+val))
alist))))]}}]
Changes to @filepath{config.ss} are detected, the file will be
re-read, and options are reloaded. A few options are fixed at
startup time: port numbers, log file specs, and the
@scheme[web-base-dir] are as configured at startup. All other
options will change the behavior of the running server (but things
like @scheme[username-case-sensitive?] it would be unwise to do
so). (For safety, options are not reloaded until the file parses
correctly, but make sure that you don't save a copy that has
inconsistent options: it is best to create a new configuration file
and move it over the old one, or use an editor that does so and not
save until the new contents is ready.) This is most useful for
closing & opening submissions directories.}
@item{@filepath{users.ss} (created if not present if a user is added):
keeps the list of user accounts, along with the associated password
(actually the MD5 hash of the password), and extra string fields as
specified by the 'extra-fields configuration entry (in the same
order). The file format is
@schemeblock[
((<username-sym> (<pw-md5-str> <extra-field> ...))
...)]
For example, the default @scheme['extra-field] setting will make this:
@schemeblock[
((<username-sym> (<pw-md5-str> <full-name> <id> <email>))
...)]
Usernames that begin with ``solution'' are special. They are used
by the HTTPS status server. Independent of the
@scheme['user-regexp] and @scheme['username-case-sensitive?]
configuration items, usernames are not allowed to contain characters
that are illegal in Windows pathnames, and they cannot end or begin
in spaces or periods.
If the @scheme['allow-new-users] configuration allows new users, the
@filepath{users.ss} file can be updated by the server with new
users. It can always be updated by the server to change passwords.
If you have access to a standard Unix password file (from
@filepath{/etc/passwd} or @filepath{/etc/shadow}), then you can
construct a @filepath{users.ss} file that will allow users to use
their normal passwords. To achieve this, use a list with 'unix as
the first element and the system's encrypted password string as the
second element. Such passwords can be used, but when users change
them, a plain md5 hash will be used.
You can combine this with other fields from the password file to
create your @filepath{users.ss}, but make sure you have information
that matches your 'extra-fields specification. For example, given
this system file:
@verbatim[#:indent 2]{
foo:wRzN1u5q2SqRD:1203:1203:L.E. Foo :/home/foo:/bin/tcsh
bar:$1$dKlU0OkJ$t63TzKz:1205:1205:Bar Z. Lie:/home/bar:/bin/bash}
you can create this @filepath{users.ss} file:
@schemeblock[
((foo ((unix "wRzN1u5q2SqRD") "L.E. Foo" "?"))
(bar ((unix "$1$dKlU0OkJ$t63TzKz") "Bar Z. Lie" "?")))]
which can be combined with this setting for @scheme['extra-fields]
in your @filepath{config.ss}:
@schemeblock[
...
(extra-fields (("Full Name" #f #f)
("TA" '("Alice" "Bob") "Your TA")))
...]
and you can tell your students to use their department username and
password, and use the @onscreen{Manage ...} dialog to properly set
their TA name.
Finally, a password value can be a list that begins with a
@scheme['plaintext] symbol, which will be used without encryption.
This may be useful for manually resetting a forgotten passwords.}
@item{@filepath{log} (or any other name that the @scheme['log-file]
configuration option specifies (if any), created if not present,
appended otherwise): records connections and actions, where each
entry is of the form
@verbatim{[<id>|<time>] <msg>}
where @scheme[<id>] is an integer representing the connection
(numbered consecutively from 1 when the server starts), ``@tt{-}''
for a message without a connection, and ``@tt{wN}'' for a message
from the status servlet.}
@item{Active and inactive assignment directories (which you can put in
a nested directory for convenience, or specify a different absolute
directory), as specified by the configuration file using the
@scheme['active-dirs] and @scheme['inactive-dirs]. A list of active
assignment directories (the last path element in each specified path
is used as a label) is sent to the client tool when a student clicks
@onscreen{Handin}. The assignment labels are ordered in the
student's menu using @scheme[string<?], and the first assignment is
the default selection.
Within each assignment directory, the student id is used for a
sub-directory name. Within each student sub-directory are
directories for handin attempts and successes. If a directory
@filepath{ATTEMPT} exists, it contains the most recent (unsuccessful
or currently-in-submission) handin attempt. Directories
@filepath{SUCCESS-n} (where n counts from 0) contain successful
handins; the lowest numbered such directory represents the latest
handin.
A cleanup process in the server copies successful submissions to the
student directory, one level up from the corresponding
@filepath{SUCCESS-n} directory. This is done only for files and
directories that are newer in @filepath{SUCCESS-n} than in the
submission root, other files and directories are left intact. If
external tools add new content to the student directory (e.g., a
@filepath{grade} file, as described below) it will stay there. If
the machine crashes or the server is stopped, the cleanup process
might not finish. When the server is started, it automatically runs
the cleanup process for each student directory.
Within a student directory, a @filepath{handin.scm} file (or some
other name if the @scheme[default-file-name] option is set) contains
the actual submission. A @scheme[checker] procedure can change this
default file name, and it can create additional files in an
@filepath{ATTEMPT} directory (to be copied by the cleanup process);
see below for more details on @schememodname[handin-server/checker].
For submissions from a normal DrScheme frame, a submission file
contains a copy of the student's definitions and interactions
windows. The file is in a binary format (to support non-text code),
and opening the file directly in DrScheme shows the definitions
part. To get both the definitions and interactions parts, the file
can be parsed with @scheme[unpack-submission] from
@schememodname[handin-server/utils].
To submit an assignment as a group, students use a concatenation of
usernames separated by ``@tt{+}'' and any number of spaces (e.g.,
``@tt{user1+user2}''). The same syntax (``@tt{user1+user2}'') is
used for the directory for shared submissions, where the usernames
are always sorted so that directory names are deterministic.
Multiple submissions for a particular user in different groups will
be rejected.
Inactive assignment directories are used by the the HTTPS status web
server.}
@item{@filepath{<active-assignment>/checker.ss} (optional): a module
that exports a @scheme[checker] function. This function receives
two
@; JBC: use defproc here?
arguments: a username list and a submission as a byte string. (See
also @scheme[unpack-submission], etc. from
@schememodname[handin-server/utils].) To
reject the submission, the @scheme[checker] function can raise an
exception; the exception message will be relayed back to the
student. The module is loaded when the current directory is the
main server directory, so it can read files from there (but note
that to read values from @filepath{config.ss} it is better to use
@scheme[get-conf]). Also, the module will be reloaded if the
checker file is modified; there's no need to restart the server,
but make sure that you do not save a broken checker (i.e., do not
save in mid-edit).
The first argument is a list of usernames with at least one
username, and more than one if this is a joint submission (where
the submission username was a concatenation of usernames separated
by ``@tt{+}'').
The @scheme[checker] function is called with the current directory
as @filepath{<active-assignment>/<username(s)>/ATTEMPT}, and the
submission is saved in the file @filepath{handin}, and the timeout
clock is reset to the value of the @scheme[session-timeout]
configuration. The checker function can change @filepath{handin},
and it can create additional files in this directory. (Extra
files in the current directory will be preserved as it is later
renamed to @filepath{SUCCESS-0}, and copied to the submission's
root (@filepath{<active-assignment>/<username(s)>/}), etc.) To
hide generated files from the HTTPS status web server interface,
put the files in a subdirectory, it is preserved but hidden from
the status interface.
The checker should return a string, such as @filepath{handin.scm},
to use in naming the submission file, or @scheme[#f] to indicate
that he file should be deleted (e.g., when the checker alrady
created the submission file(s) in a different place).
Alternatively, the module can bind @scheme[checker] to a list of
three procedures: a pre-checker, a checker, and a post-checker.
All three are applied in exactly the same way as the checker (same
arguments, and always within the submission directory), except
that:
@itemize[
@item{If there was an error during the pre-checker, and the
submission directory does not have a @filepath{SUCCESS-*}
directory, then the whole submission directory is removed. This
is useful for checking that the user/s are valid; if you allow a
submission only when @scheme[users] is @scheme['("foo" "bar")],
and ``@tt{foo}'' tries to submit alone, then the submission
directory for ``@tt{foo}'' should be removed to allow a proper
submission later. Note that the timeout clock is reset only
once, before the pre-checker is used.}
@item{The post-checker is used at the end of the process, after
the @filepath{ATTEMPT} directory was renamed to
@filepath{SUCCESS-0}. At this stage, the submission is
considered successful, so this function should avoid throwing an
exception (it can, but the submission will still be in place).
This is useful for things like notifying the user of the
successful submission (see @scheme[message]), or sending a
``receipt'' email.}]
To specify only pre/post-checker, use @scheme[#f] for the one you
want to omit.}
@item{@filepath{<[in]active-assignment>/<user(s)>/<filename>} (if
submitted): the most recent submission for
@tt{<[in]active-assignment>} by @tt{<user(s)>} where <filename> was
returned by the checker (or the value of the
@scheme[default-file-name] configuration option if there's no
checker). If the submission is from multiple users, then
``@tt{<user(s)>}'' is actually ``@tt{<user1>+<user2>}'' etc. Also,
if the cleanup process was interrupted (by a machine failure, etc.),
the submission may actually be in @filepath{SUCCESS-n} as described
above, but will move up when the server performs a cleanup (or when
restarted).}
@item{@filepath{<[in]active-assignment>/<user(s)>/grade} (optional):
the @tt{<user(s)>}'s grade for @tt{<[in]active-assignment>}, to be
reported by the HTTPS status web server}
@item{@filepath{<[in]active-assignment>/solution*}: the solution to
the assignment, made available by the status server to any user who
logs in. The solution can be either a file or a directory with a
name that begins with @filepath{solution}. In the first case, the
status web server will have a ``Solution'' link to the file, and in
the second case, all files in the @filepath{solution*} directory
will be listed and accessible.}
]
The server can be run within either MzScheme or MrEd, but
@schememodname[handin-server/utils] requires MrEd (which means that
@scheme[checker] modules will likely require the server to run under
MrEd). Remember that if you're not using the (default) 3m garbage
collector you don't get memory accounting.
The server currently provides no mechanism for a graceful shutdown,
but terminating the server is no worse than a network outage. (In
particular, no data should be lost.) The server reloads the
configuration file, checker modules etc, so there should not be any
need to restart it for reconfigurations.
The client and server are designed to be robust against network
problems and timeouts. The client-side tool always provides a
@onscreen{cancel} button for any network transaction. For handins,
@onscreen{cancel} is guaranteed to work up to the point that the
client sends a ``commit'' command; this command is sent only after the
server is ready to record the submission (having run it through the
checker, if any), but before renaming @filepath{ATTEMPT}. Also, the
server responds to a commit with @onscreen{ok} only after it has
written the file. Thus, when the client-side tool reports that the
handin was successful, the report is reliable. Meanwhile, the tool
can also report successful cancels most of the time. In the (normally
brief) time between a commit and an @onscreen{ok} response, the tool
gives the student a suitable warning that the cancel is unreliable.
To minimize human error, the number of active assignments should be
limited to one whenever possible. When multiple assignments are
active, design a checker to help ensure that the student has selected
the correct assignment in the handin dialog.
A student can download his/her own submissions through a web server
that runs concurrently with the handin server. The starting URL is
@commandline{https://SERVER:PORT/servlets/status.ss}
to obtain a list of all assignments, or
@commandline{https://SERVER:PORT/servlets/status.ss?handin=ASSIGNMENT}
to start with a specific assignment (named ASSIGNMENT). The default
PORT is 7980.

34
collects/handin-server/scribblings/updater.scrbl Normal file
View File

@ -0,0 +1,34 @@
#lang scribble/doc
@(require "common.ss")
@title{Auto-Updater}
The handin-client has code that can be used for automatic updating of
clients. This can be useful for courses where you distribute some
additional functionality (collections, teachpacks, language-levels
etc), and this functionality can change (or expected to change, for
example, distributing per-homework teachpacks).
To enable this, uncomment the relevant part of the @filepath{info.ss}
file in the client code. It has the following three keys:
@indexed-scheme[enable-auto-update] that turns this facility on, and
@indexed-scheme[version-filename] and
@indexed-scheme[package-filename] which are the expected file names of
the version file and the @filepath{.plt} file relative to the course
web address (the value of the @scheme[web-address] key). Also,
include in your client collection a @filepath{version} file that
contains a single number that is its version. Use a big integer that
holds the time of this collection in a @tt{YYYYMMDDHHMM} format.
When students install the client, every time DrScheme starts, it will
automatically check the version from the web page (as specified by the
@scheme[web-address] and @scheme[version-filename] keys), and if that
contains a bigger number, it will offer the students to download and
install the new version. So, every time you want to distribute a new
version, you build a new @filepath{.plt} file that contains a new
version file, then copy these version and @filepath{.plt} files to
your web page, and students will be notified automatically. Note: to
get this to work, you need to create your @filepath{.plt} file using
mzc's @DFlag{--replace} flag, so it will be possible to overwrite
existing files. (Also note that there is no way to delete files when
a new @filepath{.plt} is installed.)

180
collects/handin-server/scribblings/utils.scrbl Normal file
View File

@ -0,0 +1,180 @@
#lang scribble/doc
@(require "common.ss")
@title{Utils}
@defmodule[handin-server/utils]
@; JBC: have eli verify these contracts?
@defproc[(get-conf [key symbol?]) any/c]{
Returns a value from the configuration file (useful for reading
things like field names, etc.).}
@defproc[(unpack-submission [submission bytes?])
(values (is-a?/c text%) (is-a?/c text%))]{
Returns two @scheme[text%] objects corresponding to the submitted
definitions and interactions windows.}
@defproc[(make-evaluator/submission
[language (or/c module-path?
(list/c (one-of/c 'special) symbol?)
(cons/c (one-of/c 'begin) list?))]
[teachpack-paths (listof path-string?)]
[content bytes?])
(any/c . -> . any)]{
Like @scheme[make-evaluator], but the definitions content is
supplied as a submission byte string. The byte string is opened for
reading, with line-counting enabled.}
@defproc[(call-with-evaluator
[language (or/c module-path?
(list/c (one-of/c 'special) symbol?)
(cons/c (one-of/c 'begin) list?))]
[teachpack-paths (listof path-string?)]
[input-program any/c]
[proc (any/c . -> . any)])
any]{
Calls @scheme[proc] with an evaluator for the given language,
teachpack paths, and initial definition content as supplied by
@scheme[input-program] (see @scheme[make-evaluator]). It also sets
the current error-value print handler to print values in a way
suitable for @scheme[language], it initializes
@scheme[set-run-status] with @scheme["executing your code"], and it
catches all exceptions to re-raise them in a form suitable as a
submission error.}
@defproc[(call-with-evaluator/submission [language
(or/c module-path?
(list/c (one-of/c 'special) symbol?)
(cons/c (one-of/c 'begin) list?))]
[teachpack-paths (listof path-string?)]
[submission bytes?]
[proc (any/c . -> . any)])
any]{
Like @scheme[call-with-evaluator], but the definitions content is
supplied as a byte string. The byte string is opened for reading,
with line-counting enabled.}
@; JBC: this contract is probably wrong
@; JBC: does this eval accept an optional namespace?
@defproc[(evaluate-all [source any]
[input-port port?]
[eval (any/c . -> . any)]) any]{
Like @scheme[load] on an input port.}
@defproc[(evaluate-submission [submission bytes?]
[eval (any/c . -> . any)])
any]{
Like @scheme[load] on a submission byte string.}
@defproc[(check-proc [eval (any/c . -> . any)]
[expect-v any/c]
[compare-proc (any/c any/c . -> . any)]
[proc-name symbol?]
[arg any/c] ...)
any]{
Calls the function named @scheme[proc-name] using the evaluator
@scheme[eval], giving it the (unquoted) arguments @scheme[arg ...]
Let @scheme[result-v] be the result of the call; unless
@scheme[(compare-proc result-v expect-v)] is true, an exception is
raised.}
Every exception or result mismatch during the call to
@scheme[compare-proc] is phrased suitably for the handin client.
@defproc[(check-defined [eval (any/c . -> . any)]
[name symbol?])
any]{
Checks whether @scheme[name] is defined in the evaluator
@scheme[eval], and raises an error if not (suitably phrased for the
handin client). If it is defined as non-syntax, its value is
returned. Warning: in the beginner language level, procedure
definitions are bound as syntax.}
@; JBC: returns what? signals error?
@defproc[(look-for-tests [text (is-a?/c text%)] [name symbol?] [n number?])
any]{
Inspects the given @scheme[text%] object to determine whether it
contains at least @scheme[n] tests for the function @scheme[name].
The tests must be top-level expressions.}
@defproc[(user-construct [eval (any/c . -> . any)]
[name symbol?]
[arg any/c] ...)
any]{
Like @scheme[check-proc], but with no result checking. This
function is often useful for calling a student-defined constructor.}
@defparam[test-history-enabled on? any/c]{
Controls how run-time errors are reported to the handin client. If
the parameter's value is true, then the complete sequence of tested
expressions is reported to the handin client for any test failure.
Set this parameter to true when testing programs that use state.}
@defproc*[([(message [string string?]) void?]
[(message [string string?]
[styles (or/c (symbols 'final)
(listof (one-of/c 'ok 'ok-cancel
'yes-no 'caution 'stop)))])
any])]{
If given only a string, this string will be shown on the client's
submission dialog; if @scheme[styles] is also given, it can be the
symbol @scheme['final], which will be used as the text on the handin
dialog after a successful submission instead of ``Handin
successful.'' (useful for submissions that were saved, but had
problems); finally, @scheme[styles] can be used as a list of styles
for a @scheme[message-box] dialog on the client side, and the
resulting value is returned as the result of @scheme[message]. You
can use this to send warnings to the student or ask confirmation.}
@defproc[(set-run-status [status (or/c false? string?)]) void?]{
Registers information about the current actions of the checker, in
case the session is terminated due to excessive memory consumption
or a timeout. For example, a checker might set the status to
indicate which instructor-supplied test was being executed when the
session aborted.}
@defparam[current-value-printer proc (any/c . -> . string?)]{
Controls how values are printed. The @scheme[proc] must be a
procedure that expects a Scheme value and returns a string
representation for it. The default value printer uses
@scheme[pretty-print], with DrScheme-like settings.}
@defproc[(reraise-exn-as-submission-problem [thunk (-> any)]) any]{
Calls @scheme[thunk] in a context that catches exceptions and
re-raises them in a form suitable as a submission error. It returns
the value returned by @scheme[thunk] if no exception occurs.}
@defproc[(log-line [fmt string?] [args any/c] ...) void?]{
Produces a line in the server log file, using the given format
string and arguments. This function arranges to print the line fast
(to avoid mixing lines from different threads) to the error port,
and flush it. (The log port will prefix all lines with a time stamp
and a connection identifier.)}
@defproc[(timeout-control [msg string?]) void?]{
Controls the timeout for this session. The timeout is initialized
by the value of the @scheme[session-timeout] configuration entry,
and the checker can use this procedure to further control it: if
@scheme[msg] is @scheme['reset] the timeout is reset to
@scheme[session-timeout] seconds; if @scheme[msg] is a number the
timeout will be set to that many seconds in the future. The timeout
can be completely disabled by @scheme[(timeout-control #f)]. (Note
that before the checker is used (after the pre-checker, if
specified), the timer will be reset to the @scheme['session-timeout]
value.)}

11
collects/handin-server/scribblings/wheres-the-collection.scrbl Normal file
View File

@ -0,0 +1,11 @@
#lang scribble/doc
@(require "common.ss")
@title[#:tag "wheres-the-collection"]{Where is the collection?}
If you obtained the server and client by installing a @filepath{.plt}
file, then the @filepath{handin-server} and @filepath{handin-client}
directories might be in your PLT addon space. Start MzScheme, and
enter @schemeblock[(collection-path "handin-server")]
@schemeblock[(collection-path "handin-client")] to find out where
these collections are.

2
collects/macro-debugger/stxclass/info.ss
View File

@ -1,5 +1,5 @@
#lang setup/infotab
;; Not ready yet
#;(define scribblings '(("stxclass.scrbl")))
;; (define scribblings '(("stxclass.scrbl")))
(define compile-omit-paths '("test.ss"))

24
collects/macro-debugger/stxclass/private/kws.ss
View File

@ -2,7 +2,6 @@
(require scheme/stxparam
(for-syntax scheme/base))
(provide pattern
union
...*
try
@ -15,13 +14,15 @@
current-expression
current-macro-name)
;; (define-syntax-class name SyntaxClassRHS)
;; (define-syntax-class (name id ...) SyntaxClassRHS)
;; (define-syntax-class name SyntaxClassDirective* SyntaxClassRHS*)
;; (define-syntax-class (name id ...) SyntaxClassDirective* SyntaxClassRHS*)
;; A SyntaxClassRHS is one of
;; A SCDirective is one of
;; #:description String
;; #:transparent
;; A SyntaxClassRHS is
;; (pattern Pattern PatternDirective ...)
;; (union SyntaxClassRHS ...)
;; syntax-class-id
;; A Pattern is one of
;; name:syntaxclass
@ -56,7 +57,6 @@
(raise-syntax-error #f "keyword used out of context" stx))))
(define-keyword pattern)
(define-keyword union)
(define-keyword ...*)
(define-keyword ...**)
@ -75,10 +75,15 @@
(define (current-macro-name)
(let ([expr (current-expression)])
(and expr
(syntax-case expr ()
(syntax-case expr (set!)
[(set! kw . _)
#'kw]
[(kw . _)
(identifier? #'kw)
#'kw]
[kw
(identifier? #'kw)
#'kw]
[_ #f]))))
;; A PatternParseResult is one of
@ -113,7 +118,8 @@
(let loop ([f1 frontier1] [f2 frontier2])
(cond [(and (null? f1) (null? f2))
;; FIXME: merge
(k x1 `(union ,p1 ,p2) #f frontier1)]
(let ([p (and p1 p2 (format "~a; or ~a" p1 p2))])
(k x1 p #f frontier1))]
[(and (pair? f1) (null? f2)) (go1)]
[(and (null? f1) (pair? f2)) (go2)]
[(and (pair? f1) (pair? f2))

72
collects/macro-debugger/stxclass/private/lib.ss
View File

@ -1,6 +1,7 @@
#lang scheme/base
(require "sc.ss"
"util.ss"
syntax/stx
syntax/kerncase
scheme/struct-info
@ -49,8 +50,8 @@
(define-syntax-class define-syntaxes-form
(pattern (kw:define-syntaxes-kw (var:identifier ...) rhs)))
(define-syntax-class definition-form
(union define-values-form
define-syntaxes-form))
(pattern :define-values-form)
(pattern :define-syntaxes-form))
(define-basic-syntax-class static
([datum 0] [value 0])
@ -123,7 +124,7 @@
[expr 1])
(lambda (x)
(let-values ([(ex1 ex2 defs vdefs sdefs exprs)
(head-local-expand-syntaxes x #f #t)])
(head-local-expand-and-categorize-syntaxes x #f #; #t)])
(list ex1 ex2 defs vdefs sdefs exprs))))
(define-basic-syntax-class internal-definitions
@ -135,72 +136,9 @@
[expr 1])
(lambda (x)
(let-values ([(ex1 ex2 defs vdefs sdefs exprs)
(head-local-expand-syntaxes x #t #f)])
(head-local-expand-and-categorize-syntaxes x #t #; #f)])
(list ex1 ex2 defs vdefs sdefs exprs))))
;; head-local-expand-syntaxes : syntax boolean boolean -> stxs ^ 6
;; Setting allow-def-after-expr? allows def/expr interleaving.
;; Setting need-expr? requires at least one expr to be present.
(define (head-local-expand-syntaxes x allow-def-after-expr? need-expr?)
(let ([intdef (syntax-local-make-definition-context)]
[ctx '(block)])
(let loop ([x x] [ex null] [defs null] [vdefs null] [sdefs null] [exprs null])
(cond [(stx-pair? x)
(let ([ee (local-expand (stx-car x)
ctx
(kernel-form-identifier-list)
intdef)])
(syntax-case ee (begin define-values define-syntaxes)
[(begin e ...)
(loop (append (syntax->list #'(e ...)) (stx-cdr x)) ex defs vdefs sdefs exprs)]
[(begin . _)
(raise-syntax-error #f "bad begin form" ee)]
[(define-values (var ...) rhs)
(andmap identifier? (syntax->list #'(var ...)))
(begin
(when (and (pair? exprs) (not allow-def-after-expr?))
(raise-syntax-error #f "definition after expression" ee))
(syntax-local-bind-syntaxes (syntax->list #'(var ...)) #f intdef)
(loop (stx-cdr x)
(cons ee ex)
(cons ee defs)
(cons ee vdefs)
sdefs
exprs))]
[(define-values . _)
(raise-syntax-error #f "bad define-values form" ee)]
[(define-syntaxes (var ...) rhs)
(andmap identifier? (syntax->list #'(var ...)))
(begin
(when (and (pair? exprs) (not allow-def-after-expr?))
(raise-syntax-error #f "definition after expression" ee))
(syntax-local-bind-syntaxes (syntax->list #'(var ...))
#'rhs
intdef)
(loop (stx-cdr x)
(cons ee ex)
(cons ee defs)
vdefs
(cons ee sdefs)
exprs))]
[(define-syntaxes . _)
(raise-syntax-error #f "bad define-syntaxes form" ee)]
[_
(loop (stx-cdr x)
(cons ee ex)
defs
vdefs
sdefs
(cons ee exprs))]))]
[(stx-null? x)
(let ([ex (reverse ex)])
(values ex
ex
(reverse defs)
(reverse vdefs)
(reverse sdefs)
(reverse exprs)))]))))
(define-syntax-rule (define-contract-stxclass name c)
(define-basic-syntax-class* (name)
([orig-stx 0])

75
collects/macro-debugger/stxclass/private/parse.ss
View File

@ -72,8 +72,12 @@
;; rhs->pks : RHS (listof SAttr) identifier -> (listof PK)
(define (rhs->pks rhs relsattrs main-var)
(match rhs
[(struct rhs:union (orig-stx attrs rhss))
(for*/list ([rhs rhss] [pk (rhs->pks rhs relsattrs main-var)]) pk)]
[(struct rhs:union (orig-stx attrs transparent? description patterns))
(for*/list ([rhs patterns] [pk (rhs-pattern->pks rhs relsattrs main-var)])
pk)]))
(define (rhs-pattern->pks rhs relsattrs main-var)
(match rhs
[(struct rhs:pattern (orig-stx attrs pattern decls remap sides))
(list (make-pk (list pattern)
(expr:convert-sides sides
@ -143,7 +147,7 @@
#:literals literals)])
(syntax-case rest ()
[(b)
(let* ([pattern (parse-pattern #'p decls)])
(let* ([pattern (parse-pattern #'p decls 0)])
(make-pk (list pattern)
(expr:convert-sides sides
(pattern-attrs pattern)
@ -202,6 +206,55 @@
#`(let-syntax ([failvar (make-rename-transformer (quote-syntax #,failid))])
(try failvar (expr ...))))))]))
(define (report-stxclass stxclass)
(and stxclass
(format "expected ~a"
(or (sc-description stxclass)
(sc-name stxclass)))))
(define (report-constants pairs? data literals)
(cond [pairs? #f]
[(null? data)
(format "expected ~a" (report-choices-literals literals))]
[(null? literals)
(format "expected ~a" (report-choices-data data))]
[else
(format "expected ~a; or ~a"
(report-choices-data data)
(report-choices-literals literals))]))
(define (report-choices-literals literals0)
(define literals
(sort (map syntax-e literals0)
string<?
#:key symbol->string
#:cache-keys? #t))
(case (length literals)
[(1) (format "the literal identifier ~s" (car literals))]
[else (format "one of the following literal identifiers: ~a"
(comma-list literals))]))
(define (report-choices-data data)
(case (length data)
[(1) (format "the datum ~s" (car data))]
[else (format "one of the following literals: ~a"
(comma-list data))]))
(define (comma-list items0)
(define items (for/list ([item items0]) (format "~s" item)))
(define (loop items)
(cond [(null? items)
null]
[(null? (cdr items))
(list ", or " (car items))]
[else
(list* ", " (car items) (loop (cdr items)))]))
(case (length items)
[(2) (format "~a or ~a" (car items) (cadr items))]
[else (let ([strings (list* (car items) (loop (cdr items)))])
(apply string-append strings))]))
;; parse:extpk : (listof identifier) (listof FC) ExtPK identifier -> stx
;; Pre: vars is not empty
(define (parse:extpk vars fcs extpk failid)
@ -217,7 +270,7 @@
(if (ok? r)
#,(parse:pks (cdr vars) (cdr fcs) (shift-pks:id pks #'r) failid)
#,(fail failid (car vars)
#:pattern (and stxclass (sc-name stxclass))
#:pattern (report-stxclass stxclass)
#:fc (car fcs)))))]
[(struct cpks (pairpks datumpkss literalpkss))
(with-syntax ([var0 (car vars)]
@ -270,13 +323,13 @@
#'())
[datum-test datum-rhs] ...
[else
#,(let ([ps #'(pair-pattern ... datum-pattern ...)])
(with-syntax ([ep (if (= (length (syntax->list ps)) 1)
(car (syntax->list ps))
#`(union #,@ps))])
(fail failid (car vars)
#:pattern #'ep
#:fc (car fcs))))]))))]
#,(fail failid (car vars)
#:pattern (report-constants (pair? pairpks)
(for/list ([d datumpkss])
(datumpks-datum d))
(for/list ([l literalpkss])
(literalpks-literal l)))
#:fc (car fcs))]))))]
#;
[(struct pk ((cons (struct pat:splice (orig-stx attrs depth head tail))
rest-ps)

109
collects/macro-debugger/stxclass/private/rep.ss
View File

@ -31,7 +31,7 @@
format-symbol)
;; An SC is one of (make-sc symbol (listof symbol) (list-of SAttr) identifier)
(define-struct sc (name inputs attrs parser-name)
(define-struct sc (name inputs attrs parser-name description)
#:property prop:procedure (lambda (self stx) (sc-parser-name self))
#:transparent)
@ -44,13 +44,19 @@
(define-struct attr (name depth inner)
#:transparent)
;; A RHS is one of
;; (make-rhs:union <RHS> (listof RHS))
;; (make-rhs:pattern <RHS> Pattern Env Env (listof SideClause))
;; where <RHS> is stx (listof SAttr)
(define-struct rhs (orig-stx attrs) #:transparent)
(define-struct (rhs:union rhs) (rhss) #:transparent)
(define-struct (rhs:pattern rhs) (pattern decls remap wheres) #:transparent)
;; RHSBase is stx (listof SAttr)
(define-struct rhs (orig-stx attrs)
#:transparent)
;; A RHS is
;; (make-rhs:union <RHSBase> (listof RHS))
(define-struct (rhs:union rhs) (transparent? description patterns)
#:transparent)
;; An RHSPattern is
;; (make-rhs:pattern <RHSBase> Pattern Env Env (listof SideClause))
(define-struct (rhs:pattern rhs) (pattern decls remap wheres)
#:transparent)
;; A Pattern is one of
;; (make-pat:id <Pattern> identifier SC/#f (listof stx))
@ -88,7 +94,7 @@
;; make-empty-sc : identifier => SC
;; Dummy stxclass for calculating attributes of recursive stxclasses.
(define (make-empty-sc name)
(make sc (syntax-e name) null null #f))
(make sc (syntax-e name) null null #f #f))
(define (iattr? a)
(and (attr? a) (identifier? (attr-name a))))
@ -101,8 +107,8 @@
[sattr? (any/c . -> . boolean?)]
[reorder-iattrs
((listof sattr?) (listof iattr?) (identifier? . -> . symbol?) . -> . (listof iattr?))]
[parse-rhs (syntax? boolean? . -> . rhs?)]
[parse-splice-rhs (syntax? boolean? . -> . rhs?)]
[parse-rhs (syntax? boolean? syntax? . -> . rhs?)]
[parse-splice-rhs (syntax? boolean? syntax? . -> . rhs?)]
[flatten-sattrs
([(listof sattr?)] [exact-integer? (or/c symbol? false/c)] . ->* . (listof sattr?))]
@ -208,25 +214,51 @@
(define allow-unbound-stxclasses (make-parameter #f))
;; parse-rhs : stx(SyntaxClassRHS) boolean -> RHS
;; parse-rhs : stx(SyntaxClassRHS) boolean stx -> RHS
;; If allow-unbound? is true, then unbound stxclass acts as if it has no attrs.
;; Used for pass1 (attr collection); parser requires stxclasses to be bound.
(define (parse-rhs stx allow-unbound?)
(parse-rhs* stx allow-unbound? #f))
(define (parse-rhs stx allow-unbound? ctx)
(parse-rhs* stx allow-unbound? #f ctx))
;; parse-splice-rhs : stx(SyntaxClassRHS) boolean -> RHS
;; parse-splice-rhs : stx(SyntaxClassRHS) boolean stx -> RHS
;; If allow-unbound? is true, then unbound stxclass acts as if it has no attrs.
;; Used for pass1 (attr collection); parser requires stxclasses to be bound.
(define (parse-splice-rhs stx allow-unbound?)
(parse-rhs* stx allow-unbound? #t))
(define (parse-splice-rhs stx allow-unbound? ctx)
(parse-rhs* stx allow-unbound? #t ctx))
;; parse-rhs* : stx boolean boolean -> RHS
(define (parse-rhs* stx allow-unbound? splice?)
(syntax-case stx (pattern union)
(define (parse-rhs* stx allow-unbound? splice? ctx)
(define-values (chunks rest)
(chunk-kw-seq stx rhs-directive-table #:context ctx))
(define lits (assq '#:literals chunks))
(define desc (assq '#:description chunks))
(define trans (assq '#:transparent chunks))
(define literals (if lits (caddr lits) null))
(define (gather-patterns stx)
(syntax-case stx (pattern)
[((pattern . _) . rest)
(cons (parse-rhs-pattern (stx-car stx) allow-unbound? splice? literals)
(gather-patterns #'rest))]
[()
null]))
(define patterns (gather-patterns rest))
(when (null? patterns)
(raise-syntax-error #f "syntax class has no variants" ctx))
(let ([sattrs (intersect-attrss (map rhs-attrs patterns) ctx)])
(make rhs:union stx sattrs
(and desc (caddr desc))
(and trans #t)
patterns)))
;; parse-rhs-pattern : stx boolean boolean (listof identifier) -> RHS
(define (parse-rhs-pattern stx allow-unbound? splice? literals)
(syntax-case stx (pattern)
[(pattern p . rest)
(parameterize ((allow-unbound-stxclasses allow-unbound?))
(let-values ([(rest decls remap clauses)
(parse-pattern-directives #'rest #:sc? #t)])
(parse-pattern-directives #'rest
#:literals literals
#:sc? #t)])
(unless (stx-null? rest)
(raise-syntax-error #f "unexpected terms after pattern directives"
(if (pair? rest) (car rest) rest)))
@ -241,25 +273,16 @@
(map pattern-attrs with-patterns))
stx)]
[sattrs (iattrs->sattrs attrs remap)])
(make rhs:pattern stx sattrs pattern decls remap clauses))))]
[(union p ...)
(let* ([rhss (for/list ([rhs (syntax->list #'(p ...))])
(parse-rhs* rhs allow-unbound? splice?))]
[sattrs (intersect-attrss (map rhs-attrs rhss) stx)])
(make rhs:union stx sattrs rhss))]
[(id arg ...)
(identifier? #'id)
(parse-rhs* (syntax/loc stx (pattern || #:declare || (id arg ...)))
allow-unbound?
splice?)]
[id
(identifier? #'id)
(parse-rhs* (syntax/loc stx (pattern || #:declare || id))
allow-unbound?
splice?)]))
(make rhs:pattern stx sattrs pattern decls remap clauses))))]))
;; rhs-directive-table
(define rhs-directive-table
(list (list '#:literals check-idlist)
(list '#:description check-string)
(list '#:transparent)))
;; parse-pattern : stx(Pattern) env number -> Pattern
(define (parse-pattern stx [decls (lambda _ #f)] [depth 0] [allow-splice? #f])
(define (parse-pattern stx decls depth [allow-splice? #f])
(syntax-case stx ()
[dots
(or (dots? #'dots)
@ -354,12 +377,6 @@
(raise-syntax-error 'pattern "expected sequence of patterns or sequence directive"
(if (pair? stx) (car stx) stx))]))
(define (check-nat/f stx)
(let ([d (syntax-e stx)])
(unless (nat/f d)
(raise-syntax-error #f "expected exact nonnegative integer or #f" stx))
stx))
(define head-directive-table
(list (list '#:min check-nat/f)
(list '#:max check-nat/f)
@ -369,7 +386,7 @@
(list '#:mand)))
(define (parse-heads-k stx heads heads-attrs heads-depth k)
(define-values (chunks rest) (chunk-kw-seq stx head-directive-table))
(define-values (chunks rest) (chunk-kw-seq/no-dups stx head-directive-table))
(reject-duplicate-chunks chunks)
(let* ([min-row (assq '#:min chunks)]
[max-row (assq '#:max chunks)]
@ -412,10 +429,6 @@
(and occurs-row (caddr occurs-row))
(and default-row (caddr default-row)))))
;; nat/f : any -> boolean
(define (nat/f x)
(or (not x) (exact-nonnegative-integer? x)))
;; append-attrs : (listof (listof IAttr)) stx -> (listof IAttr)
(define (append-attrs attrss stx)
(let* ([all (apply append attrss)]

49
collects/macro-debugger/stxclass/private/sc.ss
View File

@ -10,7 +10,6 @@
syntax/stx
"kws.ss")
(provide define-syntax-class
define-syntax-splice-class
define-basic-syntax-class
define-basic-syntax-class*
parse-sc
@ -24,7 +23,6 @@
with-patterns
pattern
union
...*
fail-sc
@ -35,27 +33,32 @@
(define-syntax (define-syntax-class stx)
(syntax-case stx ()
[(define-syntax-class (name arg ...) rhs)
#'(begin (define-syntax name
(make sc 'name
'(arg ...)
(rhs-attrs (parse-rhs (quote-syntax rhs) #t))
((syntax-local-certifier) #'parser)))
(define parser (rhs->parser name rhs (arg ...))))]
[(define-syntax-class name rhs)
#'(define-syntax-class (name) rhs)]))
[(define-syntax-class (name arg ...) . rhss)
#`(begin (define-syntax name
(let ([the-rhs (parse-rhs (quote-syntax rhss) #t (quote-syntax #,stx))])
(make sc 'name
'(arg ...)
(rhs-attrs the-rhs)
((syntax-local-certifier) #'parser)
(rhs:union-description the-rhs))))
(define parser (rhs->parser name rhss (arg ...) #,stx)))]
[(define-syntax-class name . rhss)
(syntax/loc stx
(define-syntax-class (name) . rhss))]))
#;
(define-syntax (define-syntax-splice-class stx)
(syntax-case stx ()
[(define-syntax-splice-class (name arg ...) rhs)
#'(begin (define-syntax name
[(define-syntax-splice-class (name arg ...) . rhss)
#`(begin (define-syntax name
(make ssc 'name
'(arg ...)
(rhs-attrs (parse-splice-rhs (quote-syntax rhs) #t))
(rhs-attrs
(parse-splice-rhs (quote-syntax rhss) #t (quote-syntax #,stx)))
((syntax-local-certifier) #'parser)))
(define parser (splice-rhs->parser name rhs (arg ...))))]
[(define-syntax-splice-class name rhs)
#'(define-syntax-splice-class (name) rhs)]))
(define parser (splice-rhs->parser name rhss (arg ...) #,stx)))]
[(define-syntax-splice-class name . rhss)
(syntax/loc stx (define-syntax-splice-class (name) . rhss))]))
(define-syntax define-basic-syntax-class
(syntax-rules ()
@ -89,12 +92,13 @@
(make sc 'name
'(arg ...)
(list (make-attr 'attr-name 'attr-depth null) ...)
((syntax-local-certifier) #'parser))))]))
((syntax-local-certifier) #'parser)
#f)))]))
(define-syntax (rhs->parser stx)
(syntax-case stx ()
[(rhs->parser name rhs (arg ...))
(let ([rhs (parse-rhs #'rhs #f)]
[(rhs->parser name rhss (arg ...) ctx)
(let ([rhs (parse-rhs #'rhss #f #'ctx)]
[sc (syntax-local-value #'name)])
(parse:rhs rhs
(sc-attrs sc)
@ -182,7 +186,7 @@
[_
(err "expected end of list" x)])]
[expected
(err (format "expected ~s~a"
(err (format "~a~a"
expected
(cond [(zero? n) ""]
[(= n +inf.0) " after matching main pattern"]
@ -204,3 +208,6 @@
(define (fail-sc stx #:pattern [pattern #f] #:reason [reason #f])
(make-failed stx pattern reason))
(define (syntax-class-fail stx #:reason [reason #f])
(make-failed stx #f reason))

143
collects/macro-debugger/stxclass/private/util.ss
View File

@ -3,37 +3,22 @@
(require (for-syntax scheme/base
scheme/struct-info)
syntax/boundmap
syntax/kerncase
syntax/stx)
(provide make
chunk-kw-seq/no-dups
chunk-kw-seq
reject-duplicate-chunks
check-id
#|
monomap?
monomap-get
monomap-put!
monomap-map
monomap-for-each
monomap-domain
monomap-range
check-nat/f
check-string
check-idlist
isomap?
isomap-get
isomap-reverse-get
isomap-put!
isomap-map
isomap-for-each
isomap-domain
isomap-range
make-bound-id-monomap
make-free-id-monomap
make-hash-monomap
(rename-out [-make-isomap make-isomap])
|#
)
head-local-expand-and-categorize-syntaxes
categorize-expanded-syntaxes
head-local-expand-syntaxes)
(define-syntax (make stx)
(syntax-case stx ()
@ -80,7 +65,8 @@
[arity (cdr (assq kw-value kws))]
[args+rest (stx-split #'more arity)])
(if args+rest
(loop (cdr args+rest) (cons (list* kw-value #'kw (car args+rest)) rchunks))
(loop (cdr args+rest)
(cons (list* kw-value #'kw (car args+rest)) rchunks))
(raise-syntax-error #f "too few arguments for keyword" #'kw ctx)))]
[(kw . more)
(keyword? (syntax-e #'kw))
@ -90,13 +76,14 @@
(loop stx null))
(define (reject-duplicate-chunks chunks #:context [ctx #f])
(define kws (make-hasheq))
(define (loop chunks)
(when (pair? chunks)
(let* ([kw (caar chunks)]
[dup (assq kw (cdr chunks))])
(when dup
(raise-syntax-error #f "duplicate keyword argument" (cadr dup) ctx))
(loop (cdr chunks)))))
(let ([kw (caar chunks)])
(when (hash-ref kws kw #f)
(raise-syntax-error #f "duplicate keyword argument" (cadar chunks) ctx))
(hash-set! kws kw #t))
(loop (cdr chunks))))
(loop chunks))
;; stx-split : stx nat -> (cons (listof stx) stx)
@ -115,6 +102,104 @@
(raise-syntax-error 'pattern "expected identifier" stx))
stx)
(define (check-string stx)
(unless (string? (syntax-e stx))
(raise-syntax-error #f "expected string" stx))
stx)
;; nat/f : any -> boolean
(define (nat/f x)
(or (not x) (exact-nonnegative-integer? x)))
(define (check-nat/f stx)
(let ([d (syntax-e stx)])
(unless (nat/f d)
(raise-syntax-error #f "expected exact nonnegative integer or #f" stx))
stx))
(define (check-idlist stx)
(unless (and (stx-list? stx) (andmap identifier? (stx->list stx)))
(raise-syntax-error #f "expected list of identifiers" stx))
(stx->list stx))
;; head-local-expand-syntaxes : syntax boolean boolean -> stxs ^ 6
;; Setting allow-def-after-expr? allows def/expr interleaving.
(define (head-local-expand-and-categorize-syntaxes x allow-def-after-expr?)
(define estxs (head-local-expand-syntaxes x allow-def-after-expr?))
(define-values (defs vdefs sdefs exprs)
(categorize-expanded-syntaxes estxs))
(values estxs estxs defs vdefs sdefs exprs))
(define (categorize-expanded-syntaxes estxs0)
(let loop ([estxs estxs0] [defs null] [vdefs null] [sdefs null] [exprs null])
(cond [(pair? estxs)
(let ([ee (car estxs)])
(syntax-case ee (begin define-values define-syntaxes)
[(define-values . _)
(loop (cdr estxs)
(cons ee defs)
(cons ee vdefs)
sdefs
exprs)]
[(define-syntaxes (var ...) rhs)
(loop (cdr estxs)
(cons ee defs)
vdefs
(cons ee sdefs)
exprs)]
[_
(loop (cdr estxs)
defs
vdefs
sdefs
(cons ee exprs))]))]
[(null? estxs)
(values (reverse defs)
(reverse vdefs)
(reverse sdefs)
(reverse exprs))])))
;; head-local-expand-syntaxes : syntax boolean -> (listof syntax)
(define (head-local-expand-syntaxes x allow-def-after-expr?)
(let ([intdef (syntax-local-make-definition-context)]
[ctx '(block)])
(let loop ([x x] [ex null] [expr? #f])
(cond [(stx-pair? x)
(let ([ee (local-expand (stx-car x)
ctx
(kernel-form-identifier-list)
intdef)])
(syntax-case ee (begin define-values define-syntaxes)
[(begin e ...)
(loop (append (syntax->list #'(e ...)) (stx-cdr x)) ex expr?)]
[(begin . _)
(raise-syntax-error #f "bad begin form" ee)]
[(define-values (var ...) rhs)
(andmap identifier? (syntax->list #'(var ...)))
(begin
(when (and expr? (not allow-def-after-expr?))
(raise-syntax-error #f "definition after expression" ee))
(syntax-local-bind-syntaxes (syntax->list #'(var ...)) #f intdef)
(loop (stx-cdr x) (cons ee ex) expr?))]
[(define-values . _)
(raise-syntax-error #f "bad define-values form" ee)]
[(define-syntaxes (var ...) rhs)
(andmap identifier? (syntax->list #'(var ...)))
(begin
(when (and expr? (not allow-def-after-expr?))
(raise-syntax-error #f "definition after expression" ee))
(syntax-local-bind-syntaxes (syntax->list #'(var ...))
#'rhs
intdef)
(loop (stx-cdr x) (cons ee ex) expr?))]
[(define-syntaxes . _)
(raise-syntax-error #f "bad define-syntaxes form" ee)]
[_
(loop (stx-cdr x) (cons ee ex) #t)]))]
[(stx-null? x)
(reverse ex)]))))
#|
;; Mappings

62
collects/macro-debugger/stxclass/stxclass.scrbl
View File

@ -2,14 +2,14 @@
@(require scribble/manual
scribble/struct
(for-label stxclass/stxclass))
(for-label macro-debugger/stxclass/stxclass))
@title{Parsing Syntax and Syntax Classes}
@defmodule[stxclass/stxclass]
@defmodule[macro-debugger/stxclass/stxclass]
@section{Parsing Syntax}
@declare-exporting[stxclass/stxclass]
@declare-exporting[macro-debugger/stxclass/stxclass]
@defform/subs[(syntax-parse stx-expr maybe-literals clause ...)
([maybe-literals code:blank
@ -222,7 +222,7 @@ generalized sequences. It may not be used as an expression.
}
@section{Syntax Classes}
@declare-exporting[stxclass/stxclass]
@declare-exporting[macro-debugger/stxclass/stxclass]
Syntax classes provide an abstraction mechanism for the specification
of syntax. Basic syntax classes include @scheme[identifier] and
@ -239,30 +239,43 @@ syntax. While the values of the attributes depend on the matched
syntax, the set of attributes and each attribute's ellipsis nesting
depth is fixed for each syntax class.
@defform*/subs[#:literals (union pattern)
[(define-syntax-class name-id stxclass-body)
(define-syntax-class (name-id arg-id ...) stxclass-body)]
([stxclass-body
(union stxclass-body ...)
@defform*/subs[#:literals (pattern)
[(define-syntax-class name-id stxclass-option ...
stxclass-variant ...)
(define-syntax-class (name-id arg-id ...) stxclass-option ...
stxclass-variant ...)]
([stxclass-options
(code:line #:description string)
(code:line #:transparent)]
[stxclass-variant
(pattern syntax-pattern pattern-directive ...)])]{
Defines @scheme[name-id] as a syntax class. When the @scheme[arg-id]s
are present, they are bound as variables (not pattern variables) in
the body.
The body of the syntax-class definition specifies the syntax it
accepts and determines the attributes it provides.
The body of the syntax-class definition contains one or more variants
that specify the syntax it accepts and determines the attributes it
provides. The syntax class provides only those attributes which are
present in every variant. Each such attribute must be defined with the
same ellipsis nesting depth and the same sub-attributes in each
component.
@specsubform[#:literals (union)
(union stxclass-body ...)]{
@specsubform[(code:line #:description string)]{
Accepts any syntax accepted by one of the component bodies.
Provides only those attributes which are present in every component
body. Each such attribute must be defined with the same ellipsis
nesting depth and the same sub-attributes in each component.
Specifies a string to use in error messages involving the syntax
class. For example, if a term is rejected by the syntax class, an
error of the form @scheme["expected <description>"] may be generated.
If absent, the name of the syntax class is used instead.
}
@specsubform[#:transparent]{
Indicates that errors may be reported with respect to the internal
structure of the syntax class.
}
@specsubform/subs[#:literals (pattern)
(pattern syntax-pattern pattern-directive ...)
([stxclass-pattern-directive
@ -320,17 +333,12 @@ match only proper lists:
}
@deftogether[(
@defidform[union]
@defidform[pattern]
)]{
Keywords recognized by @scheme[define-syntax-class]. They may not be
used as expressions.
@defidform[pattern]{
Keyword recognized by @scheme[define-syntax-class]. It may not be
used as an expression.
}
@defform[(define-basic-syntax-class (name-id arg-id ...)
([attr-id attr-depth] ...)
parser-expr)]{
@ -390,7 +398,7 @@ the @scheme[arg-expr]s) on the syntax object produced by
@section{Library syntax classes}
@declare-exporting[stxclass/stxclass]
@declare-exporting[macro-debugger/stxclass/stxclass]
@(define-syntax-rule (defstxclass name . pre-flows)
(defidform name . pre-flows))

32
collects/planet/lang/reader.ss
View File

@ -3,10 +3,12 @@
(require "../parsereq.ss"
syntax/readerr)
(provide (rename-out [planet-read read]
[planet-read-syntax read-syntax]))
(define (planet-read-fn in read-sym args src mod line col pos)
(provide (rename-out [planet-read read]
[planet-read-syntax read-syntax])
get-info)
(define (planet-get in lang-mod export-sym src line col pos mk-fail-thunk)
(let ([spec (regexp-try-match #px"^(.*?)(\\s|$)" in)]
[bad (lambda (str eof?)
((if eof?
@ -24,17 +26,27 @@
(let ([parsed-spec
(let ([str (bytes->string/latin-1 (cadr spec))])
(if (module-path? `(planet ,(string->symbol str)))
`(planet ,(string->symbol (string-append str "/lang/reader")))
`(planet ,(string->symbol (string-append str lang-mod)))
#f))])
(if parsed-spec
(let ([r (dynamic-require parsed-spec read-sym)])
(if (and (procedure? r)
(procedure-arity-includes? r (+ 5 (length args))))
(apply r (append args
(list in mod line col pos)))
(apply r (append args (list in)))))
(dynamic-require parsed-spec export-sym (mk-fail-thunk spec))
(bad (cadr spec) #f))))))
(define (get-info in mod line col pos)
(planet-get in "/lang/langinfo" 'get-info (object-name in) line col pos
(lambda (spec) (lambda () (lambda (tag) #f)))))
(define (planet-read-fn in read-sym args src mod line col pos)
(let ([r (planet-get in "/lang/reader" read-sym src mod line col pos
(lambda (spec)
(lambda ()
(error 'planet "cannot find reader for `#lang planet ~a'" spec))))])
(if (and (procedure? r)
(procedure-arity-includes? r (+ 5 (length args))))
(apply r (append args
(list in mod line col pos)))
(apply r (append args (list in))))))
(define (planet-read inp mod line col pos)
(planet-read-fn inp 'read null (object-name inp) mod line col pos))

296
collects/redex/private/rg-test.ss
View File

@ -8,8 +8,6 @@
(reset-count)
;; to-table : hash-table -> assoc
;; extracts the hash-table's mapping in a deterministic way
(define (to-table ht)
@ -58,14 +56,6 @@
(test (min-prods (car (compiled-lang-lang lang)) (find-base-cases lang))
(list (car (nt-rhs (car (compiled-lang-lang lang)))))))
(let ()
(define-language lang
(a (side-condition "strin_g" #t) 1/2 #t))
(let* ([literals (sort (lang-literals lang) string<=?)]
[chars (sort (unique-chars literals) char<=?)])
(test literals '("1/2" "side-condition" "strin_g"))
(test chars '(#\- #\/ #\1 #\2 #\c #\d #\e #\g #\i #\n #\o #\r #\s #\t))))
(define (make-random nums)
(let ([nums (box nums)])
(λ (m)
@ -77,31 +67,23 @@
(test (pick-length (make-random '(1 1 1 0))) 3)
(let ()
(define-language lang
(a bcd cbd))
(let* ([lits (sort (lang-literals lang) string<=?)]
[chars (sort (unique-chars lits) char<=?)])
(test (pick-char 0 chars (make-random '(1))) #\c)
(test (pick-char 50 chars (make-random '(1 1))) #\c)
(test (pick-char 50 chars (make-random '(0 65))) #\a)
(test (pick-char 500 chars (make-random '(0 1 65))) #\a)
(test (pick-char 500 chars (make-random '(0 0 3))) #\⇒)
(test (pick-char 2000 chars (make-random '(0 0 1 3))) #\⇒)
(test (pick-char 2000 chars (make-random '(0 0 0 1))) (integer->char #x4E01))
(test (pick-char 50 chars (make-random `(0 ,(- (char->integer #\_) #x20)))) #\`)
(test (random-string chars lits 3 0 (make-random '(0 1))) "cbd")
(test (random-string chars lits 3 0 (make-random '(1 2 1 0))) "dcb")
(test (pick-string chars lits 0 (make-random '(1 1 1 0 1 2 1 0))) "dcb")
(test (pick-var chars lits null 0 (make-random '(0 0 1 1 2 1 0))) 'dcb)
(test (pick-var chars lits '(x) 0 (make-random '(1 0))) 'x)))
(let ()
(define-language empty)
(let* ([lits (sort (lang-literals empty) string<=?)]
[chars (sort (unique-chars lits) char<=?)])
(test (pick-char 0 chars (make-random '(65))) #\a)
(test (random-string chars lits 1 0 (make-random '(65))) "a")))
(let* ([lits '("bcd" "cbd")]
[chars (sort (unique-chars lits) char<=?)])
(test (pick-char 0 chars (make-random '(1))) #\c)
(test (pick-char 50 chars (make-random '(1 1))) #\c)
(test (pick-char 50 chars (make-random '(0 65))) #\a)
(test (pick-char 500 chars (make-random '(0 1 65))) #\a)
(test (pick-char 500 chars (make-random '(0 0 3))) #\⇒)
(test (pick-char 2000 chars (make-random '(0 0 1 3))) #\⇒)
(test (pick-char 2000 chars (make-random '(0 0 0 1))) (integer->char #x4E01))
(test (pick-char 50 chars (make-random `(0 ,(- (char->integer #\_) #x20)))) #\`)
(test (random-string chars lits 3 0 (make-random '(0 1))) "cbd")
(test (random-string chars lits 3 0 (make-random '(1 2 1 0))) "dcb")
(test (pick-string chars lits 0 (make-random '(1 1 1 0 1 2 1 0))) "dcb")
(test (pick-var chars lits null 0 (make-random '(0 0 1 1 2 1 0))) 'dcb)
(test (pick-var chars lits '(x) 0 (make-random '(1 0))) 'x)
(test (pick-char 0 null (make-random '(65))) #\a)
(test (random-string null null 1 0 (make-random '(65))) "a"))
(define-syntax exn:fail-message
(syntax-rules ()
@ -152,7 +134,7 @@
;; Generate (λ (x) x)
(test
(generate
(generate/decisions
lc e 1 0
(decisions #:var (list (λ _ 'x) (λ _'x))
#:nt (patterns third first first first)))
@ -160,15 +142,15 @@
;; Generate pattern that's not a non-terminal
(test
(generate
lc (x_1 x_1) 1 0
(decisions #:var (list (λ _ 'x))))
'(x x))
(generate/decisions
lc (x x x_1 x_1) 1 0
(decisions #:var (list (λ _ 'x) (λ _ 'y))))
'(x x y y))
;; Minimum rhs is chosen with zero size
(test
(let/ec k
(generate
(generate/decisions
lc e 0 0
(decisions #:nt (list (λ (prods . _) (k (map rhs-pattern prods)))))))
'(x))
@ -177,7 +159,7 @@
(let ([size 5])
(test
(let/ec k
(generate
(generate/decisions
lc e size 0
(decisions #:nt (list (λ (prods . _) (cadr prods)) (λ (p b s) (k s))))))
(sub1 size))))
@ -192,7 +174,7 @@
(let* ([x null]
[prepend! (λ (c l b a) (begin (set! x (cons (car b) x)) 'x))])
(test (begin
(generate lang a 5 0 (decisions #:var (list (λ _ 'x) prepend! prepend!)))
(generate/decisions lang a 5 0 (decisions #:var (list (λ _ 'x) prepend! prepend!)))
x)
'(x x))))
@ -203,7 +185,7 @@
(x (variable-except λ)))
(test
(exn:fail-message
(generate
(generate/decisions
postfix e 2 0
(decisions #:var (list (λ _ 'x) (λ _ 'y))
#:nt (patterns third second first first))))
@ -214,7 +196,7 @@
(define-language var
(e (variable-except x y)))
(test
(generate
(generate/decisions
var e 2 0
(decisions #:var (list (λ _ 'x) (λ _ 'y) (λ _ 'x) (λ _ 'z))))
'z))
@ -231,25 +213,25 @@
(n number)
(z 4))
(test
(generate
(generate/decisions
lang a 2 0
(decisions #:num (build-list 3 (λ (n) (λ (_) n)))
#:seq (list (λ () 2) (λ () 3) (λ () 1))))
`(0 1 2 "foo" "foo" "foo" "bar" #t))
(test (generate lang b 5 0 (decisions #:seq (list (λ () 0))))
(test (generate/decisions lang b 5 0 (decisions #:seq (list (λ () 0))))
null)
(test (generate lang c 5 0 (decisions #:seq (list (λ () 0))))
(test (generate/decisions lang c 5 0 (decisions #:seq (list (λ () 0))))
null)
(test (generate lang d 5 0 (decisions #:seq (list (λ () 2))))
(test (generate/decisions lang d 5 0 (decisions #:seq (list (λ () 2))))
'(4 4 4 4 (4 4) (4 4)))
(test (exn:fail-message (generate lang e 5 0))
(test (exn:fail-message (generate lang e 5))
#rx"generate: unable to generate pattern \\(n_1 ..._!_1 n_2 ..._!_1 \\(n_1 n_2\\) ..._3\\)")
(test (generate lang f 5 0 (decisions #:seq (list (λ () 0)))) null)
(test (generate lang ((0 ..._!_1) ... (1 ..._!_1) ...) 5 0
(test (generate/decisions lang f 5 0 (decisions #:seq (list (λ () 0)))) null)
(test (generate/decisions lang ((0 ..._!_1) ... (1 ..._!_1) ...) 5 0
(decisions #:seq (list (λ () 2) (λ () 3) (λ () 4) (λ () 2) (λ () 3) (λ () 4)
(λ () 2) (λ () 3) (λ () 4) (λ () 1) (λ () 3))))
'((0 0 0) (0 0 0 0) (1 1 1)))
(test (generate lang ((0 ..._!_1) ... (1 ..._!_1) ...) 5 0
(test (generate/decisions lang ((0 ..._!_1) ... (1 ..._!_1) ...) 5 0
(decisions #:seq (list (λ () 2) (λ () 3) (λ () 4) (λ () 2) (λ () 3) (λ () 5))))
'((0 0 0) (0 0 0 0) (1 1 1) (1 1 1 1 1))))
@ -263,7 +245,7 @@
;; x and y bound in body
(test
(let/ec k
(generate
(generate/decisions
lc e 10 0
(decisions #:var (list (λ _ 'x) (λ _ 'y) (λ (c l b a) (k b)))
#:nt (patterns first first first third first)
@ -273,7 +255,7 @@
(let ()
(define-language lang (e (variable-prefix pf)))
(test
(generate
(generate/decisions
lang e 5 0
(decisions #:var (list (λ _ 'x))))
'pfx))
@ -287,7 +269,7 @@
(define-language lang
(e number (e_1 e_2 e e_1 e_2)))
(test
(generate
(generate/decisions
lang e 5 0
(decisions #:nt (patterns second first first first)
#:num (list (λ _ 2) (λ _ 3) (λ _ 4))))
@ -299,7 +281,7 @@
(x variable))
(test
(let/ec k
(generate
(generate/decisions
lang e 5 0
(decisions #:var (list (λ _ 'x) (λ (c l b a) (k b))))))
'(x)))
@ -310,29 +292,30 @@
(b (c_!_1 c_!_1 c_!_1))
(c 1 2))
(test
(generate
(generate/decisions
lang a 5 0
(decisions #:num (list (λ _ 1) (λ _ 1) (λ _ 1) (λ _ 1) (λ _ 1) (λ _ 2))))
'(1 1 2))
(test
(generate
(generate/decisions
lang (number_!_1 number_!_2 number_!_1) 5 0
(decisions #:num (list (λ _ 1) (λ _ 1) (λ _ 1) (λ _ 1) (λ _ 1) (λ _ 2))))
'(1 1 2))
(test
(exn:fail-message (generate lang b 5000 0))
(exn:fail-message (generate lang b 5000))
#rx"unable"))
(let ()
(define-language lang
(e string))
(e string)
(f foo bar))
(test
(let/ec k
(generate
(generate/decisions
lang e 5 0
(decisions #:str (list (λ (c l a) (k (cons (sort c char<=?) (sort l string<=?))))))))
(cons '(#\g #\i #\n #\r #\s #\t)
'("string"))))
(cons '(#\a #\b #\f #\o #\r)
'("bar" "foo"))))
(let ()
(define-language lang
@ -342,27 +325,28 @@
(d (side-condition (x_1 x_1 x) (not (eq? (term x_1) 'x))) #:binds x_1 x)
(e (side-condition (x_1 x_!_2 x_!_2) (not (eq? (term x_1) 'x))))
(x variable))
(test (generate lang b 5 0) 43)
(test (exn:fail-message (generate lang c 5 0))
(test (generate lang b 5) 43)
(test (generate lang (side-condition a (odd? (term a))) 5) 43)
(test (exn:fail-message (generate lang c 5))
#rx"unable to generate")
(test ; binding works for with side-conditions failure/retry
(let/ec k
(generate
(generate/decisions
lang d 5 0
(decisions #:var (list (λ _ 'x) (λ _ 'x) (λ _ 'y) (λ (c l b a) (k b))))))
'(y))
(test ; mismatch patterns work with side-condition failure/retry
(generate
(generate/decisions
lang e 5 0
(decisions #:var (list (λ _ 'x) (λ _ 'x) (λ _ 'y) (λ _ 'y) (λ _ 'x) (λ _ 'y))))
'(y x y))
(test ; generate compiles side-conditions in pattern
(generate lang (side-condition x_1 (not (eq? (term x_1) 'x))) 5 0
(generate/decisions lang (side-condition x_1 (not (eq? (term x_1) 'x))) 5 0
(decisions #:var (list (λ _ 'x) (λ _ 'y))))
'y)
(test ; bindings within ellipses collected properly
(let/ec k
(generate lang (side-condition (((number_1 3) ...) ...) (k (term ((number_1 ...) ...)))) 5 0
(generate/decisions lang (side-condition (((number_1 3) ...) ...) (k (term ((number_1 ...) ...)))) 5 0
(decisions #:seq (list (λ () 2) (λ () 3) (λ () 4))
#:num (build-list 7 (λ (n) (λ (_) n))))))
'((0 1 2) (3 4 5 6))))
@ -374,9 +358,9 @@
(c (side-condition (name x d) (zero? (term x))))
(d 2 1 0)
(e ((side-condition (name d_1 d) (zero? (term d_1))) d_1)))
(test (generate lang a 5 0) 4)
(test (generate lang c 5 0) 0)
(test (generate lang e 5 0) '(0 0)))
(test (generate lang a 5) 4)
(test (generate lang c 5) 0)
(test (generate lang e 5) '(0 0)))
(let ()
(define-language lang
@ -394,28 +378,28 @@
(y variable))
(test
(generate
(generate/decisions
lang (in-hole A number ) 5 0
(decisions
#:nt (patterns second second first first third first second first first)
#:num (build-list 5 (λ (x) (λ (_) x)))))
'(+ (+ 1 2) (+ 0 (+ 3 4))))
(test (generate lang (in-hole (in-hole (1 hole) hole) 5) 5 0) '(1 5))
(test (generate lang (hole 4) 5 0) (term (hole 4)))
(test (generate lang (variable_1 (in-hole C variable_1)) 5 0
(test (generate lang (in-hole (in-hole (1 hole) hole) 5) 5) '(1 5))
(test (generate lang (hole 4) 5) (term (hole 4)))
(test (generate/decisions lang (variable_1 (in-hole C variable_1)) 5 0
(decisions #:var (list (λ _ 'x) (λ _ 'y) (λ _ 'x))))
'(x x))
(test (generate lang (variable_!_1 (in-hole C variable_!_1)) 5 0
(test (generate/decisions lang (variable_!_1 (in-hole C variable_!_1)) 5 0
(decisions #:var (list (λ _ 'x) (λ _ 'x) (λ _ 'x) (λ _ 'y))))
'(x y))
(test (let/ec k (generate lang d 5 0 (decisions #:var (list (λ _ 'x) (λ (c l b a) (k b))))))
(test (let/ec k (generate/decisions lang d 5 0 (decisions #:var (list (λ _ 'x) (λ (c l b a) (k b))))))
'(x))
(test (generate lang e 5 0 (decisions #:num (list (λ _ 1) (λ _ 2))))
(test (generate/decisions lang e 5 0 (decisions #:num (list (λ _ 1) (λ _ 2))))
'((2 (1 1)) 1))
(test (generate lang g 5 0 (decisions #:num (list (λ _ 1) (λ _ 2) (λ _ 1) (λ _ 0))))
(test (generate/decisions lang g 5 0 (decisions #:num (list (λ _ 1) (λ _ 2) (λ _ 1) (λ _ 0))))
'(1 0))
(test (generate lang h 5 0 (decisions #:num (list (λ _ 1) (λ _ 2) (λ _ 3))))
(test (generate/decisions lang h 5 0 (decisions #:num (list (λ _ 1) (λ _ 2) (λ _ 3))))
'((2 ((3 (2 1)) 3)) 1)))
(let ()
@ -423,7 +407,7 @@
(e (e e) (+ e e) x v)
(v (λ (x) e) number)
(x variable-not-otherwise-mentioned))
(test (generate lc x 5 0 (decisions #:var (list (λ _ 'λ) (λ _ '+) (λ _ 'x))))
(test (generate/decisions lc x 5 0 (decisions #:var (list (λ _ 'λ) (λ _ '+) (λ _ 'x))))
'x))
(let ()
@ -436,8 +420,8 @@
(list four 'f))
(test (call-with-values (λ () (pick-any four (make-random (list 1)))) list)
(list sexp 'sexp))
(test (generate four any 5 0 (decisions #:any (list (λ _ (values four 'e))))) 4)
(test (generate four any 5 0
(test (generate/decisions four any 5 0 (decisions #:any (list (λ _ (values four 'e))))) 4)
(test (generate/decisions four any 5 0
(decisions #:any (list (λ _ (values sexp 'sexp)))
#:nt (patterns fifth second second second)
#:seq (list (λ _ 3))
@ -448,7 +432,7 @@
(let ()
(define-language lang
(e (hide-hole (in-hole ((hide-hole hole) hole) 1))))
(test (generate lang e 5 0) (term (hole 1))))
(test (generate lang e 5) (term (hole 1))))
(define (output-error-port thunk)
(let ([port (open-output-string)])
@ -462,66 +446,105 @@
(e x (e e) v)
(v (λ (x) e))
(x variable-not-otherwise-mentioned))
(test (generate lang (cross e) 3 0
(test (generate/decisions lang (cross e) 3 0
(decisions #:nt (patterns fourth first first second first first first)
#:var (list (λ _ 'x) (λ _ 'y))))
(term (λ (x) (hole y)))))
;; current-error-port-output : (-> (-> any) string)
(define (current-error-port-output thunk)
(let ([p (open-output-string)])
(parameterize ([current-error-port p])
(thunk))
(begin0
(get-output-string p)
(close-output-port p))))
(let ()
(define-language lang
(d 5)
(e e 4))
(test (check lang () 2 0 #f) "failed after 1 attempts: ()")
(test (check lang () 2 0 #t) #t)
(test (check lang ([x d] [y e]) 2 0 (and (eq? (term x) 5) (eq? (term y) 4))) #t)
(test (check lang ([x d] [y e]) 2 0 #f) "failed after 1 attempts: ((x 5) (y 4))")
(test (exn:fail-message (check lang ([x d]) 2 0 (error 'pred-raised)))
#rx"term \\(\\(x 5\\)\\) raises"))
(test (current-error-port-output (λ () (check lang d 2 0 #f)))
"failed after 1 attempts: 5")
(test (check lang d 2 0 #t) #t)
(test (check lang (d e) 2 0 (and (eq? (term d) 5) (eq? (term e) 4))) #t)
(test (check lang (d ...) 2 0 (zero? (modulo (foldl + 0 (term (d ...))) 5))) #t)
(test (current-error-port-output (λ () (check lang (d e) 2 0 #f)))
"failed after 1 attempts: (5 4)")
(test (exn:fail-message (check lang d 2 0 (error 'pred-raised)))
#rx"term 5 raises"))
;; parse/unparse-pattern
(let-syntax ([test-match (syntax-rules () [(_ p x) (test (match x [p #t] [_ #f]) #t)])])
(let ([pattern '((x_1 x_2) ... 3)])
(test-match (list (struct ellipsis ('... '(x_1 x_2) _ '(x_2 x_1))) 3)
(parse-pattern pattern))
(test (unparse-pattern (parse-pattern pattern)) pattern))
(let ([pattern '((x_1 ..._1 x_2) ..._!_1)])
(test-match (struct ellipsis
((struct mismatch (i_1 '..._!_1))
(list (struct ellipsis ('..._1 'x_1 (struct class ('..._1)) '(x_1))) 'x_2)
_ `(x_2 ..._1 ,(struct class ('..._1)) x_1)))
(car (parse-pattern pattern)))
(test (unparse-pattern (parse-pattern pattern)) pattern))
(let ([pattern '((name x_1 x_!_2) ...)])
(test-match (struct ellipsis
('... `(name x_1 ,(struct mismatch (i_2 'x_!_2))) _
(list 'x_1 (struct mismatch (i_2 'x_!_2)))))
(car (parse-pattern pattern)))
(test (unparse-pattern (parse-pattern pattern)) pattern))
(let ([pattern '((x_1 ...) ..._1)])
(test-match (struct ellipsis
('..._1
(list (struct ellipsis ('... 'x_1 (struct class (c_1)) '(x_1))))
_
`(,(struct class (c_1)) x_1)))
(car (parse-pattern pattern)))
(test (unparse-pattern (parse-pattern pattern)) pattern))
(let ([pattern '((x_1 ..._!_1) ...)])
(test-match (struct ellipsis
('...
(list
(struct ellipsis ((struct mismatch (i_1 '..._!_1)) 'x_1 (struct class (c_1)) '(x_1))))
_
(list (struct class (c_1)) (struct mismatch (i_1 '..._!_1)) 'x_1)))
(car (parse-pattern pattern)))
(test (unparse-pattern (parse-pattern pattern)) pattern)
(test (parse-pattern '(cross e)) '(cross e-e))
(test (parse-pattern '(cross e) #t) '(cross e))))
(define-language lang (x variable))
(let ([pattern '((x_1 number) ... 3)])
(test-match (list
(struct ellipsis
('...
(list (struct binder ('x_1)) (struct binder ('number)))
_
(list (struct binder ('number)) (struct binder ('x_1)))))
3)
(parse-pattern pattern lang 'top-level))
(test (unparse-pattern (parse-pattern pattern lang 'top-level)) pattern))
(let ([pattern '((x_1 ..._1 x_2) ..._!_1)])
(test-match (struct ellipsis
((struct mismatch (i_1 '..._!_1))
(list
(struct ellipsis
('..._1
(struct binder ('x_1))
(struct class ('..._1))
(list (struct binder ('x_1)))))
(struct binder ('x_2)))
_
(list (struct binder ('x_2)) '..._1 (struct class ('..._1)) (struct binder ('x_1)))))
(car (parse-pattern pattern lang 'grammar)))
(test (unparse-pattern (parse-pattern pattern lang 'grammar)) pattern))
(let ([pattern '((name x_1 x_!_2) ...)])
(test-match (struct ellipsis
('... `(name x_1 ,(struct mismatch (i_2 'x_!_2))) _
(list (struct binder ('x_1)) (struct mismatch (i_2 'x_!_2)))))
(car (parse-pattern pattern lang 'grammar)))
(test (unparse-pattern (parse-pattern pattern lang 'grammar)) pattern))
(let ([pattern '((x ...) ..._1)])
(test-match (struct ellipsis
('..._1
(list
(struct ellipsis
('...
(struct binder ('x))
(struct class (c_1))
(list (struct binder ('x))))))
_
(list (struct class (c_1)) (struct binder ('x)))))
(car (parse-pattern pattern lang 'top-level)))
(test (unparse-pattern (parse-pattern pattern lang 'top-level)) pattern))
(let ([pattern '((variable_1 ..._!_1) ...)])
(test-match (struct ellipsis
('...
(list
(struct ellipsis
((struct mismatch (i_1 '..._!_1))
(struct binder ('variable_1))
(struct class (c_1))
(list (struct binder ('variable_1))))))
_
(list (struct class (c_1)) (struct mismatch (i_1 '..._!_1)) (struct binder ('variable_1)))))
(car (parse-pattern pattern lang 'grammar)))
(test (unparse-pattern (parse-pattern pattern lang 'grammar)) pattern))
(test (parse-pattern '(cross x) lang 'grammar) '(cross x-x))
(test (parse-pattern '(cross x) lang 'cross) '(cross x))
(test (parse-pattern 'x lang 'grammar) 'x)
(test (parse-pattern 'variable lang 'grammar) 'variable))
(let ()
(define-language lang (x variable))
(define-syntax test-class-reassignments
(syntax-rules ()
[(_ pattern expected)
(test (to-table (class-reassignments (parse-pattern pattern))) expected)]))
(test (to-table (class-reassignments (parse-pattern pattern lang 'top-level)))
expected)]))
(test-class-reassignments
'(x_1 ..._1 x_2 ..._2 x_2 ..._1)
@ -544,11 +567,16 @@
(test-class-reassignments
'(x_1 ..._1 x_1 ..._2 x_2 ..._1 x_2 ..._4 x_2 ..._3)
'((..._1 . ..._3) (..._2 . ..._3) (..._4 . ..._3)))
(test (hash-map (class-reassignments (parse-pattern '(x_1 ... x_1 ..._!_1 x_1 ..._1)))
(λ (_ cls) cls))
'(..._1 ..._1))
(test
(hash-map
(class-reassignments (parse-pattern '(x_1 ... x_1 ..._!_1 x_1 ..._1) lang 'top-level))
(λ (_ cls) cls))
'(..._1 ..._1))
(test-class-reassignments
'((3 ..._1) ..._2 (4 ..._1) ..._3)
'((..._2 . ..._3))))
'((..._2 . ..._3)))
(test-class-reassignments
'(x ..._1 x ..._2 variable ..._2 variable ..._3 variable_1 ..._3 variable_1 ..._4)
'((..._1 . ..._4) (..._2 . ..._4) (..._3 . ..._4))))
(print-tests-passed 'rg-test.ss)

238
collects/redex/private/rg.ss
View File

@ -30,28 +30,13 @@ To do a better job of not generating programs with free variables,
(define (use-lang-literal? [random random]) (= 0 (random 20)))
(define (try-to-introduce-binder?) (= 0 (random 2)) #f)
(define (hash->keys hash) (hash-map hash (λ (k v) k)))
(define (lang-literals lang)
(define (process-pattern pat lits)
(cond [(symbol? pat) (process-pattern (symbol->string pat) lits)]
[(string? pat) (hash-set lits pat (void))]
[(number? pat) (process-pattern (number->string pat) lits)]
[(pair? pat) (foldl process-pattern lits pat)]
[else lits]))
(define (process-non-terminal nt chars)
(foldl (λ (rhs chars) (process-pattern (rhs-pattern rhs) chars))
chars (nt-rhs nt)))
(hash->keys
(foldl process-non-terminal
(make-immutable-hash null) (compiled-lang-lang lang))))
;; unique-chars : (listof string) -> (listof char)
(define (unique-chars strings)
(define (record-chars char chars)
(if (char=? char #\_) chars (hash-set chars char (void))))
(hash->keys
(foldl (λ (s c) (foldl record-chars c (string->list s)))
(make-immutable-hash null) strings)))
(let ([uniq (make-hasheq)])
(for ([lit strings])
(for ([char lit])
(hash-set! uniq char #t)))
(hash-map uniq (λ (k v) k))))
(define generation-retries 100)
(define ascii-chars-threshold 50)
@ -129,15 +114,15 @@ To do a better job of not generating programs with free variables,
(error 'generate "unable to generate pattern ~s in ~s attempts"
(unparse-pattern pat) generation-retries))
(define (generate* lang pat size attempt [decisions@ random-decisions@])
(define (generate* lang pat size [decisions@ random-decisions@])
(define-values/invoke-unit decisions@
(import) (export decisions^))
(define lang-lits (lang-literals lang))
(define lang-lits (map symbol->string (compiled-lang-literals lang)))
(define lang-chars (unique-chars lang-lits))
(define base-table (find-base-cases lang))
(define (generate-nt name fvt-id bound-vars size in-hole state)
(define (generate-nt name fvt-id bound-vars size attempt in-hole state)
(let*-values
([(nt) (findf (λ (nt) (eq? name (nt-name nt)))
(append (compiled-lang-lang lang)
@ -151,7 +136,7 @@ To do a better job of not generating programs with free variables,
[(term _)
(generate/pred
(rhs-pattern rhs)
(λ (pat) (((generate-pat bound-vars (max 0 (sub1 size))) pat in-hole) nt-state))
(λ (pat) (((generate-pat bound-vars (max 0 (sub1 size)) attempt) pat in-hole) nt-state))
(λ (_ env) (mismatches-satisfied? env)))])
(values term (extend-found-vars fvt-id term state))))
@ -189,6 +174,14 @@ To do a better job of not generating programs with free variables,
(values term state)
(retry (sub1 remaining)))))))
(define (generate/prior name state generate)
(let* ([none (gensym)]
[prior (hash-ref (state-env state) name none)])
(if (eq? prior none)
(let-values ([(term state) (generate)])
(values term (set-env state name term)))
(values prior state))))
(define (mismatches-satisfied? env)
(let ([groups (make-hasheq)])
(define (get-group group)
@ -207,17 +200,20 @@ To do a better job of not generating programs with free variables,
(define (set-env state name value)
(make-state (state-fvt state) (hash-set (state-env state) name value)))
(define (bindings env)
(make-bindings
(for/fold ([bindings null]) ([(key val) env])
(if (binder? key)
(cons (make-bind (binder-name key) val) bindings)
bindings))))
(define-struct found-vars (nt source bound-vars found-nt?))
(define (fvt-entry binds)
(make-found-vars (binds-binds binds) (binds-source binds) '() #f))
(define (((generate-pat bound-vars size) pat in-hole) state)
(define recur (generate-pat bound-vars size))
(define (((generate-pat bound-vars size attempt) pat in-hole) state)
(define recur (generate-pat bound-vars size attempt))
(define (recur/pat pat) ((recur pat in-hole) state))
(define (generate-nt/built-in undecorated decorated)
(if ((is-nt? lang) undecorated)
(generate-nt undecorated decorated bound-vars size in-hole state)
(recur/pat undecorated)))
(match pat
[`number (values ((next-number-decision) random-numbers) state)]
@ -233,40 +229,33 @@ To do a better job of not generating programs with free variables,
(values (symbol-append prefix term) state))]
[`string (values ((next-string-decision) lang-chars lang-lits attempt) state)]
[`(side-condition ,pat ,(? procedure? condition))
(define (bindings env)
(make-bindings
(for/fold ([bindings null]) ([(name value) env])
(if (symbol? name) (cons (make-bind name value) bindings) bindings))))
;; `env' includes bindings beyond those bound in `pat',
;; but compiled side-conditions ignore these.
(generate/pred pat recur/pat (λ (_ env) (condition (bindings env))))]
[`(name ,(? symbol? id) ,p)
(let-values ([(term state) (recur/pat p)])
(values term (set-env state id term)))]
(values term (set-env state (make-binder id) term)))]
[`hole (values in-hole state)]
[`(in-hole ,context ,contractum)
(let-values ([(term state) (recur/pat contractum)])
((recur context term) state))]
[`(hide-hole ,pattern) ((recur pattern the-hole) state)]
[`any
(let-values ([(lang nt) ((next-any-decision) lang)])
(values (generate* lang nt size attempt decisions@) state))]
(let*-values ([(lang nt) ((next-any-decision) lang)]
[(term _) ((generate* lang nt size decisions@) attempt)])
(values term state))]
[(? (is-nt? lang))
(generate-nt pat pat bound-vars size in-hole state)]
[(and (? symbol?) (app symbol->string (regexp named-nt-rx (list _ nt))))
(let* ([undecorated (string->symbol nt)]
[none (gensym)]
[prior (hash-ref (state-env state) pat none)])
(if (eq? prior none)
(let-values ([(term state) (generate-nt/built-in undecorated pat)])
(values term (set-env state pat term)))
(values prior state)))]
[(struct mismatch (name group))
(let ([undecorated (string->symbol (cadr (regexp-match mismatch-nt-rx (symbol->string group))))])
(let-values ([(term state) (generate-nt/built-in undecorated name)])
(values term (set-env state pat term))))]
(generate-nt pat pat bound-vars size attempt in-hole state)]
[(struct binder ((and name (or (? (is-nt? lang) nt) (app (symbol-match named-nt-rx) (? (is-nt? lang) nt))))))
(generate/prior pat state (λ () (generate-nt nt name bound-vars size attempt in-hole state)))]
[(struct binder ((or (? built-in? b) (app (symbol-match named-nt-rx) (? built-in? b)))))
(generate/prior pat state (λ () (recur/pat b)))]
[(struct mismatch (name (app (symbol-match mismatch-nt-rx) (? symbol? (? (is-nt? lang) nt)))))
(let-values ([(term state) (generate-nt nt pat bound-vars size attempt in-hole state)])
(values term (set-env state pat term)))]
[(struct mismatch (name (app (symbol-match mismatch-nt-rx) (? symbol? (? built-in? b)))))
(let-values ([(term state) (recur/pat b)])
(values term (set-env state pat term)))]
[`(cross ,(? symbol? cross-nt))
(generate-nt cross-nt #f bound-vars size in-hole state)]
(generate-nt cross-nt #f bound-vars size attempt in-hole state)]
[(or (? symbol?) (? number?) (? string?) (? boolean?) (? null?)) (values pat state)]
[(list-rest (and (struct ellipsis (name sub-pat class vars)) ellipsis) rest)
(let*-values ([(length) (let ([prior (hash-ref (state-env state) class #f)])
@ -317,13 +306,15 @@ To do a better job of not generating programs with free variables,
(state-fvt state))
(state-env state)))
(let-values ([(term _)
(generate/pred pat
(λ (pat)
(((generate-pat null size) pat the-hole)
(make-state null #hash())))
(λ (_ env) (mismatches-satisfied? env)))])
term))
(λ (attempt)
(let-values ([(term state)
(generate/pred
pat
(λ (pat)
(((generate-pat null size attempt) pat the-hole)
(make-state null #hash())))
(λ (_ env) (mismatches-satisfied? env)))])
(values term (bindings (state-env state))))))
;; find-base-cases : compiled-language -> hash-table
(define (find-base-cases lang)
@ -403,39 +394,55 @@ To do a better job of not generating programs with free variables,
(define ((is-nt? lang) x)
(and (hash-ref (compiled-lang-ht lang) x #f) #t))
;; built-in? : any -> boolean
(define (built-in? x)
(and (memq x underscore-allowed) #t))
(define named-nt-rx #rx"^([^_]+)_[^_]*$")
(define mismatch-nt-rx #rx"([^_]+)_!_[^_]*$")
(define named-ellipsis-rx #rx"^\\.\\.\\._[^_]*$")
(define mismatch-ellipsis-rx #rx"^\\.\\.\\._!_[^_]*$")
;; symbol-match : regexp -> any -> (or/c false symbol)
;; Returns the sub-symbol matching the sub-pattern inside
;; the first capturing parens.
(define ((symbol-match rx) x)
(and (symbol? x)
(let ([match (regexp-match rx (symbol->string x))])
(and match (cadr match) (string->symbol (cadr match))))))
(define-struct class (id) #:inspector (make-inspector))
(define-struct mismatch (id group) #:inspector (make-inspector))
(define-struct binder (name) #:inspector (make-inspector))
;; name: (or/c symbol? mismatch?)
;; The generator records `name' in the environment when generating an ellipsis,
;; to collect bindings (for side-condition evaluation) and check mismatch satisfaction.
;; to enforce sequence length constraints.
;; class: class?
;; When one binding appears under two (non-nested) ellipses, the sequences generated
;; must have the same length; `class' groups ellipses to reflect this constraint.
;; var: (list/c (or/c symbol? class? mismatch?))
;; var: (list/c (or/c symbol? class? mismatch? binder?))
;; the bindings within an ellipses, used to split and merge the environment before
;; and after generating an ellipsis
(define-struct ellipsis (name pattern class vars) #:inspector (make-inspector))
;; parse-pattern : pattern -> parsed-pattern
;; Turns "pat ...", "pat ..._id", and "pat ..._!_id" into ellipsis structs
;; and "nt_!_id" into mismatch structs.
(define (parse-pattern pattern [cross? #f])
;; parse-pattern : pattern compiled-lang (or/c 'cross 'top-level 'grammar) -> parsed-pattern
;; Turns "pat ...", "pat ..._id", and "pat ..._!_id" into ellipsis structs,
;; "nt_!_id" into mismatch structs, "nt_id" into binder structs, and
;; "nt/underscore-allowed" in top-level patterns into binder structs.
(define (parse-pattern pattern lang mode)
(define (recur pat vars)
(match pat
[(and (? symbol?) (app symbol->string (regexp named-nt-rx)))
(values pat (cons pat vars))]
[(and (? symbol?) (app symbol->string (regexp mismatch-nt-rx)))
[(or (app (symbol-match named-nt-rx) (or (? (is-nt? lang)) (? built-in?)))
(and (? (λ (_) (eq? mode 'top-level))) (or (? (is-nt? lang)) (? built-in?))))
(let ([b (make-binder pat)])
(values b (cons b vars)))]
[(app (symbol-match mismatch-nt-rx) (or (? (is-nt? lang)) (? built-in?)))
(let ([mismatch (make-mismatch (gensym) pat)])
(values mismatch (cons mismatch vars)))]
[`(name ,name ,sub-pat)
(let-values ([(parsed vars) (recur sub-pat vars)])
(values `(name ,name ,parsed) (cons name vars)))]
(values `(name ,name ,parsed) (cons (make-binder name) vars)))]
[(list-rest sub-pat (and (? symbol?) (app symbol->string (regexp named-ellipsis-rx)) name) rest)
(let*-values ([(sub-pat-parsed sub-pat-vars) (recur sub-pat null)]
[(seq) (make-ellipsis name sub-pat-parsed (make-class name) sub-pat-vars)]
@ -456,7 +463,7 @@ To do a better job of not generating programs with free variables,
[(vars) (append (list* class mismatch sub-pat-vars) vars)]
[(rest-parsed vars) (recur rest vars)])
(values (cons seq rest-parsed) vars))]
[(and (? (λ (_) (not cross?))) `(cross ,(and (? symbol?) nt)))
[(and (? (λ (_) (not (eq? mode 'cross)))) `(cross ,(and (? (is-nt? lang)) nt)))
(let ([nt-str (symbol->string nt)])
(values `(cross ,(string->symbol (string-append nt-str "-" nt-str))) vars))]
[(cons first rest)
@ -469,19 +476,20 @@ To do a better job of not generating programs with free variables,
;; parse-language: compiled-lang -> compiled-lang
(define (parse-language lang)
(define ((parse-nt cross?) nt)
(make-nt (nt-name nt) (map (parse-rhs cross?) (nt-rhs nt))))
(define ((parse-rhs cross?) rhs)
(make-rhs (reassign-classes (parse-pattern (rhs-pattern rhs) cross?))
(define ((parse-nt mode) nt)
(make-nt (nt-name nt) (map (parse-rhs mode) (nt-rhs nt))))
(define ((parse-rhs mode) rhs)
(make-rhs (reassign-classes (parse-pattern (rhs-pattern rhs) lang mode))
(rhs-var-info rhs)))
(struct-copy
compiled-lang lang
[lang (map (parse-nt #f) (compiled-lang-lang lang))]
[cclang (map (parse-nt #t) (compiled-lang-cclang lang))]))
[lang (map (parse-nt 'grammar) (compiled-lang-lang lang))]
[cclang (map (parse-nt 'top-level) (compiled-lang-cclang lang))]))
;; unparse-pattern: parsed-pattern -> pattern
(define unparse-pattern
(match-lambda
[(struct binder (name)) name]
[(struct mismatch (_ group)) group]
[(list-rest (struct ellipsis (name sub-pat _ _)) rest)
(let ([ellipsis (if (mismatch? name) (mismatch-group name) name)])
@ -515,8 +523,8 @@ To do a better job of not generating programs with free variables,
(match pat
;; `(name ,id ,sub-pat) not considered, since bindings introduced
;; by name must be unique.
[(and (? symbol?) (app symbol->string (regexp named-nt-rx)))
(record-binder pat under assignments)]
[(struct binder (name))
(record-binder name under assignments)]
[(struct ellipsis (name sub-pat (struct class (cls)) _))
(recur sub-pat (cons cls under)
(if (and (symbol? name) (regexp-match named-ellipsis-rx (symbol->string name)))
@ -544,37 +552,54 @@ To do a better job of not generating programs with free variables,
(define-language sexp (sexp variable string number hole (sexp ...)))
(parse-language sexp)))
(define-syntax check
(syntax-rules ()
[(_ lang ([id pat] ...) attempts size property)
(let loop ([remaining attempts])
(if (zero? remaining)
#t
(let ([attempt (add1 (- attempts remaining))])
(term-let
([id (generate lang pat size attempt)] ...)
(let ([generated (term ((,'id id) ...))])
(if (with-handlers
([exn:fail? (λ (exn) (error 'check "term ~s raises ~s" generated exn))])
property)
(loop (sub1 remaining))
(format "failed after ~s attempts: ~s"
attempt generated)))))))]))
(define-syntax (generate stx)
(define-syntax (check stx)
(syntax-case stx ()
[(_ lang pat attempts size property)
(let-values ([(names names/ellipses)
(extract-names (language-id-nts #'lang 'generate) 'check #t #'pat)])
(with-syntax ([(name ...) names]
[(name/ellipses ...) names/ellipses])
(syntax/loc stx
(let ([generator (term-generator lang pat size random-decisions@)])
(let loop ([remaining attempts])
(if (zero? remaining)
#t
(let ([attempt (add1 (- attempts remaining))])
(let-values ([(term bindings) (generator attempt)])
(term-let ([name/ellipses (lookup-binding bindings 'name)] ...)
(if (with-handlers
([exn:fail? (λ (exn) (error 'check "term ~s raises ~s" term exn))])
property)
(loop (sub1 remaining))
(fprintf (current-error-port)
"failed after ~s attempts: ~s"
attempt term)))))))))))]))
(define-syntax generate
(syntax-rules ()
[(_ lang pat size attempt)
(syntax (generate lang pat size attempt random-decisions@))]
(let-values ([(term _) ((term-generator lang pat size random-decisions@) attempt)])
term)]
[(_ lang pat size) (generate lang pat size 0)]))
(define-syntax generate/decisions
(syntax-rules ()
[(_ lang pat size attempt decisions@)
(let-values ([(term _) ((term-generator lang pat size decisions@) attempt)])
term)]))
(define-syntax (term-generator stx)
(syntax-case stx ()
[(_ lang pat size decisions@)
(with-syntax ([pattern
(rewrite-side-conditions/check-errs
(language-id-nts #'lang 'generate)
'generate #f #'pat)])
(syntax
'generate #t #'pat)])
(syntax/loc stx
(generate*
(parse-language lang)
(reassign-classes (parse-pattern`pattern))
size attempt decisions@)))]))
(reassign-classes (parse-pattern `pattern lang 'top-level))
size decisions@)))]))
(define-signature decisions^
(next-variable-decision
@ -594,10 +619,11 @@ To do a better job of not generating programs with free variables,
(define (next-string-decision) pick-string)))
(provide pick-from-list pick-var pick-length min-prods decisions^
is-nt? lang-literals pick-char random-string pick-string
check pick-nt unique-chars pick-any sexp generate parse-pattern
is-nt? pick-char random-string pick-string check
pick-nt unique-chars pick-any sexp generate parse-pattern
class-reassignments reassign-classes unparse-pattern
(struct-out ellipsis) (struct-out mismatch) (struct-out class))
(struct-out ellipsis) (struct-out mismatch) (struct-out class)
(struct-out binder) generate/decisions)
(provide/contract
[find-base-cases (-> compiled-lang? hash?)])

2
collects/repos-time-stamp/stamp.ss
View File

@ -1 +1 @@
#lang scheme/base (provide stamp) (define stamp "18sep2008")
#lang scheme/base (provide stamp) (define stamp "22sep2008")

12
collects/rnrs/io/ports-6.ss
View File

@ -965,9 +965,9 @@
[else 9])))]
[(char? v)
(case v
[(#\x7) 7] ; #\alarm
[(#\x1B) 5] ; #\esc
[(#\x7F) 8] ; #\delete
[(#\u7) 7] ; #\alarm
[(#\u1B) 5] ; #\esc
[(#\u7F) 8] ; #\delete
[else (and (not (char-graphic? v))
(+ 3
(if ((char->integer v) . < . #x10000)
@ -1014,9 +1014,9 @@
(write-char #\" p)]
[(char? v)
(case v
[(#\x7) (display "#\\alarm" p)]
[(#\x1B) (display "#\\esc" p)]
[(#\x7F) (display "#\\delete" p)]
[(#\u7) (display "#\\alarm" p)]
[(#\u1B) (display "#\\esc" p)]
[(#\u7F) (display "#\\delete" p)]
[else
(display "#\\x" p)
(let ([n (number->string (char->integer v) 16)])

7
collects/scheme/private/kw.ss
View File

@ -280,6 +280,13 @@
"missing argument identifier after keyword"
stx
#'kw))]
[(kw bad . rest)
(keyword? (syntax-e #'kw))
(raise-syntax-error
#f
"after keyword, not an identifier or identifier with default"
stx
(syntax bad))]
[(bad . rest)
(raise-syntax-error
#f

2
collects/scribblings/drscheme/keybindings.scrbl
View File

@ -124,6 +124,8 @@ window to the interactions window (or the search window, if it is open).}
@keybinding["C-c C-o"]{the sexpression following the
insertion point is put in place of its containing sexpression}
@keybinding["C-c C-e"]{the first and last characters (usually parentheses)
of the containing expression are removed}
@keybinding["C-c C-l"]{wraps a let around the
sexpression following the insertion point and puts a printf in at
that point (useful for debugging).}

50
collects/scribblings/main/private/search.js
View File

@ -455,6 +455,22 @@ function Search(data, term, is_pre, K) {
else { progress(0); t = setTimeout(DoChunk,15); return killer; }
}
function GetContextHTML() {
// useful only when a context is set
return (((pre_query_label != "") && pre_query_label)
? SanitizeHTML(pre_query_label)
: ('&ldquo;' + SanitizeHTML(pre_query) + '&rdquo;'));
}
function GetContextClearerHTML(text) {
return ('<a href="?hq=" tabIndex="5"'
+' title="Clear pre-filter context"'
+' style="text-decoration: none; color: #444;'
+' font-size: 82%; font-weight: bold;"'
+' onclick="return new_query(this,\'\');">'
+ text
+ '</a>');
}
var search_data; // pre-filtered searchable index data
function PreFilter() {
pre_query = NormalizeSpaces(pre_query);
@ -469,23 +485,15 @@ function PreFilter() {
+'[set context]</a>';
} else {
pre_query_label_line.innerHTML =
'Context:&nbsp;'
+ (((pre_query_label != "") && pre_query_label)
? SanitizeHTML(pre_query_label)
: ('&ldquo;' + SanitizeHTML(pre_query) + '&rdquo;'))
+ '&nbsp;<a href="?hq=" tabIndex="5"'
+' title="Clear pre-filter context"'
+' style="text-decoration: none; color: #444;'
+' font-size: 82%; font-weight: bold;"'
+' onclick="return new_query(this,\'\');">'
+'[clear</a>'
+'/'
+'<a href="#" tabIndex="5"'
+' title="Edit pre-filter context"'
+' style="text-decoration: none; color: #444;'
+' font-size: 82%; font-weight: bold;"'
+' onclick="toggle_panel(\'contexts\'); return false;">'
+'modify]</a>';
'Context:&nbsp;' + GetContextHTML()
+ '&nbsp;'
+ GetContextClearerHTML('[clear')
+ '/<a href="#" tabIndex="5"'
+' title="Edit pre-filter context"'
+' style="text-decoration: none; color: #444;'
+' font-size: 82%; font-weight: bold;"'
+' onclick="toggle_panel(\'contexts\'); return false;">'
+'modify]</a>';
}
last_search_term = null;
last_search_term_raw = null;
@ -604,8 +612,12 @@ function UpdateResults() {
+ ' exact</span>)';
if (search_results.length == 0) {
if (last_search_term == "") status_line.innerHTML = "";
else status_line.innerHTML = 'No matches found '
+ '<div style="color: black; font-size: 82%;">'
else status_line.innerHTML = 'No matches found'
+ ((pre_query != "")
? (' in '+GetContextHTML()
+' '+GetContextClearerHTML('<small>[clear]</small>'))
: '')
+ '<br><div style="color: black; font-size: 82%;">'
+ '(Make sure your spelling is correct'
+ (last_search_term.search(/ /)>=0 ? ', or try fewer keywords' : '')
+ ((pre_query != "") ? ', or clear the search context' : '')

30
collects/scribblings/reference/module-reflect.scrbl
View File

@ -293,6 +293,25 @@ explicitly the import, the import @tech{phase level} shift (where
name of the re-exported binding, and the @tech{phase level} of the
import.}
@defproc[(module-compiled-language-info [compiled-module-code compiled-module-expression?])
(or/c false/c (vector/c module-path? symbol? any/c))]{
Returns information intended to reflect the ``language'' of the
module's implementation as originally attached to the syntax of the
module's declaration though the @indexed-scheme['module-language]
@tech{syntax property}. See also @scheme[module].
If no information is available for the module, the result is
@scheme[#f]. Otherwise, the result is @scheme[(vector _mp _name _val)]
such that @scheme[((dynamic-require _mp _name) _val)] should return
function that takes a single argument. The function's argument is a
key for reflected information, and the result is a value associated
with that key. Acceptable keys and the interpretation of results is
up to external tools, such as DrScheme. If no information is
available for a given key, the result should be @scheme[#f].
See also @scheme[module->language-info].}
@;------------------------------------------------------------------------
@section[#:tag "dynreq"]{Dynamic Module Access}
@ -329,3 +348,14 @@ If @scheme[provided] is @|void-const|, then the module is
any]{
Like @scheme[dynamic-require], but in @tech{phase} 1.}
@defproc[(module->language-info [mod module-path?])
(or/c false/c (vector/c module-path? symbol? any/c))]{
Returns information intended to reflect the ``language'' of the
implementation of @scheme[mod], which must be declared (but not
necessarily @tech{instantiate}d or @tech{visit}ed) in the current
namespace. The information is the same as would have been returned by
@scheme[module-compiled-language-info] applied to the module's
implementation as compiled code.}

46
collects/scribblings/reference/read.scrbl
View File

@ -105,6 +105,52 @@ See @secref["readtables"] for an extended example that uses
@scheme[read-syntax/recursive].}
@defproc[(read-language [in input-port? (current-input-port)]
[fail-thunk (-> any) (lambda () (error ...))])
any]{
Reads @scheme[in] in the same way as @scheme[read], but stopping as
soon as a @tech{reader language} (or its absence) is determined.
A @deftech{reader language} is specified by @litchar{#lang} or
@litchar{#!} (see @secref["parse-reader"]) at the beginning of the
input, though possibly after comment forms. Instead of dispatching to
a @schemeidfont{read} or @schemeidfont{read-syntax} form as
@scheme[read] and @scheme[read-syntax] do, @scheme[read-language]
dispatches to a @schemeidfont{get-info} function (if any) exported by
the same module. The result of the @schemeidfont{get-info} function is
the result of @scheme[read-language] if it is a function of one
argument; if @schemeidfont{get-info} produces any other kind of
result, the @exnraise[exn:fail:contract].
The function produced by @schemeidfont{get-info} reflects information
about the expected syntax of the input stream. The argument to the
function serves as a key on such information; acceptable keys and the
interpretation of results is up to external tools, such as DrScheme.
If no information is available for a given key, the result should be
@scheme[#f].
The @schemeidfont{get-info} function itself is applied to five
arguments: the input port being read, the module path from which the
@schemeidfont{get-info} function was extracted, and the source line
(positive exact integer or @scheme[#f]), column (non-negative exact
integer or @scheme[#f]), and position (positive exact integer or
@scheme[#f]) of the start of the @litchar{#lang} or @litchar{#!}
form. The @schemeidfont{get-info} function may further read from the
given input port to determine its result, but it should read no
further than necessary.
If @scheme[in] starts with a @tech{reader language} specification but
the relevant module does not export @schemeidfont{get-info} (but
perhaps does export @schemeidfont{read} and
@schemeidfont{read-syntax}), then the result of @scheme[read-language]
is @scheme[#f].
If @scheme[in] does not specify a @tech{reader language}, then
@scheme[fail-thunk] is called. The default @scheme[fail-thunk] raises
@scheme[exn:fail:contract].}
@defboolparam[read-case-sensitive on?]{
A parameter that controls parsing and printing of symbols. When this

13
collects/scribblings/reference/syntax.scrbl
View File

@ -161,7 +161,18 @@ are evaluated in order as they appear within the module; accessing a
@tech{module-level variable} before it is defined signals a run-time
error, just like accessing an undefined global variable.
See also @secref["module-eval-model"] and @secref["mod-parse"].}
See also @secref["module-eval-model"] and @secref["mod-parse"].
When a @tech{syntax object} representing a @scheme[module] form has a
@indexed-scheme['module-language] @tech{syntax property} attached, and
when the property value is a vector of three elements where the first
is a module path (in the sense of @scheme[module-path?]) and the
second is a symbol, then the property value is preserved in the
corresponding compiled and/or declared module. The third component of
the vector should be printable and @scheme[read]able, so that it can
be preserved in marshaled bytecode. See also
@scheme[module-compiled-language-info] and
@scheme[module->language-info].}
@defform[(#%module-begin form ...)]{

65
collects/string-constants/german-string-constants.ss
View File

@ -399,18 +399,23 @@
(repl-value-color "Werte")
(repl-error-color "Fehler")
;;; find/replace
(find-and-replace "Suchen und Ersetzen")
(find "Suchen")
(replace "Ersetzen")
;;; find/replace
(search-next "Weiter")
(search-next "Zurück")
(search-match "Fundort") ;;; this one and the next one are singular/plural variants of each other
(search-matches "Fundorte")
(search-replace "Ersetzen")
(search-skip "Überspringen")
(search-show-replace "Ersetzen einblenden")
(search-hide-replace "Ersetzen ausblenden")
(find-case-sensitive "Groß-/Kleinschreibung beachten") ;; the check box in both the docked & undocked search
(find-anchor-based "Suchen mit Ankern")
;; these string constants used to be used by searching,
;; but aren't anymore. They are still used by other tools, tho.
(hide "Ausblenden")
(dock "Andocken")
(undock "Ablegen")
(replace&find "Ersetzen && Suchen") ;;; need double & to get a single &
(forward "Vorwärts")
(backward "Rückwärts")
(hide "Ausblenden")
(find-case-sensitive "Groß-/Kleinschreibung beachten")
(find-anchor-based "Suchen mit Ankern")
;;; multi-file-search
(mfs-multi-file-search-menu-item "In Dateien suchen...")
@ -547,17 +552,18 @@
(find-info "Zum nächsten Vorkommen der Zeichenkette aus dem Such-Fenster springen")
(find-menu-item "Suchen")
(find-again-info "Die gleiche Zeichenkette nochmal suchen")
(find-again-menu-item "Nochmal suchen")
(find-next-info "Zum nächsten Fundort der Zeichenkette im Suchfenster springen")
(find-next-menu-item "Weitersuchen")
(find-again-backwards-info "Zum vorherigen Vorkommen der Zeichenkette aus dem Such-Fenster springen")
(find-again-backwards-menu-item "Rückwärts nochmal suchen")
(find-previous-info "Zum vorherigen Vorkommen der Zeichenkette aus dem Such-Fenster springen")
(find-previous-menu-item "Rückwärts weitersuchen")
(replace-and-find-again-info "Den aktuellen Text ersetzen und dann nochmal suchen")
(replace-and-find-again-menu-item "Ersetzen && nochmal suchen")
(replace-and-find-again-backwards-info "Den aktuellen Text ersetzen und dann nochmal rückwärtssuchen")
(replace-and-find-again-backwards-menu-item "Ersetzen && rückwärts nochmal suchen")
(show-replace-menu-item "Ersetzen einblenden")
(hide-replace-menu-item "Ersetzen ausblenden")
(show/hide-replace-info "Wechselt die Sichtbarkeit des Ersetzen-Panels")
(replace-menu-item "Ersetzen")
(replace-info " Suchtext im dunklen Kreis ersetzen")
(replace-all-info "Alle Vorkommen der Such-Zeichenkette ersetzen")
(replace-all-menu-item "Alle ersetzen")
@ -828,7 +834,10 @@
(whole-part "Ganzzahliger Anteil")
(numerator "Zähler")
(denominator "Nenner")
(invalid-number "Unzulässige Zahl: muss exakt, reell und nicht ganz sein.")
(insert-number/bad-whole-part "Der ganzzahlige Anteil muß eine ganze Zahl sein")
(insert-number/bad-numerator "Der Zähler einer Zahl muß eine nichtnegative ganze Zahl sein")
(insert-number/bad-denominator "Der Nenner einer Zahl muß eine nichtnegative ganze Zahl sein")
(insert-fraction-menu-item-label "Bruch einfügen...")
;; number snip popup menu
@ -1166,6 +1175,8 @@
(ml-cp-raise "Höher")
(ml-cp-lower "Tiefer")
(ml-always-show-#lang-line "#lang-Zeile in der `module'-Sprache immer anzeigen")
;; Profj
(profj-java "Java")
(profj-java-mode "Java-Modus")
@ -1303,4 +1314,16 @@
(gui-tool-show-gui-toolbar "GUI-Toolbar einblenden")
(gui-tool-hide-gui-toolbar "GUI-Toolbar ausblenden")
(gui-tool-insert-gui "GUI einfügen")
)
;; contract violation tracking
; tooltip for new planet icon in drscheme window (must have a planet violation logged to see it)
(show-planet-contract-violations "PLaneT-Vertragsverletzungen anzeigen")
; buttons in the dialog that lists the recorded bug reports
(bug-track-report "Ticket einreichen")
(bug-track-forget "Vergessen")
(bug-track-forget-all "Alles vergessen")
)

16
collects/tests/mzscheme/lang/reader.ss Normal file
View File

@ -0,0 +1,16 @@
#lang scheme/base
(require syntax/module-reader)
(provide (rename-out [my-read read]
[my-read-syntax read-syntax]))
(define (my-read port modpath line col pos)
(wrap-read-all 'scheme port read modpath (object-name port) line col pos))
(define (my-read-syntax src port modpath line col pos)
(syntax-property
(datum->syntax #f
(wrap-read-all 'scheme port (lambda (in) (read-syntax src in)) modpath src line col pos)
#f)
'module-language
'#(tests/mzscheme/lang/getinfo get-info closure-data)))

27
collects/tests/mzscheme/module.ss
View File

@ -407,6 +407,33 @@
(test #t module-path? '(planet "foo.ss" ("robby" "redex.plt") "sub" "deeper"))
(test #t module-path? '(planet "foo%2e.ss" ("robby%2e" "redex%2e.plt") "sub%2e" "%2edeeper"))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check 'module-language, `module-compiled-language-info', and `module->language-info'
(let ([mk (lambda (val)
(compile (syntax-property #'(module m scheme/base)
'module-language
val)))])
(test #f 'info (module-compiled-language-info (mk 10)))
(test '#(scheme x "whatever") 'info (module-compiled-language-info (mk '#(scheme x "whatever"))))
(let ([ns (make-base-namespace)])
(parameterize ([current-namespace ns])
(eval mk ns)
(eval (mk '#(scheme x "whatever")))
(test '#(scheme x "whatever") module->language-info ''m)
(let ([path (build-path (collection-path "tests" "mzscheme")
"langm.ss")])
(parameterize ([read-accept-reader #t]
[current-module-declare-name (module-path-index-resolve
(module-path-index-join path #f))])
(eval
(read-syntax path
(open-input-string "#lang tests/mzscheme (provide x) (define x 1)"
path)))
((current-module-name-resolver) (current-module-declare-name))))
(test '#(tests/mzscheme/lang/getinfo get-info closure-data)
module->language-info 'tests/mzscheme/langm))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

2
collects/web-server/formlets/date.ss
View File

@ -21,7 +21,7 @@
(define travel-formlet
(formlet
(#%#
(div
"Name:" ,{input-string . => . name}
(div
"Arrive:" ,{date-formlet . => . arrive}

10
collects/web-server/formlets/lib.ss
View File

@ -42,14 +42,13 @@
(apply fe gs-e)))
gs-i))))
(define (xml x)
(lambda (i)
(values (list x) (const id) i)))
(define (xml-forest x)
(lambda (i)
(values x (const id) i)))
(define (xml x)
(xml-forest (list x)))
(define (text x)
(xml x))
@ -81,6 +80,7 @@
(define beta any/c)
(provide/contract
[xexpr-forest/c contract?]
[formlet/c (any/c . -> . contract?)]
[pure (alpha
. -> . (formlet/c alpha))]
@ -90,8 +90,8 @@
[cross* (((formlet/c (() () #:rest (listof alpha) . ->* . beta)))
() #:rest (listof (formlet/c alpha))
. ->* . (formlet/c beta))]
[xml (xexpr? . -> . (formlet/c procedure?))]
[xml-forest (xexpr-forest/c . -> . (formlet/c procedure?))]
[xml (xexpr? . -> . (formlet/c procedure?))]
[text (string? . -> . (formlet/c procedure?))]
[tag-xexpr (symbol? (listof (list/c symbol? string?)) (formlet/c alpha) . -> . (formlet/c alpha))]
[formlet-display ((formlet/c alpha) . -> . xexpr-forest/c)]

234
collects/web-server/scribblings/formlets.scrbl Normal file
View File

@ -0,0 +1,234 @@
#lang scribble/doc
@(require "web-server.ss")
@(require (for-label web-server/servlet
xml))
@(define xexpr @tech[#:doc '(lib "xml/xml.scrbl")]{X-expression})
@title[#:tag "formlets"
#:style 'toc]{Formlets}
@defmodule[web-server/formlets]
The @web-server provides a kind of Web form abstraction called a @tech{formlet}.
@margin-note{@tech{Formlet}s originate in the work of the @link["http://groups.inf.ed.ac.uk/links/"]{Links} research group in
their paper @link["http://groups.inf.ed.ac.uk/links/formlets/"]{The Essence of Form Abstraction}.}
@local-table-of-contents[]
@section{Basic Formlet Usage}
Suppose we want to create an abstraction of entering a date in an HTML form. The following
@tech{formlet} captures this idea:
@schemeblock[
(define date-formlet
(formlet
(div
"Month:" ,{input-int . => . month}
"Day:" ,{input-int . => . day})
(list month day)))
]
The first part of the @scheme[formlet] syntax is the template of an @xexpr that is the rendering
of the formlet. It can contain elements like @scheme[,(_formlet . => . _name)] where @scheme[_formlet]
is a formlet expression and @scheme[_name] is an identifier bound in the second part of the @scheme[formlet]
syntax.
This formlet is displayed (with @scheme[formlet-display]) as the following @xexpr forest (list):
@schemeblock[
(list
'(div "Month:" (input ([name "input_0"]))
"Day:" (input ([name "input_1"]))))
]
@scheme[date-formlet] not only captures the rendering of the form, but also the request processing
logic. If we send it an HTTP request with bindings for @scheme["input_0"] to @scheme["10"] and
@scheme["input_1"] to @scheme["3"], with @scheme[formlet-process], then it returns:
@schemeblock[
(list 10 3)
]
which is the second part of the @scheme[formlet] syntax, where @scheme[month] has been replaced with the
integer represented by the @scheme["input_0"] and @scheme[day] has been replaced with the
integer represented by the @scheme["input_1"].
The real power of formlet is that they can be embedded within one another. For instance, suppose we want to
combine two date forms to capture a travel itinerary. The following formlet does the job:
@schemeblock[
(define travel-formlet
(formlet
(div
"Name:" ,{input-string . => . name}
(div
"Arrive:" ,{date-formlet . => . arrive}
"Depart:" ,{date-formlet . => . depart})
(list name arrive depart))))
]
(Notice that @scheme[date-formlet] is embedded twice.) This is rendered as:
@schemeblock[
(list
'(div
"Name:"
(input ([name "input_0"]))
(div
"Arrive:"
(div "Month:" (input ([name "input_1"]))
"Day:" (input ([name "input_2"])))
"Depart:"
(div "Month:" (input ([name "input_3"]))
"Day:" (input ([name "input_4"]))))))
]
Observe that @scheme[formlet-display] has automatically generated unique names for each input element. When we pass
bindings for these names to @scheme[formlet-process], the following list is returned:
@schemeblock[
(list "Jay"
(list 10 3)
(list 10 6))
]
The rest of the manual gives the details of @tech{formlet} usage and extension.
@section{Syntactic Shorthand}
@(require (for-label web-server/formlets/syntax))
@defmodule[web-server/formlets/syntax]
Most users will want to use the syntactic shorthand for creating @tech{formlet}s.
@defform[(formlet rendering yields-expr)]{
Constructs a @tech{formlet} with the specified @scheme[rendering] and the processing
resulting in the @scheme[yields-expr] expression. The @scheme[rendering] form is a quasiquoted
@xexpr, with two special caveats:
@scheme[,{_formlet-expr . => . _name}] embeds the
@tech{formlet} given by @scheme[_formlet-expr]; the result of this processing this formlet is
available in the @scheme[yields-expr] as @scheme[_name].
@scheme[(#%# _xexpr ...)] renders an @xexpr forest.
}
@section{Functional Usage}
@(require (for-label web-server/formlets/lib))
@defmodule[web-server/formlets/lib]
The syntactic shorthand abbreviates the construction of @deftech{formlet}s with the following library.
These combinators may be used directly to construct low-level formlets, such as those for new INPUT element
types. Refer to @secref["input-formlets"] for example low-level formlets using these combinators.
@defthing[xexpr-forest/c contract?]{
Equivalent to @scheme[(listof xexpr?)]
}
@defproc[(formlet/c [content any/c]) contract?]{
Equivalent to @scheme[(integer? . -> .
(values xexpr-forest/c
((listof binding?) . -> . (coerce-contract 'formlet/c content))
integer?))].
A @tech{formlet}'s internal representation is a function from an initial input number
to an @xexpr forest rendering, a processing function, and the next allowable
input number.
}
@defproc[(pure [value any/c]) (formlet/c any/c)]{
Constructs a @tech{formlet} that has no rendering and always returns @scheme[value] in
the processing stage.
}
@defproc[(cross [f (formlet/c (any/c . -> . any/c))]
[g (formlet/c any/c)])
(formlet/c any/c)]{
Constructs a @tech{formlet} with a rendering equal to the concatenation of the renderings of @tech{formlet}s @scheme[f] and @scheme[g];
a processing stage that applies @scheme[g]'s processing result to @scheme[f]'s processing result.
}
@defproc[(cross* [f (formlet/c (() () #:rest (listof any/c) . ->* . any/c))]
[g (formlet/c any/c)] ...)
(formlet/c any/c)]{
Equivalent to @scheme[cross] lifted to many arguments.
}
@defproc[(xml-forest [r xexpr-forest/c])
(formlet/c procedure?)]{
Constructs a @tech{formlet} with the rendering @scheme[r] and the identity procedure as the processing step.
}
@defproc[(xml [r xexpr?])
(formlet/c procedure?)]{
Equivalent to @scheme[(xml-forest (list r))].
}
@defproc[(text [r string?])
(formlet/c procedure?)]{
Equivalent to @scheme[(xml r)].
}
@defproc[(tag-xexpr [tag symbol?]
[attrs (listof (list/c symbol? string?))]
[inner (formlet/c any/c)])
(formlet/c any/c)]{
Constructs a @tech{formlet} with the rendering @scheme[(list (list* tag attrs inner-rendering))] where @scheme[inner-rendering] is
the rendering of @scheme[inner] and the processing stage identical to @scheme[inner].
}
@defproc[(formlet-display [f (formlet/c any/c)])
xexpr-forest/c]{
Renders @scheme[f].
}
@defproc[(formlet-process [f (formlet/c any/c)]
[r request?])
any/c]{
Runs the processing stage of @scheme[f] on the bindings in @scheme[r].
}
@section[#:tag "input-formlets"]{Predefined Formlets}
@(require (for-label web-server/formlets/input))
@defmodule[web-server/formlets/input]
There are a few basic @tech{formlet}s provided by this library.
@defthing[input-string (formlet/c string?)]{
A @tech{formlet} that renders as @schemeblock[(list `(input ([name (format "input_~a" _next-id)])))] where
@scheme[_next-id] is the next available input index and extracts @scheme[(format "input_~a" _next-id)] in
the processing stage and converts it into a UTF-8 string.
}
@defthing[input-int (formlet/c integer?)]{
Equivalent to @scheme[(cross (pure string->number) input-string)].
}
@defthing[input-symbol (formlet/c symbol?)]{
Equivalent to @scheme[(cross (pure string->symbol) input-string)].
}
@section{Utilities}
@(require (for-label web-server/formlets/servlet))
@defmodule[web-server/formlets/servlet]
A few utilities are provided for using @tech{formlet}s in Web applications.
@defproc[(send/formlet [f (formlet/c any/c)])
any/c]{
Uses @scheme[send/suspend] to send @scheme[f]'s rendering (wrapped in a FORM tag whose action is
the continuation URL) to the client. When the form is submitted, the request is passed to the
processing stage of @scheme[f].
}
@defproc[(embed-formlet [embed/url embed/url/c]
[f (formlet/c any/c)])
xexpr?]{
Like @scheme[send/formlet], but for use with @scheme[send/suspend/dispatch].
}

2
collects/web-server/scribblings/web-server.scrbl
View File

@ -15,6 +15,8 @@ develop Web applications in Scheme.
@include-section["servlet.scrbl"]
@include-section["lang.scrbl"]
@include-section["formlets.scrbl"]
@include-section["configuration.scrbl"]
@include-section["dispatchers.scrbl"]
@include-section["web-config-unit.scrbl"]

5
doc/release-notes/mzscheme/HISTORY.txt
View File

@ -1,3 +1,8 @@
Version 4.1.0.4
Added read-language
Added module-compiled-language-info, module->language-info,
and 'module-language property support
Version 4.1, August 2008
Changed namespaces to have a base phase; for example, calling
eval at compile-time uses a phase-1 namespace

692
src/mzscheme/src/cstartup.inc
View File

@ -1,24 +1,24 @@
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,48,46,51,50,0,0,0,1,0,0,6,0,9,0,
13,0,20,0,23,0,28,0,35,0,40,0,45,0,52,0,65,0,69,0,78,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,48,46,52,50,0,0,0,1,0,0,6,0,9,0,
13,0,20,0,23,0,36,0,41,0,48,0,53,0,58,0,65,0,69,0,78,
0,84,0,98,0,112,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0,
177,0,179,0,193,0,253,0,23,1,32,1,41,1,51,1,68,1,107,1,146,
1,215,1,4,2,92,2,137,2,142,2,162,2,53,3,73,3,124,3,190,3,
75,4,233,4,20,5,31,5,110,5,0,0,118,7,0,0,65,98,101,103,105,
110,29,11,11,63,108,101,116,66,100,101,102,105,110,101,62,111,114,64,108,101,
116,42,66,117,110,108,101,115,115,64,99,111,110,100,64,119,104,101,110,66,108,
101,116,114,101,99,72,112,97,114,97,109,101,116,101,114,105,122,101,63,97,110,
75,4,233,4,20,5,31,5,110,5,0,0,119,7,0,0,65,98,101,103,105,
110,29,11,11,63,108,101,116,66,100,101,102,105,110,101,62,111,114,72,112,97,
114,97,109,101,116,101,114,105,122,101,64,108,101,116,42,66,117,110,108,101,115,
115,64,99,111,110,100,64,119,104,101,110,66,108,101,116,114,101,99,63,97,110,
100,68,104,101,114,101,45,115,116,120,65,113,117,111,116,101,29,94,2,14,68,
35,37,107,101,114,110,101,108,11,29,94,2,14,68,35,37,112,97,114,97,109,
122,11,62,105,102,63,115,116,120,61,115,70,108,101,116,45,118,97,108,117,101,
115,61,120,73,108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109,
98,100,97,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,
45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,98,
10,35,11,8,155,226,94,159,2,16,35,35,159,2,15,35,35,16,20,2,3,
2,2,2,4,2,2,2,10,2,2,2,5,2,2,2,6,2,2,2,7,2,
2,2,8,2,2,2,9,2,2,2,11,2,2,2,12,2,2,97,36,11,8,
155,226,93,159,2,15,35,36,16,2,2,13,161,2,2,36,2,13,2,2,2,
13,97,10,11,11,8,155,226,16,0,97,10,37,11,8,155,226,16,0,13,16,
10,35,11,8,147,225,94,159,2,16,35,35,159,2,15,35,35,16,20,2,3,
2,2,2,4,2,2,2,11,2,2,2,5,2,2,2,6,2,2,2,7,2,
2,2,8,2,2,2,9,2,2,2,10,2,2,2,12,2,2,97,36,11,8,
147,225,93,159,2,15,35,36,16,2,2,13,161,2,2,36,2,13,2,2,2,
13,97,10,11,11,8,147,225,16,0,97,10,37,11,8,147,225,16,0,13,16,
4,35,29,11,11,2,2,11,18,98,64,104,101,114,101,8,31,8,30,8,29,
8,28,8,27,27,248,22,190,3,23,196,1,249,22,183,3,80,158,38,35,251,
22,73,2,17,248,22,88,23,200,2,12,249,22,63,2,1,248,22,90,23,202,
@ -28,14 +28,14 @@
36,28,248,22,71,248,22,65,23,195,2,248,22,64,193,249,22,183,3,80,158,
38,35,251,22,73,2,17,248,22,64,23,200,2,249,22,63,2,12,248,22,65,
23,202,1,11,18,100,10,8,31,8,30,8,29,8,28,8,27,16,4,11,11,
2,18,3,1,7,101,110,118,56,50,57,49,16,4,11,11,2,19,3,1,7,
101,110,118,56,50,57,50,27,248,22,65,248,22,190,3,23,197,1,28,248,22,
2,18,3,1,7,101,110,118,56,50,54,57,16,4,11,11,2,19,3,1,7,
101,110,118,56,50,55,48,27,248,22,65,248,22,190,3,23,197,1,28,248,22,
71,23,194,2,20,15,159,36,35,36,28,248,22,71,248,22,65,23,195,2,248,
22,64,193,249,22,183,3,80,158,38,35,250,22,73,2,20,248,22,73,249,22,
73,248,22,73,2,21,248,22,64,23,202,2,251,22,73,2,17,2,21,2,21,
249,22,63,2,5,248,22,65,23,205,1,18,100,11,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,56,50,57,52,16,4,
11,11,2,19,3,1,7,101,110,118,56,50,57,53,248,22,190,3,193,27,248,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,56,50,55,50,16,4,
11,11,2,19,3,1,7,101,110,118,56,50,55,51,248,22,190,3,193,27,248,
22,190,3,194,249,22,63,248,22,73,248,22,64,196,248,22,65,195,27,248,22,
65,248,22,190,3,23,197,1,249,22,183,3,80,158,38,35,28,248,22,51,248,
22,184,3,248,22,64,23,198,2,27,249,22,2,32,0,89,162,8,44,36,42,
@ -49,7 +49,7 @@
22,2,32,0,89,162,8,44,36,46,9,222,33,42,248,22,190,3,248,22,64,
201,248,22,65,198,27,248,22,65,248,22,190,3,196,27,248,22,190,3,248,22,
64,195,249,22,183,3,80,158,39,35,28,248,22,71,195,250,22,74,2,20,9,
248,22,65,199,250,22,73,2,3,248,22,73,248,22,64,199,250,22,74,2,6,
248,22,65,199,250,22,73,2,3,248,22,73,248,22,64,199,250,22,74,2,7,
248,22,65,201,248,22,65,202,27,248,22,65,248,22,190,3,23,197,1,27,249,
22,1,22,77,249,22,2,22,190,3,248,22,190,3,248,22,64,199,249,22,183,
3,80,158,39,35,251,22,73,1,22,119,105,116,104,45,99,111,110,116,105,110,
@ -59,53 +59,53 @@
115,101,116,45,102,105,114,115,116,11,2,24,201,250,22,74,2,20,9,248,22,
65,203,27,248,22,65,248,22,190,3,23,197,1,28,248,22,71,23,194,2,20,
15,159,36,35,36,249,22,183,3,80,158,38,35,27,248,22,190,3,248,22,64,
23,198,2,28,249,22,151,8,62,61,62,248,22,184,3,248,22,88,23,197,2,
23,198,2,28,249,22,154,8,62,61,62,248,22,184,3,248,22,88,23,197,2,
250,22,73,2,20,248,22,73,249,22,73,21,93,2,25,248,22,64,199,250,22,
74,2,8,249,22,73,2,25,249,22,73,248,22,97,203,2,25,248,22,65,202,
251,22,73,2,17,28,249,22,151,8,248,22,184,3,248,22,64,23,201,2,64,
74,2,9,249,22,73,2,25,249,22,73,248,22,97,203,2,25,248,22,65,202,
251,22,73,2,17,28,249,22,154,8,248,22,184,3,248,22,64,23,201,2,64,
101,108,115,101,10,248,22,64,23,198,2,250,22,74,2,20,9,248,22,65,23,
201,1,249,22,63,2,8,248,22,65,23,203,1,99,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,56,51,49,55,16,4,
11,11,2,19,3,1,7,101,110,118,56,51,49,56,18,158,94,10,64,118,111,
201,1,249,22,63,2,9,248,22,65,23,203,1,99,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,56,50,57,53,16,4,
11,11,2,19,3,1,7,101,110,118,56,50,57,54,18,158,94,10,64,118,111,
105,100,8,47,27,248,22,65,248,22,190,3,196,249,22,183,3,80,158,38,35,
28,248,22,51,248,22,184,3,248,22,64,197,250,22,73,2,26,248,22,73,248,
22,64,199,248,22,88,198,27,248,22,184,3,248,22,64,197,250,22,73,2,26,
248,22,73,248,22,64,197,250,22,74,2,23,248,22,65,199,248,22,65,202,159,
35,20,103,159,35,16,1,2,1,16,0,83,158,41,20,100,137,69,35,37,109,
105,110,45,115,116,120,2,2,10,11,10,35,80,158,35,35,20,103,159,35,16,
0,16,0,11,11,16,0,35,11,38,35,11,11,16,10,2,3,2,4,2,5,
2,6,2,7,2,8,2,9,2,10,2,11,2,12,16,10,11,11,11,11,11,
11,11,11,11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,9,
2,10,2,11,2,12,35,45,36,11,11,16,0,16,0,16,0,35,35,11,11,
11,16,0,16,0,16,0,35,35,16,11,16,5,93,2,13,20,15,159,35,35,
35,35,20,103,159,35,16,0,16,1,33,32,10,16,5,93,2,7,89,162,8,
44,36,52,9,223,0,33,33,35,20,103,159,35,16,1,20,25,159,36,2,2,
2,13,16,0,11,16,5,93,2,9,89,162,8,44,36,52,9,223,0,33,34,
35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,
2,12,89,162,8,44,36,52,9,223,0,33,35,35,20,103,159,35,16,1,20,
25,159,36,2,2,2,13,16,1,33,36,11,16,5,93,2,5,89,162,8,44,
36,55,9,223,0,33,37,35,20,103,159,35,16,1,20,25,159,36,2,2,2,
13,16,1,33,38,11,16,5,93,2,3,89,162,8,44,36,57,9,223,0,33,
41,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,
93,2,10,89,162,8,44,36,52,9,223,0,33,43,35,20,103,159,35,16,1,
20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,6,89,162,8,44,36,
53,9,223,0,33,44,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,
16,0,11,16,5,93,2,11,89,162,8,44,36,54,9,223,0,33,45,35,20,
103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,8,
89,162,8,44,36,57,9,223,0,33,46,35,20,103,159,35,16,1,20,25,159,
36,2,2,2,13,16,1,33,48,11,16,5,93,2,4,89,162,8,44,36,53,
9,223,0,33,49,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,
0,11,16,0,94,2,15,2,16,93,2,15,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 2031);
35,20,103,159,35,16,1,2,1,16,0,83,158,41,20,100,138,69,35,37,109,
105,110,45,115,116,120,2,2,11,10,11,10,35,80,158,35,35,20,103,159,35,
16,0,16,0,11,11,16,0,35,11,38,35,11,11,16,10,2,3,2,4,2,
5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,16,10,11,11,11,11,
11,11,11,11,11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,
9,2,10,2,11,2,12,35,45,36,11,11,16,0,16,0,16,0,35,35,11,
11,11,16,0,16,0,16,0,35,35,16,11,16,5,93,2,13,20,15,159,35,
35,35,35,20,103,159,35,16,0,16,1,33,32,10,16,5,93,2,8,89,162,
8,44,36,52,9,223,0,33,33,35,20,103,159,35,16,1,20,25,159,36,2,
2,2,13,16,0,11,16,5,93,2,10,89,162,8,44,36,52,9,223,0,33,
34,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,
93,2,12,89,162,8,44,36,52,9,223,0,33,35,35,20,103,159,35,16,1,
20,25,159,36,2,2,2,13,16,1,33,36,11,16,5,93,2,5,89,162,8,
44,36,55,9,223,0,33,37,35,20,103,159,35,16,1,20,25,159,36,2,2,
2,13,16,1,33,38,11,16,5,93,2,3,89,162,8,44,36,57,9,223,0,
33,41,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,
5,93,2,11,89,162,8,44,36,52,9,223,0,33,43,35,20,103,159,35,16,
1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,7,89,162,8,44,
36,53,9,223,0,33,44,35,20,103,159,35,16,1,20,25,159,36,2,2,2,
13,16,0,11,16,5,93,2,6,89,162,8,44,36,54,9,223,0,33,45,35,
20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,
9,89,162,8,44,36,57,9,223,0,33,46,35,20,103,159,35,16,1,20,25,
159,36,2,2,2,13,16,1,33,48,11,16,5,93,2,4,89,162,8,44,36,
53,9,223,0,33,49,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,
16,0,11,16,0,94,2,15,2,16,93,2,15,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 2032);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,48,46,51,59,0,0,0,1,0,0,3,0,16,0,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,48,46,52,59,0,0,0,1,0,0,3,0,16,0,
21,0,38,0,53,0,71,0,87,0,97,0,115,0,135,0,151,0,169,0,200,
0,229,0,251,0,9,1,15,1,29,1,34,1,44,1,52,1,80,1,112,1,
157,1,202,1,226,1,9,2,11,2,68,2,158,3,199,3,33,5,137,5,241,
5,102,6,116,6,150,6,166,6,16,8,30,8,193,8,200,9,206,10,213,10,
219,10,91,11,104,11,59,12,161,12,174,12,196,12,148,13,52,14,123,15,131,
15,139,15,165,15,19,16,0,0,53,19,0,0,29,11,11,72,112,97,116,104,
15,139,15,165,15,19,16,0,0,54,19,0,0,29,11,11,72,112,97,116,104,
45,115,116,114,105,110,103,63,64,98,115,98,115,76,110,111,114,109,97,108,45,
99,97,115,101,45,112,97,116,104,74,45,99,104,101,99,107,45,114,101,108,112,
97,116,104,77,45,99,104,101,99,107,45,99,111,108,108,101,99,116,105,111,110,
@ -131,241 +131,241 @@
32,98,121,116,101,32,115,116,114,105,110,103,6,36,36,99,97,110,110,111,116,
32,97,100,100,32,97,32,115,117,102,102,105,120,32,116,111,32,97,32,114,111,
111,116,32,112,97,116,104,58,32,5,0,27,20,14,159,80,158,36,50,250,80,
158,39,51,249,22,27,11,80,158,41,50,22,167,12,10,248,22,145,5,23,196,
2,28,248,22,141,6,23,194,2,12,87,94,248,22,154,8,23,194,1,248,80,
158,39,51,249,22,27,11,80,158,41,50,22,170,12,10,248,22,147,5,23,196,
2,28,248,22,144,6,23,194,2,12,87,94,248,22,157,8,23,194,1,248,80,
159,37,53,36,195,28,248,22,71,23,195,2,9,27,248,22,64,23,196,2,27,
28,248,22,148,13,23,195,2,23,194,1,28,248,22,147,13,23,195,2,249,22,
149,13,23,196,1,250,80,158,42,48,248,22,163,13,2,20,11,10,250,80,158,
40,48,248,22,163,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,
151,13,249,22,149,13,23,198,1,247,22,164,13,27,248,22,65,23,200,1,28,
248,22,71,23,194,2,9,27,248,22,64,23,195,2,27,28,248,22,148,13,23,
195,2,23,194,1,28,248,22,147,13,23,195,2,249,22,149,13,23,196,1,250,
80,158,47,48,248,22,163,13,2,20,11,10,250,80,158,45,48,248,22,163,13,
2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,151,13,249,22,149,13,
23,198,1,247,22,164,13,248,80,159,45,52,36,248,22,65,23,199,1,87,94,
28,248,22,151,13,23,195,2,23,194,1,28,248,22,150,13,23,195,2,249,22,
152,13,23,196,1,250,80,158,42,48,248,22,166,13,2,20,11,10,250,80,158,
40,48,248,22,166,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,
154,13,249,22,152,13,23,198,1,247,22,167,13,27,248,22,65,23,200,1,28,
248,22,71,23,194,2,9,27,248,22,64,23,195,2,27,28,248,22,151,13,23,
195,2,23,194,1,28,248,22,150,13,23,195,2,249,22,152,13,23,196,1,250,
80,158,47,48,248,22,166,13,2,20,11,10,250,80,158,45,48,248,22,166,13,
2,20,23,197,1,10,28,23,193,2,249,22,63,248,22,154,13,249,22,152,13,
23,198,1,247,22,167,13,248,80,159,45,52,36,248,22,65,23,199,1,87,94,
23,193,1,248,80,159,43,52,36,248,22,65,23,197,1,87,94,23,193,1,27,
248,22,65,23,198,1,28,248,22,71,23,194,2,9,27,248,22,64,23,195,2,
27,28,248,22,148,13,23,195,2,23,194,1,28,248,22,147,13,23,195,2,249,
22,149,13,23,196,1,250,80,158,45,48,248,22,163,13,2,20,11,10,250,80,
158,43,48,248,22,163,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,
22,151,13,249,22,149,13,23,198,1,247,22,164,13,248,80,159,43,52,36,248,
22,65,23,199,1,248,80,159,41,52,36,248,22,65,196,27,248,22,188,12,23,
195,2,28,23,193,2,192,87,94,23,193,1,28,248,22,146,6,23,195,2,27,
248,22,146,13,195,28,192,192,248,22,147,13,195,11,87,94,28,28,248,22,189,
12,23,195,2,10,27,248,22,188,12,23,196,2,28,23,193,2,192,87,94,23,
193,1,28,248,22,146,6,23,196,2,27,248,22,146,13,23,197,2,28,23,193,
2,192,87,94,23,193,1,248,22,147,13,23,197,2,11,12,250,22,181,8,76,
27,28,248,22,151,13,23,195,2,23,194,1,28,248,22,150,13,23,195,2,249,
22,152,13,23,196,1,250,80,158,45,48,248,22,166,13,2,20,11,10,250,80,
158,43,48,248,22,166,13,2,20,23,197,1,10,28,23,193,2,249,22,63,248,
22,154,13,249,22,152,13,23,198,1,247,22,167,13,248,80,159,43,52,36,248,
22,65,23,199,1,248,80,159,41,52,36,248,22,65,196,27,248,22,191,12,23,
195,2,28,23,193,2,192,87,94,23,193,1,28,248,22,149,6,23,195,2,27,
248,22,149,13,195,28,192,192,248,22,150,13,195,11,87,94,28,28,248,22,128,
13,23,195,2,10,27,248,22,191,12,23,196,2,28,23,193,2,192,87,94,23,
193,1,28,248,22,149,6,23,196,2,27,248,22,149,13,23,197,2,28,23,193,
2,192,87,94,23,193,1,248,22,150,13,23,197,2,11,12,250,22,184,8,76,
110,111,114,109,97,108,45,112,97,116,104,45,99,97,115,101,6,42,42,112,97,
116,104,32,40,102,111,114,32,97,110,121,32,115,121,115,116,101,109,41,32,111,
114,32,118,97,108,105,100,45,112,97,116,104,32,115,116,114,105,110,103,23,197,
2,28,28,248,22,189,12,23,195,2,249,22,151,8,248,22,190,12,23,197,2,
2,21,249,22,151,8,247,22,165,7,2,21,27,28,248,22,146,6,23,196,2,
23,195,2,248,22,155,7,248,22,129,13,23,197,2,28,249,22,176,13,0,21,
2,28,28,248,22,128,13,23,195,2,249,22,154,8,248,22,129,13,23,197,2,
2,21,249,22,154,8,247,22,168,7,2,21,27,28,248,22,149,6,23,196,2,
23,195,2,248,22,158,7,248,22,132,13,23,197,2,28,249,22,179,13,0,21,
35,114,120,34,94,91,92,92,93,91,92,92,93,91,63,93,91,92,92,93,34,
23,195,2,28,248,22,146,6,195,248,22,132,13,195,194,27,248,22,185,6,23,
195,1,249,22,133,13,248,22,158,7,250,22,182,13,0,6,35,114,120,34,47,
34,28,249,22,176,13,0,22,35,114,120,34,91,47,92,92,93,91,46,32,93,
43,91,47,92,92,93,42,36,34,23,201,2,23,199,1,250,22,182,13,0,19,
23,195,2,28,248,22,149,6,195,248,22,135,13,195,194,27,248,22,188,6,23,
195,1,249,22,136,13,248,22,161,7,250,22,185,13,0,6,35,114,120,34,47,
34,28,249,22,179,13,0,22,35,114,120,34,91,47,92,92,93,91,46,32,93,
43,91,47,92,92,93,42,36,34,23,201,2,23,199,1,250,22,185,13,0,19,
35,114,120,34,91,32,46,93,43,40,91,47,92,92,93,42,41,36,34,23,202,
1,6,2,2,92,49,80,158,43,36,2,21,28,248,22,146,6,194,248,22,132,
13,194,193,87,94,28,27,248,22,188,12,23,196,2,28,23,193,2,192,87,94,
23,193,1,28,248,22,146,6,23,196,2,27,248,22,146,13,23,197,2,28,23,
193,2,192,87,94,23,193,1,248,22,147,13,23,197,2,11,12,250,22,181,8,
23,196,2,2,22,23,197,2,28,248,22,146,13,23,195,2,12,248,22,143,11,
249,22,152,10,248,22,175,6,250,22,130,7,2,23,23,200,1,23,201,1,247,
22,23,87,94,28,27,248,22,188,12,23,196,2,28,23,193,2,192,87,94,23,
193,1,28,248,22,146,6,23,196,2,27,248,22,146,13,23,197,2,28,23,193,
2,192,87,94,23,193,1,248,22,147,13,23,197,2,11,12,250,22,181,8,23,
196,2,2,22,23,197,2,28,248,22,146,13,23,195,2,12,248,22,143,11,249,
22,152,10,248,22,175,6,250,22,130,7,2,23,23,200,1,23,201,1,247,22,
23,87,94,87,94,28,27,248,22,188,12,23,196,2,28,23,193,2,192,87,94,
23,193,1,28,248,22,146,6,23,196,2,27,248,22,146,13,23,197,2,28,23,
193,2,192,87,94,23,193,1,248,22,147,13,23,197,2,11,12,250,22,181,8,
195,2,22,23,197,2,28,248,22,146,13,23,195,2,12,248,22,143,11,249,22,
152,10,248,22,175,6,250,22,130,7,2,23,199,23,201,1,247,22,23,249,22,
3,89,162,8,44,36,49,9,223,2,33,34,196,248,22,143,11,249,22,182,10,
1,6,2,2,92,49,80,158,43,36,2,21,28,248,22,149,6,194,248,22,135,
13,194,193,87,94,28,27,248,22,191,12,23,196,2,28,23,193,2,192,87,94,
23,193,1,28,248,22,149,6,23,196,2,27,248,22,149,13,23,197,2,28,23,
193,2,192,87,94,23,193,1,248,22,150,13,23,197,2,11,12,250,22,184,8,
23,196,2,2,22,23,197,2,28,248,22,149,13,23,195,2,12,248,22,146,11,
249,22,155,10,248,22,178,6,250,22,133,7,2,23,23,200,1,23,201,1,247,
22,23,87,94,28,27,248,22,191,12,23,196,2,28,23,193,2,192,87,94,23,
193,1,28,248,22,149,6,23,196,2,27,248,22,149,13,23,197,2,28,23,193,
2,192,87,94,23,193,1,248,22,150,13,23,197,2,11,12,250,22,184,8,23,
196,2,2,22,23,197,2,28,248,22,149,13,23,195,2,12,248,22,146,11,249,
22,155,10,248,22,178,6,250,22,133,7,2,23,23,200,1,23,201,1,247,22,
23,87,94,87,94,28,27,248,22,191,12,23,196,2,28,23,193,2,192,87,94,
23,193,1,28,248,22,149,6,23,196,2,27,248,22,149,13,23,197,2,28,23,
193,2,192,87,94,23,193,1,248,22,150,13,23,197,2,11,12,250,22,184,8,
195,2,22,23,197,2,28,248,22,149,13,23,195,2,12,248,22,146,11,249,22,
155,10,248,22,178,6,250,22,133,7,2,23,199,23,201,1,247,22,23,249,22,
3,89,162,8,44,36,49,9,223,2,33,34,196,248,22,146,11,249,22,185,10,
23,196,1,247,22,23,87,94,250,80,159,38,39,36,2,7,196,197,251,80,159,
39,41,36,2,7,32,0,89,162,8,44,36,44,9,222,33,36,197,198,32,38,
89,162,43,41,58,65,99,108,111,111,112,222,33,39,28,248,22,71,23,199,2,
87,94,23,198,1,248,23,196,1,251,22,130,7,2,24,23,199,1,28,248,22,
71,23,203,2,87,94,23,202,1,23,201,1,250,22,1,22,142,13,23,204,1,
23,205,1,23,198,1,27,249,22,142,13,248,22,64,23,202,2,23,199,2,28,
248,22,137,13,23,194,2,27,250,22,1,22,142,13,23,197,1,23,202,2,28,
248,22,137,13,23,194,2,192,87,94,23,193,1,27,248,22,65,23,202,1,28,
248,22,71,23,194,2,87,94,23,193,1,248,23,199,1,251,22,130,7,2,24,
87,94,23,198,1,248,23,196,1,251,22,133,7,2,24,23,199,1,28,248,22,
71,23,203,2,87,94,23,202,1,23,201,1,250,22,1,22,145,13,23,204,1,
23,205,1,23,198,1,27,249,22,145,13,248,22,64,23,202,2,23,199,2,28,
248,22,140,13,23,194,2,27,250,22,1,22,145,13,23,197,1,23,202,2,28,
248,22,140,13,23,194,2,192,87,94,23,193,1,27,248,22,65,23,202,1,28,
248,22,71,23,194,2,87,94,23,193,1,248,23,199,1,251,22,133,7,2,24,
23,202,1,28,248,22,71,23,206,2,87,94,23,205,1,23,204,1,250,22,1,
22,142,13,23,207,1,23,208,1,23,201,1,27,249,22,142,13,248,22,64,23,
197,2,23,202,2,28,248,22,137,13,23,194,2,27,250,22,1,22,142,13,23,
197,1,204,28,248,22,137,13,193,192,253,2,38,203,204,205,206,23,15,248,22,
22,145,13,23,207,1,23,208,1,23,201,1,27,249,22,145,13,248,22,64,23,
197,2,23,202,2,28,248,22,140,13,23,194,2,27,250,22,1,22,145,13,23,
197,1,204,28,248,22,140,13,193,192,253,2,38,203,204,205,206,23,15,248,22,
65,201,253,2,38,202,203,204,205,206,248,22,65,200,87,94,23,193,1,27,248,
22,65,23,201,1,28,248,22,71,23,194,2,87,94,23,193,1,248,23,198,1,
251,22,130,7,2,24,23,201,1,28,248,22,71,23,205,2,87,94,23,204,1,
23,203,1,250,22,1,22,142,13,23,206,1,23,207,1,23,200,1,27,249,22,
142,13,248,22,64,23,197,2,23,201,2,28,248,22,137,13,23,194,2,27,250,
22,1,22,142,13,23,197,1,203,28,248,22,137,13,193,192,253,2,38,202,203,
251,22,133,7,2,24,23,201,1,28,248,22,71,23,205,2,87,94,23,204,1,
23,203,1,250,22,1,22,145,13,23,206,1,23,207,1,23,200,1,27,249,22,
145,13,248,22,64,23,197,2,23,201,2,28,248,22,140,13,23,194,2,27,250,
22,1,22,145,13,23,197,1,203,28,248,22,140,13,193,192,253,2,38,202,203,
204,205,206,248,22,65,201,253,2,38,201,202,203,204,205,248,22,65,200,27,247,
22,165,13,253,2,38,198,199,200,201,202,198,87,95,28,28,248,22,189,12,23,
194,2,10,27,248,22,188,12,23,195,2,28,23,193,2,192,87,94,23,193,1,
28,248,22,146,6,23,195,2,27,248,22,146,13,23,196,2,28,23,193,2,192,
87,94,23,193,1,248,22,147,13,23,196,2,11,12,252,22,181,8,23,200,2,
2,25,35,23,198,2,23,199,2,28,28,248,22,146,6,23,195,2,10,248,22,
134,7,23,195,2,87,94,23,194,1,12,252,22,181,8,23,200,2,2,26,36,
23,198,2,23,199,1,91,159,38,11,90,161,38,35,11,248,22,145,13,23,197,
2,87,94,23,195,1,87,94,28,192,12,250,22,182,8,23,201,1,2,27,23,
22,168,13,253,2,38,198,199,200,201,202,198,87,95,28,28,248,22,128,13,23,
194,2,10,27,248,22,191,12,23,195,2,28,23,193,2,192,87,94,23,193,1,
28,248,22,149,6,23,195,2,27,248,22,149,13,23,196,2,28,23,193,2,192,
87,94,23,193,1,248,22,150,13,23,196,2,11,12,252,22,184,8,23,200,2,
2,25,35,23,198,2,23,199,2,28,28,248,22,149,6,23,195,2,10,248,22,
137,7,23,195,2,87,94,23,194,1,12,252,22,184,8,23,200,2,2,26,36,
23,198,2,23,199,1,91,159,38,11,90,161,38,35,11,248,22,148,13,23,197,
2,87,94,23,195,1,87,94,28,192,12,250,22,185,8,23,201,1,2,27,23,
199,1,249,22,7,194,195,91,159,37,11,90,161,37,35,11,87,95,28,28,248,
22,189,12,23,196,2,10,27,248,22,188,12,23,197,2,28,23,193,2,192,87,
94,23,193,1,28,248,22,146,6,23,197,2,27,248,22,146,13,23,198,2,28,
23,193,2,192,87,94,23,193,1,248,22,147,13,23,198,2,11,12,252,22,181,
8,2,10,2,25,35,23,200,2,23,201,2,28,28,248,22,146,6,23,197,2,
10,248,22,134,7,23,197,2,12,252,22,181,8,2,10,2,26,36,23,200,2,
23,201,2,91,159,38,11,90,161,38,35,11,248,22,145,13,23,199,2,87,94,
23,195,1,87,94,28,23,193,2,12,250,22,182,8,2,10,2,27,23,201,2,
249,22,7,23,195,1,23,196,1,27,249,22,134,13,250,22,181,13,0,18,35,
114,120,35,34,40,91,46,93,91,94,46,93,42,124,41,36,34,248,22,130,13,
23,201,1,28,248,22,146,6,23,203,2,249,22,158,7,23,204,1,8,63,23,
202,1,28,248,22,189,12,23,199,2,248,22,190,12,23,199,1,87,94,23,198,
1,247,22,191,12,28,248,22,188,12,194,249,22,142,13,195,194,192,91,159,37,
11,90,161,37,35,11,87,95,28,28,248,22,189,12,23,196,2,10,27,248,22,
188,12,23,197,2,28,23,193,2,192,87,94,23,193,1,28,248,22,146,6,23,
197,2,27,248,22,146,13,23,198,2,28,23,193,2,192,87,94,23,193,1,248,
22,147,13,23,198,2,11,12,252,22,181,8,2,11,2,25,35,23,200,2,23,
201,2,28,28,248,22,146,6,23,197,2,10,248,22,134,7,23,197,2,12,252,
22,181,8,2,11,2,26,36,23,200,2,23,201,2,91,159,38,11,90,161,38,
35,11,248,22,145,13,23,199,2,87,94,23,195,1,87,94,28,23,193,2,12,
250,22,182,8,2,11,2,27,23,201,2,249,22,7,23,195,1,23,196,1,27,
249,22,134,13,249,22,144,7,250,22,182,13,0,9,35,114,120,35,34,91,46,
93,34,248,22,130,13,23,203,1,6,1,1,95,28,248,22,146,6,23,202,2,
249,22,158,7,23,203,1,8,63,23,201,1,28,248,22,189,12,23,199,2,248,
22,190,12,23,199,1,87,94,23,198,1,247,22,191,12,28,248,22,188,12,194,
249,22,142,13,195,194,192,249,247,22,178,4,194,11,248,80,158,36,46,9,27,
247,22,167,13,249,80,158,38,47,28,23,195,2,27,248,22,163,7,6,11,11,
22,128,13,23,196,2,10,27,248,22,191,12,23,197,2,28,23,193,2,192,87,
94,23,193,1,28,248,22,149,6,23,197,2,27,248,22,149,13,23,198,2,28,
23,193,2,192,87,94,23,193,1,248,22,150,13,23,198,2,11,12,252,22,184,
8,2,10,2,25,35,23,200,2,23,201,2,28,28,248,22,149,6,23,197,2,
10,248,22,137,7,23,197,2,12,252,22,184,8,2,10,2,26,36,23,200,2,
23,201,2,91,159,38,11,90,161,38,35,11,248,22,148,13,23,199,2,87,94,
23,195,1,87,94,28,23,193,2,12,250,22,185,8,2,10,2,27,23,201,2,
249,22,7,23,195,1,23,196,1,27,249,22,137,13,250,22,184,13,0,18,35,
114,120,35,34,40,91,46,93,91,94,46,93,42,124,41,36,34,248,22,133,13,
23,201,1,28,248,22,149,6,23,203,2,249,22,161,7,23,204,1,8,63,23,
202,1,28,248,22,128,13,23,199,2,248,22,129,13,23,199,1,87,94,23,198,
1,247,22,130,13,28,248,22,191,12,194,249,22,145,13,195,194,192,91,159,37,
11,90,161,37,35,11,87,95,28,28,248,22,128,13,23,196,2,10,27,248,22,
191,12,23,197,2,28,23,193,2,192,87,94,23,193,1,28,248,22,149,6,23,
197,2,27,248,22,149,13,23,198,2,28,23,193,2,192,87,94,23,193,1,248,
22,150,13,23,198,2,11,12,252,22,184,8,2,11,2,25,35,23,200,2,23,
201,2,28,28,248,22,149,6,23,197,2,10,248,22,137,7,23,197,2,12,252,
22,184,8,2,11,2,26,36,23,200,2,23,201,2,91,159,38,11,90,161,38,
35,11,248,22,148,13,23,199,2,87,94,23,195,1,87,94,28,23,193,2,12,
250,22,185,8,2,11,2,27,23,201,2,249,22,7,23,195,1,23,196,1,27,
249,22,137,13,249,22,147,7,250,22,185,13,0,9,35,114,120,35,34,91,46,
93,34,248,22,133,13,23,203,1,6,1,1,95,28,248,22,149,6,23,202,2,
249,22,161,7,23,203,1,8,63,23,201,1,28,248,22,128,13,23,199,2,248,
22,129,13,23,199,1,87,94,23,198,1,247,22,130,13,28,248,22,191,12,194,
249,22,145,13,195,194,192,249,247,22,180,4,194,11,248,80,158,36,46,9,27,
247,22,170,13,249,80,158,38,47,28,23,195,2,27,248,22,166,7,6,11,11,
80,76,84,67,79,76,76,69,67,84,83,28,192,192,6,0,0,6,0,0,27,
28,23,196,1,250,22,142,13,248,22,163,13,69,97,100,100,111,110,45,100,105,
114,247,22,161,7,6,8,8,99,111,108,108,101,99,116,115,11,27,248,80,159,
41,52,36,249,22,77,23,202,1,248,22,73,248,22,163,13,72,99,111,108,108,
28,23,196,1,250,22,145,13,248,22,166,13,69,97,100,100,111,110,45,100,105,
114,247,22,164,7,6,8,8,99,111,108,108,101,99,116,115,11,27,248,80,159,
41,52,36,249,22,77,23,202,1,248,22,73,248,22,166,13,72,99,111,108,108,
101,99,116,115,45,100,105,114,28,23,194,2,249,22,63,23,196,1,23,195,1,
192,32,47,89,162,8,44,38,54,2,19,222,33,48,27,249,22,174,13,23,197,
192,32,47,89,162,8,44,38,54,2,19,222,33,48,27,249,22,177,13,23,197,
2,23,198,2,28,23,193,2,87,94,23,196,1,27,248,22,88,23,195,2,27,
27,248,22,97,23,197,1,27,249,22,174,13,23,201,2,23,196,2,28,23,193,
27,248,22,97,23,197,1,27,249,22,177,13,23,201,2,23,196,2,28,23,193,
2,87,94,23,194,1,27,248,22,88,23,195,2,27,250,2,47,23,203,2,23,
204,1,248,22,97,23,199,1,28,249,22,140,7,23,196,2,2,28,249,22,77,
23,202,2,194,249,22,63,248,22,133,13,23,197,1,23,195,1,87,95,23,199,
1,23,193,1,28,249,22,140,7,23,196,2,2,28,249,22,77,23,200,2,9,
249,22,63,248,22,133,13,23,197,1,9,28,249,22,140,7,23,196,2,2,28,
249,22,77,197,194,87,94,23,196,1,249,22,63,248,22,133,13,23,197,1,194,
87,94,23,193,1,28,249,22,140,7,23,198,2,2,28,249,22,77,195,9,87,
94,23,194,1,249,22,63,248,22,133,13,23,199,1,9,87,95,28,28,248,22,
134,7,194,10,248,22,146,6,194,12,250,22,181,8,2,14,6,21,21,98,121,
204,1,248,22,97,23,199,1,28,249,22,143,7,23,196,2,2,28,249,22,77,
23,202,2,194,249,22,63,248,22,136,13,23,197,1,23,195,1,87,95,23,199,
1,23,193,1,28,249,22,143,7,23,196,2,2,28,249,22,77,23,200,2,9,
249,22,63,248,22,136,13,23,197,1,9,28,249,22,143,7,23,196,2,2,28,
249,22,77,197,194,87,94,23,196,1,249,22,63,248,22,136,13,23,197,1,194,
87,94,23,193,1,28,249,22,143,7,23,198,2,2,28,249,22,77,195,9,87,
94,23,194,1,249,22,63,248,22,136,13,23,199,1,9,87,95,28,28,248,22,
137,7,194,10,248,22,149,6,194,12,250,22,184,8,2,14,6,21,21,98,121,
116,101,32,115,116,114,105,110,103,32,111,114,32,115,116,114,105,110,103,196,28,
28,248,22,72,195,249,22,4,22,188,12,196,11,12,250,22,181,8,2,14,6,
28,248,22,72,195,249,22,4,22,191,12,196,11,12,250,22,184,8,2,14,6,
13,13,108,105,115,116,32,111,102,32,112,97,116,104,115,197,250,2,47,197,195,
28,248,22,146,6,197,248,22,157,7,197,196,32,50,89,162,8,44,39,57,2,
28,248,22,149,6,197,248,22,160,7,197,196,32,50,89,162,8,44,39,57,2,
19,222,33,53,32,51,89,162,8,44,38,54,70,102,111,117,110,100,45,101,120,
101,99,222,33,52,28,23,193,2,91,159,38,11,90,161,38,35,11,248,22,145,
13,23,199,2,87,95,23,195,1,23,194,1,27,28,23,198,2,27,248,22,150,
13,23,201,2,28,249,22,153,8,23,195,2,23,202,2,11,28,248,22,146,13,
23,194,2,250,2,51,23,201,2,23,202,2,249,22,142,13,23,200,2,23,198,
101,99,222,33,52,28,23,193,2,91,159,38,11,90,161,38,35,11,248,22,148,
13,23,199,2,87,95,23,195,1,23,194,1,27,28,23,198,2,27,248,22,153,
13,23,201,2,28,249,22,156,8,23,195,2,23,202,2,11,28,248,22,149,13,
23,194,2,250,2,51,23,201,2,23,202,2,249,22,145,13,23,200,2,23,198,
1,250,2,51,23,201,2,23,202,2,23,196,1,11,28,23,193,2,192,87,94,
23,193,1,27,28,248,22,188,12,23,196,2,27,249,22,142,13,23,198,2,23,
201,2,28,28,248,22,137,13,193,10,248,22,136,13,193,192,11,11,28,23,193,
2,192,87,94,23,193,1,28,23,199,2,11,27,248,22,150,13,23,202,2,28,
249,22,153,8,23,195,2,23,203,1,11,28,248,22,146,13,23,194,2,250,2,
51,23,202,1,23,203,1,249,22,142,13,23,201,1,23,198,1,250,2,51,201,
202,195,194,28,248,22,71,23,197,2,11,27,248,22,149,13,248,22,64,23,199,
2,27,249,22,142,13,23,196,1,23,197,2,28,248,22,136,13,23,194,2,250,
23,193,1,27,28,248,22,191,12,23,196,2,27,249,22,145,13,23,198,2,23,
201,2,28,28,248,22,140,13,193,10,248,22,139,13,193,192,11,11,28,23,193,
2,192,87,94,23,193,1,28,23,199,2,11,27,248,22,153,13,23,202,2,28,
249,22,156,8,23,195,2,23,203,1,11,28,248,22,149,13,23,194,2,250,2,
51,23,202,1,23,203,1,249,22,145,13,23,201,1,23,198,1,250,2,51,201,
202,195,194,28,248,22,71,23,197,2,11,27,248,22,152,13,248,22,64,23,199,
2,27,249,22,145,13,23,196,1,23,197,2,28,248,22,139,13,23,194,2,250,
2,51,198,199,195,87,94,23,193,1,27,248,22,65,23,200,1,28,248,22,71,
23,194,2,11,27,248,22,149,13,248,22,64,23,196,2,27,249,22,142,13,23,
196,1,23,200,2,28,248,22,136,13,23,194,2,250,2,51,201,202,195,87,94,
23,194,2,11,27,248,22,152,13,248,22,64,23,196,2,27,249,22,145,13,23,
196,1,23,200,2,28,248,22,139,13,23,194,2,250,2,51,201,202,195,87,94,
23,193,1,27,248,22,65,23,197,1,28,248,22,71,23,194,2,11,27,248,22,
149,13,248,22,64,195,27,249,22,142,13,23,196,1,202,28,248,22,136,13,193,
152,13,248,22,64,195,27,249,22,145,13,23,196,1,202,28,248,22,139,13,193,
250,2,51,204,205,195,251,2,50,204,205,206,248,22,65,199,87,95,28,27,248,
22,188,12,23,196,2,28,23,193,2,192,87,94,23,193,1,28,248,22,146,6,
23,196,2,27,248,22,146,13,23,197,2,28,23,193,2,192,87,94,23,193,1,
248,22,147,13,23,197,2,11,12,250,22,181,8,2,15,6,25,25,112,97,116,
22,191,12,23,196,2,28,23,193,2,192,87,94,23,193,1,28,248,22,149,6,
23,196,2,27,248,22,149,13,23,197,2,28,23,193,2,192,87,94,23,193,1,
248,22,150,13,23,197,2,11,12,250,22,184,8,2,15,6,25,25,112,97,116,
104,32,111,114,32,115,116,114,105,110,103,32,40,115,97,110,115,32,110,117,108,
41,23,197,2,28,28,23,195,2,28,27,248,22,188,12,23,197,2,28,23,193,
2,192,87,94,23,193,1,28,248,22,146,6,23,197,2,27,248,22,146,13,23,
198,2,28,23,193,2,192,87,94,23,193,1,248,22,147,13,23,198,2,11,248,
22,146,13,23,196,2,11,10,12,250,22,181,8,2,15,6,29,29,35,102,32,
41,23,197,2,28,28,23,195,2,28,27,248,22,191,12,23,197,2,28,23,193,
2,192,87,94,23,193,1,28,248,22,149,6,23,197,2,27,248,22,149,13,23,
198,2,28,23,193,2,192,87,94,23,193,1,248,22,150,13,23,198,2,11,248,
22,149,13,23,196,2,11,10,12,250,22,184,8,2,15,6,29,29,35,102,32,
111,114,32,114,101,108,97,116,105,118,101,32,112,97,116,104,32,111,114,32,115,
116,114,105,110,103,23,198,2,28,28,248,22,146,13,23,195,2,91,159,38,11,
90,161,38,35,11,248,22,145,13,23,198,2,249,22,151,8,194,68,114,101,108,
97,116,105,118,101,11,27,248,22,163,7,6,4,4,80,65,84,72,251,2,50,
116,114,105,110,103,23,198,2,28,28,248,22,149,13,23,195,2,91,159,38,11,
90,161,38,35,11,248,22,148,13,23,198,2,249,22,154,8,194,68,114,101,108,
97,116,105,118,101,11,27,248,22,166,7,6,4,4,80,65,84,72,251,2,50,
23,199,1,23,200,1,23,201,1,28,23,197,2,27,249,80,158,43,47,23,200,
1,9,28,249,22,151,8,247,22,165,7,2,21,249,22,63,248,22,133,13,5,
1,46,23,195,1,192,9,27,248,22,149,13,23,196,1,28,248,22,136,13,193,
1,9,28,249,22,154,8,247,22,168,7,2,21,249,22,63,248,22,136,13,5,
1,46,23,195,1,192,9,27,248,22,152,13,23,196,1,28,248,22,139,13,193,
250,2,51,198,199,195,11,250,80,158,38,48,196,197,11,250,80,158,38,48,196,
11,11,87,94,249,22,137,6,247,22,174,4,195,248,22,163,5,249,22,163,3,
11,11,87,94,249,22,140,6,247,22,176,4,195,248,22,166,5,249,22,163,3,
35,249,22,147,3,197,198,27,28,23,197,2,87,95,23,196,1,23,195,1,23,
197,1,87,94,23,197,1,27,248,22,163,13,2,20,27,249,80,158,40,48,23,
197,1,87,94,23,197,1,27,248,22,166,13,2,20,27,249,80,158,40,48,23,
196,1,11,27,27,248,22,166,3,23,200,1,28,192,192,35,27,27,248,22,166,
3,23,202,1,28,192,192,35,249,22,141,5,23,197,1,83,158,39,20,97,95,
3,23,202,1,28,192,192,35,249,22,143,5,23,197,1,83,158,39,20,97,95,
89,162,8,44,35,47,9,224,3,2,33,57,23,195,1,23,196,1,27,248,22,
190,4,23,195,1,248,80,159,38,53,36,193,159,35,20,103,159,35,16,1,65,
98,101,103,105,110,16,0,83,158,41,20,100,137,67,35,37,117,116,105,108,115,
2,1,11,10,10,42,80,158,35,35,20,103,159,37,16,17,30,2,1,2,2,
193,30,2,1,2,3,193,30,2,1,2,4,193,30,2,1,2,5,193,30,2,
1,2,6,193,30,2,1,2,7,193,30,2,1,2,8,193,30,2,1,2,9,
193,30,2,1,2,10,193,30,2,1,2,11,193,30,2,1,2,12,193,30,2,
1,2,13,193,30,2,1,2,14,193,30,2,1,2,15,193,30,2,1,2,16,
193,30,2,18,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,
110,45,107,101,121,4,30,2,18,1,23,101,120,116,101,110,100,45,112,97,114,
97,109,101,116,101,114,105,122,97,116,105,111,110,3,16,0,11,11,16,4,2,
6,2,5,2,3,2,9,39,11,38,35,11,11,16,11,2,8,2,7,2,16,
2,15,2,13,2,12,2,4,2,11,2,14,2,10,2,2,16,11,11,11,11,
11,11,11,11,11,11,11,11,16,11,2,8,2,7,2,16,2,15,2,13,2,
12,2,4,2,11,2,14,2,10,2,2,46,46,36,11,11,16,0,16,0,16,
0,35,35,11,11,11,16,0,16,0,16,0,35,35,16,0,16,17,83,158,35,
16,2,89,162,43,36,48,2,19,223,0,33,29,80,159,35,53,36,83,158,35,
16,2,89,162,8,44,36,55,2,19,223,0,33,30,80,159,35,52,36,83,158,
35,16,2,32,0,89,162,43,36,44,2,2,222,33,31,80,159,35,35,36,83,
158,35,16,2,249,22,148,6,7,92,7,92,80,159,35,36,36,83,158,35,16,
2,89,162,43,36,53,2,4,223,0,33,32,80,159,35,37,36,83,158,35,16,
2,32,0,89,162,8,44,37,49,2,5,222,33,33,80,159,35,38,36,83,158,
35,16,2,32,0,89,162,8,44,38,50,2,6,222,33,35,80,159,35,39,36,
83,158,35,16,2,89,162,8,45,37,47,2,7,223,0,33,37,80,159,35,40,
36,83,158,35,16,2,32,0,89,162,43,39,51,2,8,222,33,40,80,159,35,
41,36,83,158,35,16,2,32,0,89,162,43,38,49,2,9,222,33,41,80,159,
35,42,36,83,158,35,16,2,32,0,89,162,43,37,52,2,10,222,33,42,80,
159,35,43,36,83,158,35,16,2,32,0,89,162,43,37,53,2,11,222,33,43,
80,159,35,44,36,83,158,35,16,2,32,0,89,162,43,36,43,2,12,222,33,
44,80,159,35,45,36,83,158,35,16,2,83,158,38,20,96,95,2,13,89,162,
43,35,42,9,223,0,33,45,89,162,43,36,52,9,223,0,33,46,80,159,35,
46,36,83,158,35,16,2,27,248,22,170,13,248,22,157,7,27,28,249,22,151,
8,247,22,165,7,2,21,6,1,1,59,6,1,1,58,250,22,130,7,6,14,
14,40,91,94,126,97,93,42,41,126,97,40,46,42,41,23,196,2,23,196,1,
89,162,8,44,37,47,2,14,223,0,33,49,80,159,35,47,36,83,158,35,16,
2,83,158,38,20,96,96,2,15,89,162,8,44,38,53,9,223,0,33,54,89,
162,43,37,46,9,223,0,33,55,89,162,43,36,45,9,223,0,33,56,80,159,
35,48,36,83,158,35,16,2,89,162,43,38,51,2,16,223,0,33,58,80,159,
35,49,36,94,29,94,2,17,68,35,37,107,101,114,110,101,108,11,29,94,2,
17,69,35,37,109,105,110,45,115,116,120,11,9,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 5056);
128,5,23,195,1,248,80,159,38,53,36,193,159,35,20,103,159,35,16,1,65,
98,101,103,105,110,16,0,83,158,41,20,100,138,67,35,37,117,116,105,108,115,
2,1,11,11,10,10,42,80,158,35,35,20,103,159,37,16,17,30,2,1,2,
2,193,30,2,1,2,3,193,30,2,1,2,4,193,30,2,1,2,5,193,30,
2,1,2,6,193,30,2,1,2,7,193,30,2,1,2,8,193,30,2,1,2,
9,193,30,2,1,2,10,193,30,2,1,2,11,193,30,2,1,2,12,193,30,
2,1,2,13,193,30,2,1,2,14,193,30,2,1,2,15,193,30,2,1,2,
16,193,30,2,18,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,
111,110,45,107,101,121,4,30,2,18,1,23,101,120,116,101,110,100,45,112,97,
114,97,109,101,116,101,114,105,122,97,116,105,111,110,3,16,0,11,11,16,4,
2,6,2,5,2,3,2,9,39,11,38,35,11,11,16,11,2,8,2,7,2,
16,2,15,2,13,2,12,2,4,2,11,2,14,2,10,2,2,16,11,11,11,
11,11,11,11,11,11,11,11,11,16,11,2,8,2,7,2,16,2,15,2,13,
2,12,2,4,2,11,2,14,2,10,2,2,46,46,36,11,11,16,0,16,0,
16,0,35,35,11,11,11,16,0,16,0,16,0,35,35,16,0,16,17,83,158,
35,16,2,89,162,43,36,48,2,19,223,0,33,29,80,159,35,53,36,83,158,
35,16,2,89,162,8,44,36,55,2,19,223,0,33,30,80,159,35,52,36,83,
158,35,16,2,32,0,89,162,43,36,44,2,2,222,33,31,80,159,35,35,36,
83,158,35,16,2,249,22,151,6,7,92,7,92,80,159,35,36,36,83,158,35,
16,2,89,162,43,36,53,2,4,223,0,33,32,80,159,35,37,36,83,158,35,
16,2,32,0,89,162,8,44,37,49,2,5,222,33,33,80,159,35,38,36,83,
158,35,16,2,32,0,89,162,8,44,38,50,2,6,222,33,35,80,159,35,39,
36,83,158,35,16,2,89,162,8,45,37,47,2,7,223,0,33,37,80,159,35,
40,36,83,158,35,16,2,32,0,89,162,43,39,51,2,8,222,33,40,80,159,
35,41,36,83,158,35,16,2,32,0,89,162,43,38,49,2,9,222,33,41,80,
159,35,42,36,83,158,35,16,2,32,0,89,162,43,37,52,2,10,222,33,42,
80,159,35,43,36,83,158,35,16,2,32,0,89,162,43,37,53,2,11,222,33,
43,80,159,35,44,36,83,158,35,16,2,32,0,89,162,43,36,43,2,12,222,
33,44,80,159,35,45,36,83,158,35,16,2,83,158,38,20,96,95,2,13,89,
162,43,35,42,9,223,0,33,45,89,162,43,36,52,9,223,0,33,46,80,159,
35,46,36,83,158,35,16,2,27,248,22,173,13,248,22,160,7,27,28,249,22,
154,8,247,22,168,7,2,21,6,1,1,59,6,1,1,58,250,22,133,7,6,
14,14,40,91,94,126,97,93,42,41,126,97,40,46,42,41,23,196,2,23,196,
1,89,162,8,44,37,47,2,14,223,0,33,49,80,159,35,47,36,83,158,35,
16,2,83,158,38,20,96,96,2,15,89,162,8,44,38,53,9,223,0,33,54,
89,162,43,37,46,9,223,0,33,55,89,162,43,36,45,9,223,0,33,56,80,
159,35,48,36,83,158,35,16,2,89,162,43,38,51,2,16,223,0,33,58,80,
159,35,49,36,94,29,94,2,17,68,35,37,107,101,114,110,101,108,11,29,94,
2,17,69,35,37,109,105,110,45,115,116,120,11,9,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 5057);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,48,46,51,8,0,0,0,1,0,0,6,0,19,0,
34,0,48,0,62,0,76,0,111,0,0,0,254,0,0,0,65,113,117,111,116,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,48,46,52,8,0,0,0,1,0,0,6,0,19,0,
34,0,48,0,62,0,76,0,111,0,0,0,255,0,0,0,65,113,117,111,116,
101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37,
110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122,
11,29,94,2,1,68,35,37,101,120,112,111,98,115,11,29,94,2,1,68,35,
37,107,101,114,110,101,108,11,98,10,35,11,8,157,228,97,159,2,2,35,35,
37,107,101,114,110,101,108,11,98,10,35,11,8,149,227,97,159,2,2,35,35,
159,2,3,35,35,159,2,4,35,35,159,2,5,35,35,159,2,6,35,35,16,
0,159,35,20,103,159,35,16,1,65,98,101,103,105,110,16,0,83,158,41,20,
100,137,69,35,37,98,117,105,108,116,105,110,29,11,11,10,10,18,96,11,42,
42,42,35,80,158,35,35,20,103,159,35,16,0,16,0,11,11,16,0,35,11,
38,35,11,11,16,0,16,0,16,0,35,35,36,11,11,16,0,16,0,16,0,
35,35,11,11,11,16,0,16,0,16,0,35,35,16,0,16,0,99,2,6,2,
5,29,94,2,1,69,35,37,102,111,114,101,105,103,110,11,2,4,2,3,2,
2,29,94,2,1,67,35,37,112,108,97,99,101,11,9,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 291);
100,138,69,35,37,98,117,105,108,116,105,110,29,11,11,11,10,10,18,96,11,
42,42,42,35,80,158,35,35,20,103,159,35,16,0,16,0,11,11,16,0,35,
11,38,35,11,11,16,0,16,0,16,0,35,35,36,11,11,16,0,16,0,16,
0,35,35,11,11,11,16,0,16,0,16,0,35,35,16,0,16,0,99,2,6,
2,5,29,94,2,1,69,35,37,102,111,114,101,105,103,110,11,2,4,2,3,
2,2,29,94,2,1,67,35,37,112,108,97,99,101,11,9,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 292);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,48,46,51,52,0,0,0,1,0,0,3,0,14,0,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,48,46,52,52,0,0,0,1,0,0,3,0,14,0,
41,0,47,0,60,0,74,0,96,0,122,0,134,0,152,0,172,0,184,0,200,
0,223,0,3,1,8,1,13,1,18,1,23,1,54,1,58,1,66,1,74,1,
82,1,185,1,230,1,250,1,29,2,64,2,98,2,108,2,155,2,165,2,172,
2,71,4,84,4,103,4,222,4,234,4,138,5,152,5,16,6,22,6,36,6,
63,6,148,6,150,6,211,6,142,12,201,12,233,12,0,0,156,15,0,0,29,
63,6,148,6,150,6,211,6,142,12,201,12,233,12,0,0,157,15,0,0,29,
11,11,70,100,108,108,45,115,117,102,102,105,120,1,25,100,101,102,97,117,108,
116,45,108,111,97,100,47,117,115,101,45,99,111,109,112,105,108,101,100,65,113,
117,111,116,101,29,94,2,4,67,35,37,117,116,105,108,115,11,29,94,2,4,
@ -382,31 +382,31 @@
64,108,111,111,112,1,29,115,116,97,110,100,97,114,100,45,109,111,100,117,108,
101,45,110,97,109,101,45,114,101,115,111,108,118,101,114,63,108,105,98,67,105,
103,110,111,114,101,100,249,22,14,195,80,158,37,45,249,80,159,37,48,36,195,
10,27,28,23,195,2,28,249,22,151,8,23,197,2,80,158,38,46,87,94,23,
195,1,80,158,36,47,27,248,22,162,4,23,197,2,28,248,22,188,12,23,194,
2,91,159,38,11,90,161,38,35,11,248,22,145,13,23,197,1,87,95,83,160,
10,27,28,23,195,2,28,249,22,154,8,23,197,2,80,158,38,46,87,94,23,
195,1,80,158,36,47,27,248,22,163,4,23,197,2,28,248,22,191,12,23,194,
2,91,159,38,11,90,161,38,35,11,248,22,148,13,23,197,1,87,95,83,160,
37,11,80,158,40,46,198,83,160,37,11,80,158,40,47,192,192,11,11,28,23,
193,2,192,87,94,23,193,1,27,247,22,179,4,28,192,192,247,22,164,13,20,
14,159,80,158,35,39,250,80,158,38,40,249,22,27,11,80,158,40,39,22,179,
4,28,248,22,188,12,23,198,2,23,197,1,87,94,23,197,1,247,22,164,13,
247,194,250,22,142,13,23,197,1,23,199,1,249,80,158,42,38,23,198,1,2,
18,252,22,142,13,23,199,1,23,201,1,6,6,6,110,97,116,105,118,101,247,
22,166,7,249,80,158,44,38,23,200,1,80,158,44,35,87,94,23,194,1,27,
23,194,1,27,250,22,159,13,196,11,32,0,89,162,8,44,35,40,9,222,11,
28,192,249,22,63,195,194,11,27,248,23,195,1,23,196,1,27,250,22,159,13,
193,2,192,87,94,23,193,1,27,247,22,181,4,28,192,192,247,22,167,13,20,
14,159,80,158,35,39,250,80,158,38,40,249,22,27,11,80,158,40,39,22,181,
4,28,248,22,191,12,23,198,2,23,197,1,87,94,23,197,1,247,22,167,13,
247,194,250,22,145,13,23,197,1,23,199,1,249,80,158,42,38,23,198,1,2,
18,252,22,145,13,23,199,1,23,201,1,6,6,6,110,97,116,105,118,101,247,
22,169,7,249,80,158,44,38,23,200,1,80,158,44,35,87,94,23,194,1,27,
23,194,1,27,250,22,162,13,196,11,32,0,89,162,8,44,35,40,9,222,11,
28,192,249,22,63,195,194,11,27,248,23,195,1,23,196,1,27,250,22,162,13,
196,11,32,0,89,162,8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,
249,247,22,169,13,248,22,64,195,195,27,250,22,142,13,23,198,1,23,200,1,
249,80,158,43,38,23,199,1,2,18,27,250,22,159,13,196,11,32,0,89,162,
8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,249,247,22,177,4,248,
22,64,195,195,249,247,22,177,4,194,195,87,94,28,248,80,158,36,37,23,195,
2,12,250,22,181,8,77,108,111,97,100,47,117,115,101,45,99,111,109,112,105,
249,247,22,172,13,248,22,64,195,195,27,250,22,145,13,23,198,1,23,200,1,
249,80,158,43,38,23,199,1,2,18,27,250,22,162,13,196,11,32,0,89,162,
8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,249,247,22,179,4,248,
22,64,195,195,249,247,22,179,4,194,195,87,94,28,248,80,158,36,37,23,195,
2,12,250,22,184,8,77,108,111,97,100,47,117,115,101,45,99,111,109,112,105,
108,101,100,6,25,25,112,97,116,104,32,111,114,32,118,97,108,105,100,45,112,
97,116,104,32,115,116,114,105,110,103,23,197,2,91,159,41,11,90,161,36,35,
11,28,248,22,148,13,23,201,2,23,200,1,27,247,22,179,4,28,23,193,2,
249,22,149,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,145,13,23,
194,2,87,94,23,196,1,90,161,36,39,11,28,249,22,151,8,23,196,2,68,
11,28,248,22,151,13,23,201,2,23,200,1,27,247,22,181,4,28,23,193,2,
249,22,152,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,148,13,23,
194,2,87,94,23,196,1,90,161,36,39,11,28,249,22,154,8,23,196,2,68,
114,101,108,97,116,105,118,101,87,94,23,194,1,2,17,23,194,1,90,161,36,
40,11,247,22,166,13,27,89,162,43,36,49,62,122,111,225,7,5,3,33,27,
40,11,247,22,169,13,27,89,162,43,36,49,62,122,111,225,7,5,3,33,27,
27,89,162,43,36,51,9,225,8,6,4,33,28,27,249,22,5,89,162,8,44,
36,47,9,223,5,33,29,23,203,2,27,28,23,195,2,27,249,22,5,83,158,
39,20,97,94,89,162,8,44,36,47,9,223,5,33,30,23,198,1,23,205,2,
@ -419,11 +419,11 @@
199,193,11,11,11,11,28,192,249,80,159,48,54,36,203,89,162,43,35,45,9,
224,15,2,33,33,249,80,159,48,54,36,203,89,162,43,35,44,9,224,15,7,
33,34,32,36,89,162,8,44,36,54,2,19,222,33,38,0,17,35,114,120,34,
94,40,46,42,63,41,47,40,46,42,41,36,34,27,249,22,174,13,2,37,23,
94,40,46,42,63,41,47,40,46,42,41,36,34,27,249,22,177,13,2,37,23,
196,2,28,23,193,2,87,94,23,194,1,249,22,63,248,22,88,23,196,2,27,
248,22,97,23,197,1,27,249,22,174,13,2,37,23,196,2,28,23,193,2,87,
248,22,97,23,197,1,27,249,22,177,13,2,37,23,196,2,28,23,193,2,87,
94,23,194,1,249,22,63,248,22,88,23,196,2,27,248,22,97,23,197,1,27,
249,22,174,13,2,37,23,196,2,28,23,193,2,87,94,23,194,1,249,22,63,
249,22,177,13,2,37,23,196,2,28,23,193,2,87,94,23,194,1,249,22,63,
248,22,88,23,196,2,248,2,36,248,22,97,23,197,1,248,22,73,194,248,22,
73,194,248,22,73,194,32,39,89,162,43,36,54,2,19,222,33,40,28,248,22,
71,248,22,65,23,195,2,249,22,7,9,248,22,64,195,91,159,37,11,90,161,
@ -434,128 +434,128 @@
249,22,7,249,22,63,248,22,64,23,200,1,23,197,1,23,196,1,249,22,7,
249,22,63,248,22,64,23,200,1,23,197,1,23,196,1,249,22,7,249,22,63,
248,22,64,23,200,1,23,197,1,195,27,248,2,36,23,195,1,28,194,192,248,
2,39,193,87,95,28,248,22,160,4,195,12,250,22,181,8,2,20,6,20,20,
2,39,193,87,95,28,248,22,161,4,195,12,250,22,184,8,2,20,6,20,20,
114,101,115,111,108,118,101,100,45,109,111,100,117,108,101,45,112,97,116,104,197,
28,24,193,2,248,24,194,1,195,87,94,23,193,1,12,27,27,250,22,133,2,
80,158,41,42,248,22,130,14,247,22,171,11,11,28,23,193,2,192,87,94,23,
193,1,27,247,22,121,87,94,250,22,131,2,80,158,42,42,248,22,130,14,247,
22,171,11,195,192,250,22,131,2,195,198,66,97,116,116,97,99,104,251,211,197,
198,199,10,28,192,250,22,180,8,11,196,195,248,22,178,8,194,28,249,22,152,
6,194,6,1,1,46,2,17,28,249,22,152,6,194,6,2,2,46,46,62,117,
112,192,28,249,22,153,8,248,22,65,23,200,2,23,197,1,28,249,22,151,8,
248,22,64,23,200,2,23,196,1,251,22,178,8,2,20,6,26,26,99,121,99,
80,158,41,42,248,22,133,14,247,22,174,11,11,28,23,193,2,192,87,94,23,
193,1,27,247,22,121,87,94,250,22,131,2,80,158,42,42,248,22,133,14,247,
22,174,11,195,192,250,22,131,2,195,198,66,97,116,116,97,99,104,251,211,197,
198,199,10,28,192,250,22,183,8,11,196,195,248,22,181,8,194,28,249,22,155,
6,194,6,1,1,46,2,17,28,249,22,155,6,194,6,2,2,46,46,62,117,
112,192,28,249,22,156,8,248,22,65,23,200,2,23,197,1,28,249,22,154,8,
248,22,64,23,200,2,23,196,1,251,22,181,8,2,20,6,26,26,99,121,99,
108,101,32,105,110,32,108,111,97,100,105,110,103,32,97,116,32,126,101,58,32,
126,101,23,200,1,249,22,2,22,65,248,22,78,249,22,63,23,206,1,23,202,
1,12,12,247,192,20,14,159,80,158,39,44,249,22,63,247,22,171,11,23,197,
1,12,12,247,192,20,14,159,80,158,39,44,249,22,63,247,22,174,11,23,197,
1,20,14,159,80,158,39,39,250,80,158,42,40,249,22,27,11,80,158,44,39,
22,143,4,23,196,1,249,247,22,178,4,23,198,1,248,22,52,248,22,128,13,
23,198,1,87,94,28,28,248,22,188,12,23,197,2,10,248,22,165,4,23,197,
2,12,28,23,198,2,250,22,180,8,11,6,15,15,98,97,100,32,109,111,100,
117,108,101,32,112,97,116,104,23,201,2,250,22,181,8,2,20,6,19,19,109,
22,143,4,23,196,1,249,247,22,180,4,23,198,1,248,22,52,248,22,131,13,
23,198,1,87,94,28,28,248,22,191,12,23,197,2,10,248,22,167,4,23,197,
2,12,28,23,198,2,250,22,183,8,11,6,15,15,98,97,100,32,109,111,100,
117,108,101,32,112,97,116,104,23,201,2,250,22,184,8,2,20,6,19,19,109,
111,100,117,108,101,45,112,97,116,104,32,111,114,32,112,97,116,104,23,199,2,
28,28,248,22,61,23,197,2,249,22,151,8,248,22,64,23,199,2,2,4,11,
248,22,161,4,248,22,88,197,28,28,248,22,61,23,197,2,249,22,151,8,248,
28,28,248,22,61,23,197,2,249,22,154,8,248,22,64,23,199,2,2,4,11,
248,22,162,4,248,22,88,197,28,28,248,22,61,23,197,2,249,22,154,8,248,
22,64,23,199,2,66,112,108,97,110,101,116,11,87,94,28,207,12,20,14,159,
80,158,37,39,250,80,158,40,40,249,22,27,11,80,158,42,39,22,171,11,23,
80,158,37,39,250,80,158,40,40,249,22,27,11,80,158,42,39,22,174,11,23,
197,1,90,161,36,35,10,249,22,144,4,21,94,2,21,6,18,18,112,108,97,
110,101,116,47,114,101,115,111,108,118,101,114,46,115,115,1,27,112,108,97,110,
101,116,45,109,111,100,117,108,101,45,110,97,109,101,45,114,101,115,111,108,118,
101,114,12,251,211,199,200,201,202,87,94,23,193,1,27,89,162,8,44,36,45,
79,115,104,111,119,45,99,111,108,108,101,99,116,105,111,110,45,101,114,114,223,
6,33,44,27,28,248,22,51,23,199,2,27,250,22,133,2,80,158,43,43,249,
22,63,23,204,2,247,22,165,13,11,28,23,193,2,192,87,94,23,193,1,91,
22,63,23,204,2,247,22,168,13,11,28,23,193,2,192,87,94,23,193,1,91,
159,37,11,90,161,37,35,11,249,80,159,44,48,36,248,22,54,23,204,2,11,
27,251,80,158,47,50,2,20,23,202,1,28,248,22,71,23,199,2,23,199,2,
248,22,64,23,199,2,28,248,22,71,23,199,2,9,248,22,65,23,199,2,249,
22,142,13,23,195,1,28,248,22,71,23,197,1,87,94,23,197,1,6,7,7,
109,97,105,110,46,115,115,249,22,169,6,23,199,1,6,3,3,46,115,115,28,
248,22,146,6,23,199,2,87,94,23,194,1,27,248,80,159,41,55,36,23,201,
22,145,13,23,195,1,28,248,22,71,23,197,1,87,94,23,197,1,6,7,7,
109,97,105,110,46,115,115,249,22,172,6,23,199,1,6,3,3,46,115,115,28,
248,22,149,6,23,199,2,87,94,23,194,1,27,248,80,159,41,55,36,23,201,
2,27,250,22,133,2,80,158,44,43,249,22,63,23,205,2,23,199,2,11,28,
23,193,2,192,87,94,23,193,1,91,159,37,11,90,161,37,35,11,249,80,159,
45,48,36,23,204,2,11,250,22,1,22,142,13,23,199,1,249,22,77,249,22,
45,48,36,23,204,2,11,250,22,1,22,145,13,23,199,1,249,22,77,249,22,
2,32,0,89,162,8,44,36,43,9,222,33,45,23,200,1,248,22,73,23,200,
1,28,248,22,188,12,23,199,2,87,94,23,194,1,28,248,22,147,13,23,199,
1,28,248,22,191,12,23,199,2,87,94,23,194,1,28,248,22,150,13,23,199,
2,23,198,2,248,22,73,6,26,26,32,40,97,32,112,97,116,104,32,109,117,
115,116,32,98,101,32,97,98,115,111,108,117,116,101,41,28,249,22,151,8,248,
115,116,32,98,101,32,97,98,115,111,108,117,116,101,41,28,249,22,154,8,248,
22,64,23,201,2,2,21,27,250,22,133,2,80,158,43,43,249,22,63,23,204,
2,247,22,165,13,11,28,23,193,2,192,87,94,23,193,1,91,159,38,11,90,
2,247,22,168,13,11,28,23,193,2,192,87,94,23,193,1,91,159,38,11,90,
161,37,35,11,249,80,159,45,48,36,248,22,88,23,205,2,11,90,161,36,37,
11,28,248,22,71,248,22,90,23,204,2,28,248,22,71,23,194,2,249,22,176,
11,28,248,22,71,248,22,90,23,204,2,28,248,22,71,23,194,2,249,22,179,
13,0,8,35,114,120,34,91,46,93,34,23,196,2,11,10,27,27,28,23,197,
2,249,22,77,28,248,22,71,248,22,90,23,208,2,21,93,6,5,5,109,122,
108,105,98,249,22,1,22,77,249,22,2,80,159,51,56,36,248,22,90,23,211,
2,23,197,2,28,248,22,71,23,196,2,248,22,73,23,197,2,23,195,2,251,
80,158,49,50,2,20,23,204,1,248,22,64,23,198,2,248,22,65,23,198,1,
249,22,142,13,23,195,1,28,23,198,1,87,94,23,196,1,23,197,1,28,248,
249,22,145,13,23,195,1,28,23,198,1,87,94,23,196,1,23,197,1,28,248,
22,71,23,197,1,87,94,23,197,1,6,7,7,109,97,105,110,46,115,115,28,
249,22,176,13,0,8,35,114,120,34,91,46,93,34,23,199,2,23,197,1,249,
22,169,6,23,199,1,6,3,3,46,115,115,28,249,22,151,8,248,22,64,23,
201,2,64,102,105,108,101,249,22,149,13,248,22,153,13,248,22,88,23,202,2,
248,80,159,42,55,36,23,202,2,12,87,94,28,28,248,22,188,12,23,194,2,
10,248,22,168,7,23,194,2,87,94,23,200,1,12,28,23,200,2,250,22,180,
8,67,114,101,113,117,105,114,101,249,22,130,7,6,17,17,98,97,100,32,109,
249,22,179,13,0,8,35,114,120,34,91,46,93,34,23,199,2,23,197,1,249,
22,172,6,23,199,1,6,3,3,46,115,115,28,249,22,154,8,248,22,64,23,
201,2,64,102,105,108,101,249,22,152,13,248,22,156,13,248,22,88,23,202,2,
248,80,159,42,55,36,23,202,2,12,87,94,28,28,248,22,191,12,23,194,2,
10,248,22,171,7,23,194,2,87,94,23,200,1,12,28,23,200,2,250,22,183,
8,67,114,101,113,117,105,114,101,249,22,133,7,6,17,17,98,97,100,32,109,
111,100,117,108,101,32,112,97,116,104,126,97,28,23,198,2,248,22,64,23,199,
2,6,0,0,23,203,1,87,94,23,200,1,250,22,181,8,2,20,249,22,130,
2,6,0,0,23,203,1,87,94,23,200,1,250,22,184,8,2,20,249,22,133,
7,6,13,13,109,111,100,117,108,101,32,112,97,116,104,126,97,28,23,198,2,
248,22,64,23,199,2,6,0,0,23,201,2,27,28,248,22,168,7,23,195,2,
249,22,173,7,23,196,2,35,249,22,151,13,248,22,152,13,23,197,2,11,27,
28,248,22,168,7,23,196,2,249,22,173,7,23,197,2,36,248,80,158,42,51,
23,195,2,91,159,38,11,90,161,38,35,11,28,248,22,168,7,23,199,2,250,
22,7,2,22,249,22,173,7,23,203,2,37,2,22,248,22,145,13,23,198,2,
87,95,23,195,1,23,193,1,27,28,248,22,168,7,23,200,2,249,22,173,7,
23,201,2,38,249,80,158,47,52,23,197,2,5,0,27,28,248,22,168,7,23,
201,2,249,22,173,7,23,202,2,39,248,22,161,4,23,200,2,27,27,250,22,
133,2,80,158,51,42,248,22,130,14,247,22,171,11,11,28,23,193,2,192,87,
94,23,193,1,27,247,22,121,87,94,250,22,131,2,80,158,52,42,248,22,130,
14,247,22,171,11,195,192,87,95,28,23,209,1,27,250,22,133,2,23,197,2,
248,22,64,23,199,2,6,0,0,23,201,2,27,28,248,22,171,7,23,195,2,
249,22,176,7,23,196,2,35,249,22,154,13,248,22,155,13,23,197,2,11,27,
28,248,22,171,7,23,196,2,249,22,176,7,23,197,2,36,248,80,158,42,51,
23,195,2,91,159,38,11,90,161,38,35,11,28,248,22,171,7,23,199,2,250,
22,7,2,22,249,22,176,7,23,203,2,37,2,22,248,22,148,13,23,198,2,
87,95,23,195,1,23,193,1,27,28,248,22,171,7,23,200,2,249,22,176,7,
23,201,2,38,249,80,158,47,52,23,197,2,5,0,27,28,248,22,171,7,23,
201,2,249,22,176,7,23,202,2,39,248,22,162,4,23,200,2,27,27,250,22,
133,2,80,158,51,42,248,22,133,14,247,22,174,11,11,28,23,193,2,192,87,
94,23,193,1,27,247,22,121,87,94,250,22,131,2,80,158,52,42,248,22,133,
14,247,22,174,11,195,192,87,95,28,23,209,1,27,250,22,133,2,23,197,2,
197,11,28,23,193,1,12,87,95,27,27,28,248,22,17,80,158,51,45,80,158,
50,45,247,22,19,250,22,25,248,22,23,23,197,2,80,158,53,44,23,196,1,
27,247,22,171,11,249,22,3,83,158,39,20,97,94,89,162,8,44,36,54,9,
27,247,22,174,11,249,22,3,83,158,39,20,97,94,89,162,8,44,36,54,9,
226,12,11,2,3,33,46,23,195,1,23,196,1,248,28,248,22,17,80,158,50,
45,32,0,89,162,43,36,41,9,222,33,47,80,159,49,57,36,89,162,43,35,
50,9,227,14,9,8,4,3,33,48,250,22,131,2,23,197,1,197,10,12,28,
28,248,22,168,7,23,202,1,11,27,248,22,146,6,23,208,2,28,192,192,28,
248,22,61,23,208,2,249,22,151,8,248,22,64,23,210,2,2,21,11,250,22,
131,2,80,158,50,43,28,248,22,146,6,23,210,2,249,22,63,23,211,1,248,
28,248,22,171,7,23,202,1,11,27,248,22,149,6,23,208,2,28,192,192,28,
248,22,61,23,208,2,249,22,154,8,248,22,64,23,210,2,2,21,11,250,22,
131,2,80,158,50,43,28,248,22,149,6,23,210,2,249,22,63,23,211,1,248,
80,159,53,55,36,23,213,1,87,94,23,210,1,249,22,63,23,211,1,247,22,
165,13,252,22,170,7,23,208,1,23,207,1,23,205,1,23,203,1,201,12,193,
168,13,252,22,173,7,23,208,1,23,207,1,23,205,1,23,203,1,201,12,193,
91,159,37,10,90,161,36,35,10,11,90,161,36,36,10,83,158,38,20,96,96,
2,20,89,162,8,44,36,50,9,224,2,0,33,42,89,162,43,38,48,9,223,
1,33,43,89,162,43,39,8,30,9,225,2,3,0,33,49,208,87,95,248,22,
142,4,248,80,158,37,49,247,22,171,11,248,22,178,4,80,158,36,36,248,22,
162,12,80,159,36,41,36,159,35,20,103,159,35,16,1,65,98,101,103,105,110,
16,0,83,158,41,20,100,137,66,35,37,98,111,111,116,2,1,11,10,10,36,
80,158,35,35,20,103,159,39,16,19,30,2,1,2,2,193,30,2,1,2,3,
193,30,2,5,72,112,97,116,104,45,115,116,114,105,110,103,63,10,30,2,5,
75,112,97,116,104,45,97,100,100,45,115,117,102,102,105,120,7,30,2,6,1,
20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121,
4,30,2,6,1,23,101,120,116,101,110,100,45,112,97,114,97,109,101,116,101,
114,105,122,97,116,105,111,110,3,30,2,1,2,7,193,30,2,1,2,8,193,
30,2,1,2,9,193,30,2,1,2,10,193,30,2,1,2,11,193,30,2,1,
2,12,193,30,2,1,2,13,193,30,2,1,2,14,193,30,2,1,2,15,193,
30,2,5,69,45,102,105,110,100,45,99,111,108,0,30,2,5,76,110,111,114,
109,97,108,45,99,97,115,101,45,112,97,116,104,6,30,2,5,79,112,97,116,
104,45,114,101,112,108,97,99,101,45,115,117,102,102,105,120,9,30,2,1,2,
16,193,16,0,11,11,16,11,2,10,2,11,2,8,2,9,2,12,2,13,2,
3,2,7,2,2,2,15,2,14,46,11,38,35,11,11,16,1,2,16,16,1,
11,16,1,2,16,36,36,36,11,11,16,0,16,0,16,0,35,35,11,11,11,
16,0,16,0,16,0,35,35,16,0,16,16,83,158,35,16,2,89,162,43,36,
44,9,223,0,33,23,80,159,35,57,36,83,158,35,16,2,89,162,43,36,44,
9,223,0,33,24,80,159,35,56,36,83,158,35,16,2,89,162,43,36,48,67,
103,101,116,45,100,105,114,223,0,33,25,80,159,35,55,36,83,158,35,16,2,
89,162,43,37,48,68,119,105,116,104,45,100,105,114,223,0,33,26,80,159,35,
54,36,83,158,35,16,2,248,22,165,7,69,115,111,45,115,117,102,102,105,120,
80,159,35,35,36,83,158,35,16,2,89,162,43,37,59,2,3,223,0,33,35,
80,159,35,36,36,83,158,35,16,2,32,0,89,162,8,44,36,41,2,7,222,
192,80,159,35,41,36,83,158,35,16,2,247,22,123,80,159,35,42,36,83,158,
35,16,2,247,22,122,80,159,35,43,36,83,158,35,16,2,247,22,59,80,159,
35,44,36,83,158,35,16,2,248,22,18,74,109,111,100,117,108,101,45,108,111,
97,100,105,110,103,80,159,35,45,36,83,158,35,16,2,11,80,158,35,46,83,
158,35,16,2,11,80,158,35,47,83,158,35,16,2,32,0,89,162,43,37,44,
2,14,222,33,41,80,159,35,48,36,83,158,35,16,2,89,162,8,44,36,44,
2,15,223,0,33,50,80,159,35,49,36,83,158,35,16,2,89,162,43,35,43,
2,16,223,0,33,51,80,159,35,53,36,95,29,94,2,4,68,35,37,107,101,
114,110,101,108,11,29,94,2,4,69,35,37,109,105,110,45,115,116,120,11,2,
5,9,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 4121);
142,4,248,80,158,37,49,247,22,174,11,248,22,180,4,80,158,36,36,248,22,
165,12,80,159,36,41,36,159,35,20,103,159,35,16,1,65,98,101,103,105,110,
16,0,83,158,41,20,100,138,66,35,37,98,111,111,116,2,1,11,11,10,10,
36,80,158,35,35,20,103,159,39,16,19,30,2,1,2,2,193,30,2,1,2,
3,193,30,2,5,72,112,97,116,104,45,115,116,114,105,110,103,63,10,30,2,
5,75,112,97,116,104,45,97,100,100,45,115,117,102,102,105,120,7,30,2,6,
1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,
121,4,30,2,6,1,23,101,120,116,101,110,100,45,112,97,114,97,109,101,116,
101,114,105,122,97,116,105,111,110,3,30,2,1,2,7,193,30,2,1,2,8,
193,30,2,1,2,9,193,30,2,1,2,10,193,30,2,1,2,11,193,30,2,
1,2,12,193,30,2,1,2,13,193,30,2,1,2,14,193,30,2,1,2,15,
193,30,2,5,69,45,102,105,110,100,45,99,111,108,0,30,2,5,76,110,111,
114,109,97,108,45,99,97,115,101,45,112,97,116,104,6,30,2,5,79,112,97,
116,104,45,114,101,112,108,97,99,101,45,115,117,102,102,105,120,9,30,2,1,
2,16,193,16,0,11,11,16,11,2,10,2,11,2,8,2,9,2,12,2,13,
2,3,2,7,2,2,2,15,2,14,46,11,38,35,11,11,16,1,2,16,16,
1,11,16,1,2,16,36,36,36,11,11,16,0,16,0,16,0,35,35,11,11,
11,16,0,16,0,16,0,35,35,16,0,16,16,83,158,35,16,2,89,162,43,
36,44,9,223,0,33,23,80,159,35,57,36,83,158,35,16,2,89,162,43,36,
44,9,223,0,33,24,80,159,35,56,36,83,158,35,16,2,89,162,43,36,48,
67,103,101,116,45,100,105,114,223,0,33,25,80,159,35,55,36,83,158,35,16,
2,89,162,43,37,48,68,119,105,116,104,45,100,105,114,223,0,33,26,80,159,
35,54,36,83,158,35,16,2,248,22,168,7,69,115,111,45,115,117,102,102,105,
120,80,159,35,35,36,83,158,35,16,2,89,162,43,37,59,2,3,223,0,33,
35,80,159,35,36,36,83,158,35,16,2,32,0,89,162,8,44,36,41,2,7,
222,192,80,159,35,41,36,83,158,35,16,2,247,22,123,80,159,35,42,36,83,
158,35,16,2,247,22,122,80,159,35,43,36,83,158,35,16,2,247,22,59,80,
159,35,44,36,83,158,35,16,2,248,22,18,74,109,111,100,117,108,101,45,108,
111,97,100,105,110,103,80,159,35,45,36,83,158,35,16,2,11,80,158,35,46,
83,158,35,16,2,11,80,158,35,47,83,158,35,16,2,32,0,89,162,43,37,
44,2,14,222,33,41,80,159,35,48,36,83,158,35,16,2,89,162,8,44,36,
44,2,15,223,0,33,50,80,159,35,49,36,83,158,35,16,2,89,162,43,35,
43,2,16,223,0,33,51,80,159,35,53,36,95,29,94,2,4,68,35,37,107,
101,114,110,101,108,11,29,94,2,4,69,35,37,109,105,110,45,115,116,120,11,
2,5,9,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 4122);
}

4
src/mzscheme/src/eval.c
View File

@ -4715,7 +4715,7 @@ static Scheme_Object *add_renames_unless_module(Scheme_Object *form, Scheme_Env
module's language take over. */
d = SCHEME_STX_CDR(form);
a = scheme_make_pair(a, d);
form = scheme_datum_to_syntax(a, form, form, 1, 0);
form = scheme_datum_to_syntax(a, form, form, 0, 1);
return form;
}
}
@ -9282,7 +9282,7 @@ static Scheme_Object *do_eval_string_all(const char *str, Scheme_Env *env, int c
scheme_sys_wraps(NULL),
0, 0),
SCHEME_CDR(m));
expr = scheme_datum_to_syntax(m, expr, expr, 0, 0);
expr = scheme_datum_to_syntax(m, expr, expr, 0, 1);
}
}
}

94
src/mzscheme/src/module.c
View File

@ -55,7 +55,9 @@ static Scheme_Object *module_compiled_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_compiled_name(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_compiled_imports(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_compiled_exports(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_compiled_lang_info(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_to_namespace(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_to_lang_info(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_path_index_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_path_index_resolve(int argc, Scheme_Object *argv[]);
@ -334,8 +336,8 @@ void scheme_init_module(Scheme_Env *env)
GLOBAL_PARAMETER("current-module-name-resolver", current_module_name_resolver, MZCONFIG_CURRENT_MODULE_RESOLVER, env);
GLOBAL_PARAMETER("current-module-declare-name", current_module_name_prefix, MZCONFIG_CURRENT_MODULE_NAME, env);
GLOBAL_PRIM_W_ARITY("dynamic-require", scheme_dynamic_require, 2, 2, env);
GLOBAL_PRIM_W_ARITY("dynamic-require-for-syntax", dynamic_require_for_syntax, 2, 2, env);
GLOBAL_PRIM_W_ARITY("dynamic-require", scheme_dynamic_require, 2, 3, env);
GLOBAL_PRIM_W_ARITY("dynamic-require-for-syntax", dynamic_require_for_syntax, 2, 3, env);
GLOBAL_PRIM_W_ARITY("namespace-require", namespace_require, 1, 1, env);
GLOBAL_PRIM_W_ARITY("namespace-attach-module", namespace_attach_module, 2, 3, env);
GLOBAL_PRIM_W_ARITY("namespace-unprotect-module", namespace_unprotect_module, 2, 3, env);
@ -346,6 +348,7 @@ void scheme_init_module(Scheme_Env *env)
GLOBAL_PRIM_W_ARITY("module-compiled-name", module_compiled_name, 1, 1, env);
GLOBAL_PRIM_W_ARITY("module-compiled-imports", module_compiled_imports, 1, 1, env);
GLOBAL_PRIM_W_ARITY2("module-compiled-exports", module_compiled_exports, 1, 1, 2, 2, env);
GLOBAL_PRIM_W_ARITY("module-compiled-language-info", module_compiled_lang_info, 1, 1, env);
GLOBAL_FOLDING_PRIM("module-path-index?", module_path_index_p, 1, 1, 1, env);
GLOBAL_PRIM_W_ARITY("module-path-index-resolve", module_path_index_resolve, 1, 1, env);
GLOBAL_PRIM_W_ARITY2("module-path-index-split", module_path_index_split, 1, 1, 2, 2, env);
@ -355,6 +358,7 @@ void scheme_init_module(Scheme_Env *env)
GLOBAL_PRIM_W_ARITY("resolved-module-path-name", resolved_module_path_name, 1, 1, env);
GLOBAL_PRIM_W_ARITY("module-provide-protected?", module_export_protected_p, 2, 2, env);
GLOBAL_PRIM_W_ARITY("module->namespace", module_to_namespace, 1, 1, env);
GLOBAL_PRIM_W_ARITY("module->language-info", module_to_lang_info, 1, 1, env);
GLOBAL_PRIM_W_ARITY("module-path?", is_module_path, 1, 1, env);
}
@ -788,7 +792,7 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
int position)
{
Scheme_Object *modname, *modidx;
Scheme_Object *name, *srcname, *srcmname;
Scheme_Object *name, *srcname, *srcmname, *fail_thunk;
Scheme_Module *m, *srcm;
Scheme_Env *menv, *lookup_env = NULL;
int i, count, protected = 0;
@ -797,6 +801,10 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
modname = argv[0];
name = argv[1];
if (argc > 2)
fail_thunk = argv[2];
else
fail_thunk = NULL;
errname = (phase
? ((phase < 0)
@ -809,6 +817,9 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
return NULL;
}
if (fail_thunk)
scheme_check_proc_arity(errname, 0, 2, argc, argv);
if (SAME_TYPE(SCHEME_TYPE(modname), scheme_module_index_type))
modidx = modname;
else
@ -943,11 +954,14 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
}
if (i == count) {
if (fail_with_error)
if (fail_with_error) {
if (fail_thunk)
return scheme_tail_apply(fail_thunk, 0, NULL);
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: name is not provided: %V by module: %V",
errname,
name, srcm->modname);
}
return NULL;
}
}
@ -992,8 +1006,11 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
if (!menv->ran)
scheme_run_module(menv, 1);
}
if (!b->val && fail_with_error)
if (!b->val && fail_with_error) {
if (fail_thunk)
return scheme_tail_apply(fail_thunk, 0, NULL);
scheme_unbound_global(b);
}
return b->val;
}
} else
@ -2459,6 +2476,31 @@ static Scheme_Object *module_to_namespace(int argc, Scheme_Object *argv[])
return scheme_module_to_namespace(argv[0], env);
}
static Scheme_Object *module_to_lang_info(int argc, Scheme_Object *argv[])
{
Scheme_Env *env;
Scheme_Object *name;
Scheme_Module *m;
env = scheme_get_env(NULL);
if (!SCHEME_PATHP(argv[0])
&& !scheme_is_module_path(argv[0]))
scheme_wrong_type("module->language-info", "path or module-path", 0, argc, argv);
name = scheme_module_resolve(scheme_make_modidx(argv[0], scheme_false, scheme_false), 1);
env = scheme_get_env(NULL);
m = (Scheme_Module *)scheme_hash_get(env->module_registry, name);
if (!m)
scheme_arg_mismatch("module->laguage-info",
"unknown module in the current namespace: ",
name);
return (m->lang_info ? m->lang_info : scheme_false);
}
static Scheme_Object *module_compiled_p(int argc, Scheme_Object *argv[])
{
@ -2596,6 +2638,20 @@ static Scheme_Object *module_compiled_exports(int argc, Scheme_Object *argv[])
return NULL;
}
static Scheme_Object *module_compiled_lang_info(int argc, Scheme_Object *argv[])
{
Scheme_Module *m;
m = scheme_extract_compiled_module(argv[0]);
if (m) {
return (m->lang_info ? m->lang_info : scheme_false);
}
scheme_wrong_type("module-compiled-language-info", "compiled module declaration", 0, argc, argv);
return NULL;
}
static Scheme_Object *module_path_index_p(int argc, Scheme_Object *argv[])
{
return (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_module_index_type)
@ -5193,7 +5249,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
}
if (rec[drec].comp) {
Scheme_Object *dummy;
Scheme_Object *dummy, *pv;
dummy = scheme_make_environment_dummy(env);
m->dummy = dummy;
@ -5211,6 +5267,15 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
m->ii_src = NULL;
pv = scheme_stx_property(form, scheme_intern_symbol("module-language"), NULL);
if (pv && SCHEME_TRUEP(pv)) {
if (SCHEME_VECTORP(pv)
&& (3 == SCHEME_VEC_SIZE(pv))
&& scheme_is_module_path(SCHEME_VEC_ELS(pv)[0])
&& SCHEME_SYMBOLP(SCHEME_VEC_ELS(pv)[1]))
m->lang_info = pv;
}
fm = scheme_make_syntax_compiled(MODULE_EXPD, (Scheme_Object *)m);
} else {
Scheme_Object *hints, *formname;
@ -8900,6 +8965,11 @@ static Scheme_Object *write_module(Scheme_Object *obj)
l = cons(m->et_functional ? scheme_true : scheme_false, l);
l = cons(m->functional ? scheme_true : scheme_false, l);
if (m->lang_info)
l = cons(m->lang_info, l);
else
l = cons(scheme_false, l);
l = cons(m->me->src_modidx, l);
l = cons(SCHEME_PTR_VAL(m->modname), l);
@ -8951,6 +9021,18 @@ static Scheme_Object *read_module(Scheme_Object *obj)
((Scheme_Modidx *)m->me->src_modidx)->resolved = m->modname;
m->self_modidx = m->me->src_modidx;
if (!SCHEME_PAIRP(obj)) return_NULL();
e = SCHEME_CAR(obj);
if (SCHEME_FALSEP(e))
e = NULL;
else if (!(SCHEME_VECTORP(e)
&& (3 == SCHEME_VEC_SIZE(e))
&& scheme_is_module_path(SCHEME_VEC_ELS(e)[0])
&& SCHEME_SYMBOLP(SCHEME_VEC_ELS(e)[1])))
return_NULL();
m->lang_info = e;
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL();
m->functional = SCHEME_TRUEP(SCHEME_CAR(obj));
obj = SCHEME_CDR(obj);

4
src/mzscheme/src/mzmark.c
View File

@ -2348,6 +2348,8 @@ static int module_val_MARK(void *p) {
gcMARK(m->insp);
gcMARK(m->lang_info);
gcMARK(m->hints);
gcMARK(m->ii_src);
@ -2390,6 +2392,8 @@ static int module_val_FIXUP(void *p) {
gcFIXUP(m->insp);
gcFIXUP(m->lang_info);
gcFIXUP(m->hints);
gcFIXUP(m->ii_src);

2
src/mzscheme/src/mzmarksrc.c
View File

@ -943,6 +943,8 @@ module_val {
gcMARK(m->insp);
gcMARK(m->lang_info);
gcMARK(m->hints);
gcMARK(m->ii_src);

26
src/mzscheme/src/portfun.c
View File

@ -53,6 +53,7 @@ static Scheme_Object *read_syntax_f (int, Scheme_Object *[]);
static Scheme_Object *read_syntax_recur_f (int, Scheme_Object *[]);
static Scheme_Object *read_honu_syntax_f (int, Scheme_Object *[]);
static Scheme_Object *read_honu_syntax_recur_f (int, Scheme_Object *[]);
static Scheme_Object *read_language (int, Scheme_Object *[]);
static Scheme_Object *read_char (int, Scheme_Object *[]);
static Scheme_Object *read_char_spec (int, Scheme_Object *[]);
static Scheme_Object *read_byte (int, Scheme_Object *[]);
@ -262,6 +263,7 @@ scheme_init_port_fun(Scheme_Env *env)
GLOBAL_NONCM_PRIM("read-honu/recursive", read_honu_recur_f, 0, 1, env);
GLOBAL_NONCM_PRIM("read-honu-syntax", read_honu_syntax_f, 0, 2, env);
GLOBAL_NONCM_PRIM("read-honu-syntax/recursive", read_honu_syntax_recur_f, 0, 2, env);
GLOBAL_NONCM_PRIM("read-language", read_language, 0, 2, env);
GLOBAL_NONCM_PRIM("read-char", read_char, 0, 1, env);
GLOBAL_NONCM_PRIM("read-char-or-special", read_char_spec, 0, 1, env);
GLOBAL_NONCM_PRIM("read-byte", read_byte, 0, 1, env);
@ -2856,6 +2858,30 @@ static Scheme_Object *read_honu_syntax_recur_f(int argc, Scheme_Object *argv[])
return do_read_syntax_f("read-honu-syntax/recursive", argc, argv, 1, 1);
}
static Scheme_Object *read_language(int argc, Scheme_Object **argv)
{
Scheme_Object *port, *v, *fail_thunk = NULL;
if (argc > 0) {
port = argv[0];
if (!SCHEME_INPUT_PORTP(port))
scheme_wrong_type("read-language", "input-port", 0, argc, argv);
if (argc > 1) {
scheme_check_proc_arity("read-language", 0, 1, argc, argv);
fail_thunk = argv[1];
}
} else {
port = CURRENT_INPUT_PORT(scheme_current_config());
}
v = scheme_read_language(port, !!fail_thunk);
if (SCHEME_VOIDP(v))
return _scheme_tail_apply(fail_thunk, 0, NULL);
return v;
}
static Scheme_Object *
do_read_char(char *name, int argc, Scheme_Object *argv[], int peek, int spec, int is_byte)
{

167
src/mzscheme/src/read.c
View File

@ -254,6 +254,7 @@ static Scheme_Object *read_reader(Scheme_Object *port, Scheme_Object *stxsrc,
ReadParams *params);
static Scheme_Object *read_lang(Scheme_Object *port, Scheme_Object *stxsrc,
long line, long col, long pos,
int get_info,
Scheme_Hash_Table **ht,
Scheme_Object *indentation,
ReadParams *params,
@ -267,6 +268,10 @@ static void unexpected_closer(int ch,
long line, long col, long pos,
Scheme_Object *indentation,
ReadParams *params);
static Scheme_Object *expected_lang(const char *prefix, int ch,
Scheme_Object *port, Scheme_Object *stxsrc,
long line, long col, long pos,
int get_info);
static void pop_indentation(Scheme_Object *indentation);
static int skip_whitespace_comments(Scheme_Object *port, Scheme_Object *stxsrc,
@ -276,6 +281,7 @@ static int skip_whitespace_comments(Scheme_Object *port, Scheme_Object *stxsrc,
static Scheme_Object *readtable_call(int w_char, int ch, Scheme_Object *proc, ReadParams *params,
Scheme_Object *port, Scheme_Object *src, long line, long col, long pos,
int get_info,
Scheme_Hash_Table **ht, Scheme_Object *modpath_stx);
#define READTABLE_WHITESPACE 0x1
@ -709,7 +715,8 @@ static Scheme_Object *read_inner_inner(Scheme_Object *port,
ReadParams *params,
int comment_mode,
int pre_char,
Readtable *init_readtable);
Readtable *init_readtable,
int get_info);
static Scheme_Object *read_inner(Scheme_Object *port,
Scheme_Object *stxsrc,
Scheme_Hash_Table **ht,
@ -744,7 +751,7 @@ static Scheme_Object *read_inner_inner_k(void)
p->ku.k.p4 = NULL;
p->ku.k.p5 = NULL;
return read_inner_inner(o, stxsrc, ht, indentation, params, p->ku.k.i1, p->ku.k.i2, table);
return read_inner_inner(o, stxsrc, ht, indentation, params, p->ku.k.i1, p->ku.k.i2, table, p->ku.k.i3);
}
#endif
@ -753,7 +760,8 @@ static Scheme_Object *read_inner_inner_k(void)
static Scheme_Object *
read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table **ht,
Scheme_Object *indentation, ReadParams *params,
int comment_mode, int pre_char, Readtable *table)
int comment_mode, int pre_char, Readtable *table,
int get_info)
{
int ch, ch2, depth, dispatch_ch, special_value_need_copy = 0;
long line = 0, col = 0, pos = 0;
@ -785,6 +793,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
p->ku.k.i1 = comment_mode;
p->ku.k.i2 = pre_char;
p->ku.k.i3 = get_info;
return scheme_handle_stack_overflow(read_inner_inner_k);
}
}
@ -844,6 +853,10 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
} else
dispatch_ch = ch;
if (get_info && (dispatch_ch != '#') && (dispatch_ch != ';')) {
return expected_lang("", ch, port, stxsrc, line, col, pos, get_info);
}
switch ( dispatch_ch )
{
case EOF:
@ -968,6 +981,10 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
case '#':
ch = scheme_getc_special_ok(port);
if (get_info && (ch != '|') && (ch != '!') && (ch != 'l') && (ch != ';')) {
return expected_lang("#", ch, port, stxsrc, line, col, pos, get_info);
}
if (table) {
Scheme_Object *v;
int use_default;
@ -1330,7 +1347,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
"read: #lang expressions not currently enabled");
return NULL;
}
v = read_lang(port, stxsrc, line, col, pos, ht, indentation, params, 0);
v = read_lang(port, stxsrc, line, col, pos, get_info, ht, indentation, params, 0);
if (!v) {
if (comment_mode & RETURN_FOR_SPECIAL_COMMENT)
return NULL;
@ -1601,7 +1618,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
"read: #! reader expressions not currently enabled");
return NULL;
}
v = read_lang(port, stxsrc, line, col, pos, ht, indentation, params, ch);
v = read_lang(port, stxsrc, line, col, pos, get_info, ht, indentation, params, ch);
if (!v) {
if (comment_mode & RETURN_FOR_SPECIAL_COMMENT)
return NULL;
@ -1863,7 +1880,7 @@ read_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table **ht,
Scheme_Object *indentation, ReadParams *params,
int comment_mode)
{
return read_inner_inner(port, stxsrc, ht, indentation, params, comment_mode, -1, params->table);
return read_inner_inner(port, stxsrc, ht, indentation, params, comment_mode, -1, params->table, 0);
}
#ifdef DO_STACK_CHECK
@ -2133,11 +2150,11 @@ static Scheme_Object *resolve_references(Scheme_Object *obj,
return result;
}
Scheme_Object *
_scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int cant_fail, int honu_mode,
int recur, int expose_comment, int extra_char, Scheme_Object *init_readtable,
Scheme_Object *magic_sym, Scheme_Object *magic_val,
Scheme_Object *delay_load_info)
static Scheme_Object *
_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int cant_fail, int honu_mode,
int recur, int expose_comment, int extra_char, Scheme_Object *init_readtable,
Scheme_Object *magic_sym, Scheme_Object *magic_val,
Scheme_Object *delay_load_info, int get_info)
{
Scheme_Object *v, *v2;
Scheme_Config *config;
@ -2146,11 +2163,15 @@ _scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int c
config = scheme_current_config();
v = scheme_get_param(config, MZCONFIG_READTABLE);
if (SCHEME_TRUEP(v))
params.table = (Readtable *)v;
else
if (get_info) {
params.table = NULL;
} else {
v = scheme_get_param(config, MZCONFIG_READTABLE);
if (SCHEME_TRUEP(v))
params.table = (Readtable *)v;
else
params.table = NULL;
}
params.can_read_compiled = crc;
v = scheme_get_param(config, MZCONFIG_CAN_READ_PIPE_QUOTE);
params.can_read_pipe_quote = SCHEME_TRUEP(v);
@ -2158,7 +2179,7 @@ _scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int c
params.can_read_box = SCHEME_TRUEP(v);
v = scheme_get_param(config, MZCONFIG_CAN_READ_GRAPH);
params.can_read_graph = SCHEME_TRUEP(v);
if (crc) {
if (crc || get_info) {
params.can_read_reader = 1;
} else {
v = scheme_get_param(config, MZCONFIG_CAN_READ_READER);
@ -2215,7 +2236,8 @@ _scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int c
? (SCHEME_FALSEP(init_readtable)
? NULL
: (Readtable *)init_readtable)
: params.table));
: params.table),
get_info);
extra_char = -1;
@ -2280,10 +2302,10 @@ static void *scheme_internal_read_k(void)
magic_sym = SCHEME_CAR(magic_sym);
}
return (void *)_scheme_internal_read(port, stxsrc, p->ku.k.i1, 0, p->ku.k.i2,
p->ku.k.i3 & 0x2, p->ku.k.i3 & 0x1,
p->ku.k.i4, init_readtable,
magic_sym, magic_val, delay_load_info);
return (void *)_internal_read(port, stxsrc, p->ku.k.i1, 0, p->ku.k.i2,
p->ku.k.i3 & 0x2, p->ku.k.i3 & 0x1,
p->ku.k.i4, init_readtable,
magic_sym, magic_val, delay_load_info, 0);
}
Scheme_Object *
@ -2298,8 +2320,8 @@ scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int ca
crc = SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_CAN_READ_COMPILED));
if (cantfail) {
return _scheme_internal_read(port, stxsrc, crc, cantfail, honu_mode, recur, expose_comment, -1, NULL,
magic_sym, magic_val, delay_load_info);
return _internal_read(port, stxsrc, crc, cantfail, honu_mode, recur, expose_comment, -1, NULL,
magic_sym, magic_val, delay_load_info, 0);
} else {
if (magic_sym)
magic_sym = scheme_make_pair(magic_sym, magic_val);
@ -2320,12 +2342,12 @@ scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int ca
Scheme_Object *scheme_read(Scheme_Object *port)
{
return scheme_internal_read(port, NULL, -1, 0, 0, 0, 0, -1, NULL, NULL, NULL, NULL);
return scheme_internal_read(port, NULL, -1, 0, 0, 0, 0, -1, NULL, NULL, NULL, 0);
}
Scheme_Object *scheme_read_syntax(Scheme_Object *port, Scheme_Object *stxsrc)
{
return scheme_internal_read(port, stxsrc, -1, 0, 0, 0, 0, -1, NULL, NULL, NULL, NULL);
return scheme_internal_read(port, stxsrc, -1, 0, 0, 0, 0, -1, NULL, NULL, NULL, 0);
}
Scheme_Object *scheme_resolve_placeholders(Scheme_Object *obj)
@ -3339,7 +3361,7 @@ read_number_or_symbol(int init_ch, int skip_rt, Scheme_Object *port,
/* If the readtable provides a "symbol" reader, then use it: */
if (table->symbol_parser) {
return readtable_call(1, init_ch, table->symbol_parser, params,
port, stxsrc, line, col, pos, ht, NULL);
port, stxsrc, line, col, pos, 0, ht, NULL);
/* Special-comment result is handled in main loop. */
}
}
@ -5532,7 +5554,8 @@ static int readtable_kind(Readtable *t, int ch, ReadParams *params)
static Scheme_Object *readtable_call(int w_char, int ch, Scheme_Object *proc, ReadParams *params,
Scheme_Object *port, Scheme_Object *src, long line, long col, long pos,
Scheme_Hash_Table **ht, Scheme_Object *modpath_stx)
int get_info,
Scheme_Hash_Table **ht, Scheme_Object *modpath_stx)
{
int cnt, add_srcloc = 0;
Scheme_Object *a[6], *v;
@ -5581,15 +5604,25 @@ static Scheme_Object *readtable_call(int w_char, int ch, Scheme_Object *proc, Re
ht = MALLOC_N(Scheme_Hash_Table *, 1);
}
scheme_push_continuation_frame(&cframe);
scheme_set_in_read_mark(src, ht);
if (!get_info) {
scheme_push_continuation_frame(&cframe);
scheme_set_in_read_mark(src, ht);
}
v = scheme_apply(proc, cnt, a);
scheme_pop_continuation_frame(&cframe);
if (get_info) {
a[0] = v;
if (!scheme_check_proc_arity(NULL, 1, 0, 1, a)) {
scheme_wrong_type("read-language", "procedure (arity 1)", -1, -1, a);
}
}
if (!scheme_special_comment_value(v)) {
if (!get_info) {
scheme_pop_continuation_frame(&cframe);
}
if (!get_info && !scheme_special_comment_value(v)) {
if (SCHEME_STXP(v)) {
if (!src)
v = scheme_syntax_to_datum(v, 0, NULL);
@ -5651,7 +5684,7 @@ static Scheme_Object *readtable_handle(Readtable *t, int *_ch, int *_use_default
v = SCHEME_CDR(v);
v = readtable_call(1, ch, v, params, port, src, line, col, pos, ht, NULL);
v = readtable_call(1, ch, v, params, port, src, line, col, pos, 0, ht, NULL);
return v;
}
@ -5687,7 +5720,7 @@ static Scheme_Object *readtable_handle_hash(Readtable *t, int ch, int *_use_defa
*_use_default = 0;
v = readtable_call(1, ch, v, params, port, src, line, col, pos, ht, NULL);
v = readtable_call(1, ch, v, params, port, src, line, col, pos, 0, ht, NULL);
if (scheme_special_comment_value(v))
return NULL;
@ -5927,13 +5960,20 @@ static Scheme_Object *current_reader_guard(int argc, Scheme_Object **argv)
1, NULL, NULL, 0);
}
static Scheme_Object *no_val_thunk(void *d, int argc, Scheme_Object **argv)
{
return (Scheme_Object *)d;
}
static Scheme_Object *do_reader(Scheme_Object *modpath_stx,
Scheme_Object *port,
Scheme_Object *stxsrc, long line, long col, long pos,
int get_info,
Scheme_Hash_Table **ht,
Scheme_Object *indentation, ReadParams *params)
{
Scheme_Object *modpath, *name, *a[2], *proc, *v;
Scheme_Object *modpath, *name, *a[3], *proc, *v, *no_val;
int num_a;
if (stxsrc)
modpath = scheme_syntax_to_datum(modpath_stx, 0, NULL);
@ -5946,32 +5986,51 @@ static Scheme_Object *do_reader(Scheme_Object *modpath_stx,
modpath = scheme_apply(proc, 1, a);
a[0] = modpath;
if (stxsrc)
if (get_info)
name = scheme_intern_symbol("get-info");
else if (stxsrc)
name = scheme_intern_symbol("read-syntax");
else
name = scheme_intern_symbol("read");
a[1] = name;
if (get_info) {
no_val = scheme_make_pair(scheme_false, scheme_false);
a[2] = scheme_make_closed_prim(no_val_thunk, no_val);
num_a = 3;
} else {
no_val = NULL;
num_a = 2;
}
proc = scheme_dynamic_require(2, a);
proc = scheme_dynamic_require(num_a, a);
if (get_info) {
proc = scheme_force_value(proc);
}
if (get_info && SAME_OBJ(proc, no_val))
return scheme_false;
a[0] = proc;
if (scheme_check_proc_arity(NULL, stxsrc ? 6 : 5, 0, 1, a)) {
/* provide modpath_stx to reader */
} else if (scheme_check_proc_arity(NULL, stxsrc ? 2 : 1, 0, 1, a)) {
} else if (!get_info && scheme_check_proc_arity(NULL, stxsrc ? 2 : 1, 0, 1, a)) {
/* don't provide modpath_stx to reader */
modpath_stx = NULL;
} else {
scheme_wrong_type("#reader",
(stxsrc ? "procedure (arity 2 or 6)" : "procedure (arity 1 or 5)"),
(stxsrc ? "procedure (arity 2 or 6)"
: (get_info
? "procedure (arity 5)"
: "procedure (arity 1 or 5)")),
-1, -1, a);
return NULL;
}
v = readtable_call(0, 0, proc, params,
port, stxsrc, line, col, pos,
ht, modpath_stx);
get_info, ht, modpath_stx);
if (scheme_special_comment_value(v))
if (!get_info && scheme_special_comment_value(v))
return NULL;
else
return v;
@ -5996,12 +6055,13 @@ static Scheme_Object *read_reader(Scheme_Object *port,
return NULL;
}
return do_reader(modpath, port, stxsrc, line, col, pos, ht, indentation, params);
return do_reader(modpath, port, stxsrc, line, col, pos, 0, ht, indentation, params);
}
/* "#lang " has been read */
static Scheme_Object *read_lang(Scheme_Object *port,
Scheme_Object *stxsrc, long line, long col, long pos,
int get_info,
Scheme_Hash_Table **ht,
Scheme_Object *indentation, ReadParams *params,
int init_ch)
@ -6094,7 +6154,28 @@ static Scheme_Object *read_lang(Scheme_Object *port,
stxsrc, STX_SRCTAG);
}
return do_reader(modpath, port, stxsrc, line, col, pos, ht, indentation, params);
return do_reader(modpath, port, stxsrc, line, col, pos, get_info, ht, indentation, params);
}
Scheme_Object *scheme_read_language(Scheme_Object *port, int nonlang_ok)
{
return _internal_read(port, NULL, 0, 0, 0, 0, 0, -1,
NULL, NULL, NULL, NULL, nonlang_ok ? 2 : 1);
}
static Scheme_Object *expected_lang(const char *prefix, int ch,
Scheme_Object *port, Scheme_Object *stxsrc,
long line, long col, long pos,
int get_lang)
{
if (get_lang > 1) {
return scheme_void;
} else {
scheme_read_err(port, stxsrc, line, col, pos, 1, 0, NULL,
"read-language: expected `#lang' or `#!', found `%s%c'",
prefix, ch);
return NULL;
}
}
/*========================================================================*/

2
src/mzscheme/src/schminc.h
View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 926
#define EXPECTED_PRIM_COUNT 929
#ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP

4
src/mzscheme/src/schpriv.h
View File

@ -1716,6 +1716,8 @@ void scheme_internal_display(Scheme_Object *obj, Scheme_Object *port);
void scheme_internal_write(Scheme_Object *obj, Scheme_Object *port);
void scheme_internal_print(Scheme_Object *obj, Scheme_Object *port);
Scheme_Object *scheme_read_language(Scheme_Object *port, int nonlang_ok);
#define _scheme_eval_linked_expr(obj) scheme_do_eval(obj,-1,NULL,1)
#define _scheme_eval_linked_expr_multi(obj) scheme_do_eval(obj,-1,NULL,-1)
#define _scheme_eval_linked_expr_wp(obj, p) scheme_do_eval_w_thread(obj,-1,NULL,1,p)
@ -2542,6 +2544,8 @@ typedef struct Scheme_Module
Scheme_Object *insp; /* declaration-time inspector, for creating certificates
and for module instantiation */
Scheme_Object *lang_info; /* NULL or vector */
Scheme_Object *hints; /* set by expansion; moved to properties */
Scheme_Object *ii_src; /* set by compile, temporary */
Comp_Prefix *comp_prefix; /* set by body compile, temporary */

4
src/mzscheme/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "4.1.0.3"
#define MZSCHEME_VERSION "4.1.0.4"
#define MZSCHEME_VERSION_X 4
#define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_W 4
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

2
src/worksp/mred/mred.manifest
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="4.1.0.3"
version="4.1.0.4"
processorArchitecture="X86"
name="Org.PLT-Scheme.MrEd"
type="win32"

8
src/worksp/mred/mred.rc
View File

@ -20,8 +20,8 @@ APPLICATION ICON DISCARDABLE "mred.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,1,0,3
PRODUCTVERSION 4,1,0,3
FILEVERSION 4,1,0,4
PRODUCTVERSION 4,1,0,4
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -39,11 +39,11 @@ BEGIN
VALUE "CompanyName", "PLT Scheme Inc.\0"
VALUE "FileDescription", "PLT Scheme GUI application\0"
VALUE "InternalName", "MrEd\0"
VALUE "FileVersion", "4, 1, 0, 3\0"
VALUE "FileVersion", "4, 1, 0, 4\0"
VALUE "LegalCopyright", "Copyright © 1995-2008\0"
VALUE "OriginalFilename", "MrEd.exe\0"
VALUE "ProductName", "PLT Scheme\0"
VALUE "ProductVersion", "4, 1, 0, 3\0"
VALUE "ProductVersion", "4, 1, 0, 4\0"
END
END
BLOCK "VarFileInfo"

8
src/worksp/mzcom/mzcom.rc
View File

@ -53,8 +53,8 @@ END
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,1,0,3
PRODUCTVERSION 4,1,0,3
FILEVERSION 4,1,0,4
PRODUCTVERSION 4,1,0,4
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -70,12 +70,12 @@ BEGIN
BLOCK "040904b0"
BEGIN
VALUE "FileDescription", "MzCOM Module"
VALUE "FileVersion", "4, 1, 0, 3"
VALUE "FileVersion", "4, 1, 0, 4"
VALUE "InternalName", "MzCOM"
VALUE "LegalCopyright", "Copyright 2000-2008 PLT (Paul Steckler)"
VALUE "OriginalFilename", "MzCOM.EXE"
VALUE "ProductName", "MzCOM Module"
VALUE "ProductVersion", "4, 1, 0, 3"
VALUE "ProductVersion", "4, 1, 0, 4"
END
END
BLOCK "VarFileInfo"

6
src/worksp/mzcom/mzobj.rgs
View File

@ -1,19 +1,19 @@
HKCR
{
MzCOM.MzObj.4.1.0.3 = s 'MzObj Class'
MzCOM.MzObj.4.1.0.4 = s 'MzObj Class'
{
CLSID = s '{A3B0AF9E-2AB0-11D4-B6D2-0060089002FE}'
}
MzCOM.MzObj = s 'MzObj Class'
{
CLSID = s '{A3B0AF9E-2AB0-11D4-B6D2-0060089002FE}'
CurVer = s 'MzCOM.MzObj.4.1.0.3'
CurVer = s 'MzCOM.MzObj.4.1.0.4'
}
NoRemove CLSID
{
ForceRemove {A3B0AF9E-2AB0-11D4-B6D2-0060089002FE} = s 'MzObj Class'
{
ProgID = s 'MzCOM.MzObj.4.1.0.3'
ProgID = s 'MzCOM.MzObj.4.1.0.4'
VersionIndependentProgID = s 'MzCOM.MzObj'
ForceRemove 'Programmable'
LocalServer32 = s '%MODULE%'

8
src/worksp/mzscheme/mzscheme.rc
View File

@ -29,8 +29,8 @@ APPLICATION ICON DISCARDABLE "mzscheme.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,1,0,3
PRODUCTVERSION 4,1,0,3
FILEVERSION 4,1,0,4
PRODUCTVERSION 4,1,0,4
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -48,11 +48,11 @@ BEGIN
VALUE "CompanyName", "PLT Scheme Inc.\0"
VALUE "FileDescription", "PLT Scheme application\0"
VALUE "InternalName", "MzScheme\0"
VALUE "FileVersion", "4, 1, 0, 3\0"
VALUE "FileVersion", "4, 1, 0, 4\0"
VALUE "LegalCopyright", "Copyright <20>© 1995-2008\0"
VALUE "OriginalFilename", "mzscheme.exe\0"
VALUE "ProductName", "PLT Scheme\0"
VALUE "ProductVersion", "4, 1, 0, 3\0"
VALUE "ProductVersion", "4, 1, 0, 4\0"
END
END
BLOCK "VarFileInfo"

8
src/worksp/starters/start.rc
View File

@ -22,8 +22,8 @@ APPLICATION ICON DISCARDABLE "mzstart.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,1,0,3
PRODUCTVERSION 4,1,0,3
FILEVERSION 4,1,0,4
PRODUCTVERSION 4,1,0,4
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -45,7 +45,7 @@ BEGIN
#ifdef MZSTART
VALUE "FileDescription", "PLT Scheme Launcher\0"
#endif
VALUE "FileVersion", "4, 1, 0, 3\0"
VALUE "FileVersion", "4, 1, 0, 4\0"
#ifdef MRSTART
VALUE "InternalName", "mrstart\0"
#endif
@ -60,7 +60,7 @@ BEGIN
VALUE "OriginalFilename", "MzStart.exe\0"
#endif
VALUE "ProductName", "PLT Scheme\0"
VALUE "ProductVersion", "4, 1, 0, 3\0"
VALUE "ProductVersion", "4, 1, 0, 4\0"
END
END
BLOCK "VarFileInfo"