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

more mzlib scribbling

Browse Source 
svn: r8552
This commit is contained in:
Matthew Flatt 2008-02-06 04:10:54 +00:00
parent 2ae21adbff
commit 15304f5870
13 changed files with 673 additions and 155 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/mzlib/list.ss
View File

@ -21,7 +21,11 @@
filter
sort))
sort)
(only scheme/list
cons?
empty?
empty))
(provide first
second
@ -112,9 +116,5 @@
(if (pair? x)
(loop x (cdr x))
l))
(raise-type-error 'last-pair "pair" l)))
(define cons? (lambda (x) (pair? x)))
(define empty? (lambda (x) (null? x)))
(define empty '()))
(raise-type-error 'last-pair "pair" l))))

75
collects/mzlib/scribblings/list.scrbl Normal file
View File

@ -0,0 +1,75 @@
#lang scribble/doc
@(require "common.ss"
(for-label mzlib/list))
@mzlib[#:mode title list]
The @schememodname[mzlib/list] library re-exports several functions
from @schememodname[scheme/base] and @schememodname[scheme/list]:
@schemeblock[
cons?
empty?
empty
foldl
foldr
remv
remq
remove
remv*
remq*
remove*
findf
memf
assf
filter
sort
]
@deftogether[(
@defproc[(first [v pair?]) any/c]
@defproc[(second [v (and/c pair? ....)]) any/c]
@defproc[(third [v (and/c pair? ....)]) any/c]
@defproc[(fourth [v (and/c pair? ....)]) any/c]
@defproc[(fifth [v (and/c pair? ....)]) any/c]
@defproc[(sixth [v (and/c pair? ....)]) any/c]
@defproc[(seventh [v (and/c pair? ....)]) any/c]
@defproc[(eighth [v (and/c pair? ....)]) any/c]
)]{
Accesses the first, second, @|etc| elment of ``list'' @scheme[v]. The
argument need not actually be a list; it is inspected only as far as
necessary to obtain an element (unlike the same-named functions from
@schememodname[scheme/list], which do require the argument to be a
list).}
@defproc[(rest [v pair?]) any/c]{
The same as @scheme[cdr].}
@defproc[(last-pair [v pair?]) pair?]{
Returns the last pair in @scheme[v], raising an error if @scheme[v] is
not a pair (but @scheme[v] does not have to be a proper list).}
@defproc[(merge-sorted-lists [lst1 list?][lst2 lst?]
[less-than? (any/c any/c . -> . any/c)])
list?]{
Merges the two sorted input lists, creating a new sorted list. The
merged result is stable: equal items in both lists stay in the same
order, and these in @scheme[lst1] precede @scheme[lst2].}
@defproc[(mergesort [lst list?] [less-than? (any/c any/c . -> . any/c)])
list?]{
The same as @scheme[sort].}
@defproc[(quicksort [lst list?] [less-than? (any/c any/c . -> . any/c)])
list?]{
The same as @scheme[sort].}

47
collects/mzlib/scribblings/match-grammar.ss Normal file
View File

@ -0,0 +1,47 @@
#lang scheme/base
(require (lib "scribblings/reference/match-parse.ss"))
(provide match-grammar)
(define grammar "
pat ::= id @match anything, bind identifier
| _ @match anything
| literal @match literal
| 'datum @match equal% datum
| (lvp ...) @match sequence of lvps
| (lvp ... . pat) @match lvps consed onto a pat
| #(lvp ...) @match vector of pats
| #&pat @match boxed pat
| ($ struct-id pat ...) @match struct-id instance
| (AND pat ...) @match when all pats match
| (OR pat ...) @match when any pat match
| (NOT pat ...) @match when no pat match
| (= expr pat) @match (expr value) to pat
| (? pred-expr pat ...) @match if (expr value) and pats
| (set! identifier) @match anything, bind as setter
| (get! identifier) @match anything, bind as getter
| `qp @match quasipattern
literal ::= #t @match true
| #f @match false
| string @match equal% string
| number @match equal% number
| character @match equal% character
lvp ::= pat ooo @greedily match pat instances
| pat @match pat
ooo ::= *** @zero or more; *** is literal
| ___ @zero or more
| ..K @K or more
| __K @K or more
qp ::= literal @match literal
| id @match equal% symbol
| (qp ...) @match sequences of qps
| (qp ... . qp) @match sequence of qps consed onto a qp
| (qp ... qp ooo) @match qps consed onto a repeated qp
| #(qp ...) @match vector of qps
| #&qp @match boxed qp
| ,pat @match pat
| ,@pat @match pat, spliced
")
(define match-grammar
(parse-match-grammar grammar))

54
collects/mzlib/scribblings/match.scrbl Normal file
View File

@ -0,0 +1,54 @@
#lang scribble/doc
@(require "common.ss"
"match-grammar.ss"
(for-label mzlib/match))
@(begin
(define-syntax-rule (bind id)
(begin
(require scheme/match)
(define id (scheme match))))
(bind scheme-match))
@mzlib[#:mode title match]
The @schememodname[mzlib/match] library provides a @scheme[match] form
similar to that of @schememodname[scheme/match], but with an different
(older and less extensible) syntax of patterns.
@defform/subs[(match val-expr clause ...)
([clause [pat expr ...+]
[pat (=> id) expr ...+]])]{
See @scheme-match from @schememodname[scheme/match] for a description
of matching. The grammar of @scheme[pat] for this @scheme[match] is as
follows:
@|match-grammar|}
@; ------------------------------------------------------------
@deftogether[(
@defform[(match-lambda clause ...)]
@defform[(match-lambda* clause ...)]
@defform[(match-let ([pat expr] ...) body ...+)]
@defform[(match-let* ([pat expr] ...) body ...+)]
@defform[(match-letrec ([pat expr] ...) body ...+)]
@defform[(match-define pat expr)]
)]{
Analogous to the combined forms from @scheme[scheme/match].}
@; ------------------------------------------------------------
@deftogether[(
@defform*[((define-match-expander id proc-expr)
(define-match-expander id proc-expr proc-expr)
(define-match-expander id proc-expr proc-expr proc-expr))]
@defparam[match-equality-test comp-proc (any/c any/c . -> . any)]
)]{
Analogous to the form and parameter from @scheme[scheme/match]. The
@scheme[define-match-expander] form, however, supports an extra
@scheme[proc-expr] as the middle one: an expander for use with
@scheme[match] from @schememodname[mzlib/match].}

9
collects/mzlib/scribblings/math.scrbl Normal file
View File

@ -0,0 +1,9 @@
#lang scribble/doc
@(require "common.ss"
(for-label mzlib/math
(only-in scheme/math euler)))
@mzlib[#:mode title math]
Re-exports @schememodname[scheme/math], except that @scheme[euler] is
renamed on export to @scheme[e].

30
collects/mzlib/scribblings/mzlib.scrbl
View File

@ -140,6 +140,36 @@ Re-exports @schememodname[file/gunzip].
@; ----------------------------------------------------------------------
@include-section["list.scrbl"]
@; ----------------------------------------------------------------------
@include-section["match.scrbl"]
@; ----------------------------------------------------------------------
@include-section["math.scrbl"]
@; ----------------------------------------------------------------------
@mzlib[md5]
Re-exports @schememodname[file/md5].
@; ----------------------------------------------------------------------
@include-section["os.scrbl"]
@; ----------------------------------------------------------------------
@include-section["pconvert.scrbl"]
@; ----------------------------------------------------------------------
@include-section["pconvert-prop.scrbl"]
@; ----------------------------------------------------------------------
@(bibliography
(bib-entry #:key "Shivers06"

31
collects/mzlib/scribblings/os.scrbl Normal file
View File

@ -0,0 +1,31 @@
#lang scribble/doc
@(require "common.ss"
(for-label mzlib/os))
@mzlib[#:mode title os]
@defproc[(gethostname) string?]{
Returns a string for the current machine's hostname (including its
domain).}
@defproc[(getpid) exact-integer?]{
Returns an integer identifying the current process within the
operating system.}
@defproc[(truncate-file [file path-string?][n-bytes exact-nonnegative-integer? 0])
void?]{
Truncates or extends the given @scheme[file] so that it is
@scheme[n-bytes] long. If the file does not exist, or if the process
does not have sufficient privilege to truncate the file, the
@scheme[exn:fail] exception is raised.
@bold{WARNING:} under Unix, the implementation assumes that the
system's @scheme[ftruncate] function accepts a @tt{long long} second
argument.}

25
collects/mzlib/scribblings/pconvert-prop.scrbl Normal file
View File

@ -0,0 +1,25 @@
#lang scribble/doc
@(require "common.ss"
(for-label mzlib/pconvert
mzlib/pconvert-prop))
@mzlib[#:mode title pconvert-prop]
@deftogether[(
@defthing[prop:print-convert-constructor-name property?]
@defproc[(print-convert-named-constructor? [v any/c]) any]
@defproc[(print-convert-constructor-name [v any/c]) any]
)]{
The @scheme[prop:print-convert-constructor-name] property can be given
a symbol value for a structure type. In that case, for
constructor-style print conversion via @scheme[print-convert],
instances of the structure are shown using the symbol as the
constructor name. Otherwise, the constructor name is determined by
prefixing @schemeidfont{make-} onto the result of @scheme[object-name].
The @scheme[print-convert-named-constructor?] predicate recognizes
instances of structure types that have the
@scheme[prop:print-convert-constructor-name] property, and
@scheme[print-convert-constructor-name] extracts the property value.}

238
collects/mzlib/scribblings/pconvert.scrbl Normal file
View File

@ -0,0 +1,238 @@
#lang scribble/doc
@(require "common.ss"
(for-label mzlib/pconvert
mzlib/pconvert-prop
scheme/pretty))
@mzlib[#:mode title pconvert]
The @schememodname[mzlib/pconvert] library defines routines for
printing Scheme values as @scheme[eval]uable S-expressions, rather
than @scheme[read]able S-expressions.
The @scheme[print-convert] procedure does not print values; rather, it
converts a Scheme value into another Scheme value such that the new
value pretty-prints as a Scheme expression that evaluates to the
original value. For example, @scheme[(pretty-print (print-convert `(9
,(box 5) #(6 7))))] prints the literal expression @schemeresult[(list
9 (box 5) (vector 6 7))] to the current output port.
To install print converting into the read-eval-print loop, require
@scheme[mzlib/pconvert] and call the procedure
@scheme[install-converting-printer].
In addition to @scheme[print-convert], this library provides
@scheme[print-convert], @scheme[build-share], @scheme[get-shared],
and @scheme[print-convert-expr]. The last three are used to convert
sub-expressions of a larger expression (potentially with shared
structure).
See also @scheme[prop:print-convert-constructor-name].
@defboolparam[abbreviate-cons-as-list abbreviate?]{
A parameter that controls how lists are represented with
constructor-style conversion. If the parameter's value is @scheme[#t],
lists are represented using @scheme[list]. Otherwise, lists are
represented using @scheme[cons]. The initial value of the parameter is
@scheme[#t].}
@defboolparam[booleans-as-true/false use-name?]{
A parameter that controls how @scheme[#t] and @scheme[#f] are
represented. If the parameter's value is @scheme[#t], then @scheme[#t]
is represented as @scheme[true] and @scheme[#f] is represented as
@scheme[false]. The initial value of the parameter is @scheme[#t].}
@defparam[use-named/undefined-handler use-handler (any/c . -> . any/c)]{
A parameter that controls how values that have inferred names are
represented. The procedure is passed a value. If the procedure returns
true, the procedure associated with @scheme[named/undefined-handler]
is invoked to render that value. Only values that have inferred names
but are not defined at the top-level are used with this handler.
The initial value of the parameter is @scheme[(lambda (x) #f)].}
@defparam[named/undefined-handler use-handler (any/c . -> . any/c)]{
Parameter for a procedure that controls how values that have inferred
names are represented. The procedure is called only if
@scheme[use-named/undefined-handler] returns true for some value. In
that case, the procedure is passed that same value, and the result of
the parameter is used as the representation for the value.
The initial value of the parameter is @scheme[(lambda (x) #f)].}
@defproc[(build-share [v any/c]) ....]{
Takes a value and computes sharing information used for representing
the value as an expression. The return value is an opaque structure
that can be passed back into @scheme[get-shared] or
@scheme[print-convert-expr].}
@defboolparam[constructor-style-printing use-constructors?]{
Parameter that controls how values are represented after conversion.
If this parameter's value is @scheme[#t], then constructors are used;
e.g., pair containing @scheme[1] and @scheme[2] is represented as
@scheme[(cons 1 2)]. Otherwise, @scheme[quasiquote]-style syntax is
used; e.g., the pair containing @scheme[1] and @scheme[2] is
represented as @scheme[`(1 . 2)]. The initial value of the parameter
is @scheme[#f].
See also @scheme[quasi-read-style-printing] and
@scheme[prop:print-convert-constructor-name].}
@defparam[current-build-share-hook
hook
(any/c (any/c . -> . void?)
(any/c . -> . void?) . -> . any)]{
Parameter that sets a procedure used by @scheme[print-convert] and
@scheme[build-share] to assemble sharing information. The procedure
@scheme[hook] takes three arguments: a value @scheme[_v], a procedure
@scheme[_basic-share], and a procedure @scheme[_sub-share]; the return
value is ignored. The @scheme[basic-share] procedure takes @scheme[_v]
and performs the built-in sharing analysis, while the
@scheme[_sub-share] procedure takes a component of @scheme[_v] ands
analyzes it. Sharing information is accumulated as values are passed
to @scheme[basic-share] and @scheme[sub-share].
A @scheme[current-build-share-hook] procedure usually works together
with a @scheme[current-print-convert-hook] procedure.}
@defparam[current-build-share-name-hook hook (any/c . -> . (or/c symbol? false/c))]{
Parameter that sets a procedure used by @scheme[print-convert] and
@scheme[build-share] to generate a new name for a shared value. The
@scheme[hook] procedure takes a single value and returns a symbol for
the value's name. If @scheme[hook] returns @scheme[#f], a name is
generated using the form
``@schemeidfont{-}@scheme[_n]@schemeidfont{-}, where @scheme[n] is an
integer.}
@defparam[current-print-convert-hook
hook
(any/c/ (any/c . -> . any/c)
(any/c . -> . any/c))]{
Parameter that sets a procedure used by @scheme[print-convert] and
@scheme[print-convert-expr] to convert values. The procedure
@scheme[hook] takes three arguments---a value @scheme[_v], a procedure
@scheme[_basic-convert], and a procedure @scheme[_sub-convert]---and
returns the converted representation of @scheme[_v]. The
@scheme[_basic-convert] procedure takes @scheme[_v] and returns the
default conversion, while the @scheme[_sub-convert] procedure takes a
component of @scheme[_v] and returns its conversion.
A @scheme[current-print-convert-hook] procedure usually works together
with a @scheme[current-build-share-hook] procedure.}
@defparam[current-read-eval-convert-print-prompt str string?]{
Parameter that sets the prompt used by
@scheme[install-converting-printer].
The initial value is @scheme["|- "].}
@defproc[(get-shared [share-info ....]
[cycles-only? any/c #f])
(list-of (cons/c symbol? any/c))]{
The @scheme[shared-info] value must be a result from @scheme[build-share].
The procedure returns a list matching variables to shared values
within the value passed to @scheme[build-share].
The default value for @scheme[cycles-only?] is @scheme[#f];
if it is not @scheme[#f], @scheme[get-shared] returns only information
about cycles.
For example,
@schemeblock[
(get-shared (build-share (shared ([a (cons 1 b)]
[b (cons 2 a)])
a)))
]
might return the list
@schemeblock[
'((-1- (cons 1 -2-)) (-2- (cons 2 -1-)))
]}
@defproc[(install-converting-printer) void?]{
Sets the current print handler to print values using
@scheme[print-convert]. The current read handler is also set to use
the prompt returned by
@scheme[current-read-eval-convert-print-prompt].}
@defproc[(print-convert [v any/c][cycles-only? any/c (show-sharing)]) any/c]{
Converts the value @scheme[v]. If @scheme[cycles-only?] is not
@scheme[#f], then only circular objects are included in the
output.}
@defproc[(print-convert-expr [share-info ....]
[v any/c]
[unroll-once? any/c]) any/c]{
Converts the value @scheme[v] using sharing information
@scheme[share-info], which was previously returned by
@scheme[build-share] for a value containing @scheme[v]. If the most
recent call to @scheme[get-shared] with @scheme[share-info] requested
information only for cycles, then @scheme[print-convert-expr] will
only display sharing among values for cycles, rather than showing all
value sharing.
The @scheme[unroll-once?] argument is used if @scheme[v] is a shared
value in @scheme[share-info]. In this case, if @scheme[unroll-once?]
is @scheme[#f], then the return value will be a shared-value
identifier; otherwise, the returned value shows the internal structure
of @scheme[v] (using shared value identifiers within @scheme[v]'s
immediate structure as appropriate).}
@defboolparam[quasi-read-style-printing on?]{
Parameter that controls how vectors and boxes are represented after
conversion when the value of @scheme[constructor-style-printing] is
@scheme[#f]. If @scheme[quasi-read-style-printing] is set to
@scheme[#f], then boxes and vectors are unquoted and represented using
constructors. For example, the list of a box containing the number 1
and a vector containing the number 1 is represented as @scheme[`(,(box
1) ,(vector 1))]. If the parameter's value is @scheme[#t], then
@scheme[#&....] and @scheme[#(....)] are used, e.g., @scheme[`(#&1
#(1))]. The initial value of the parameter is @scheme[#t].}
@defboolparam[show-sharing show?]{
Parameter that determines whether sub-value sharing is conserved (and
shown) in the converted output by default. The initial value of the
parameter is @scheme[#t].}
@defboolparam[whole/fractional-exact-numbers whole-frac?]{
Parameter that controls how exact, non-integer numbers are converted
when the numerator is greater than the denominator. If the parameter's
value is @scheme[#t], the number is converted to the form @scheme[(+
_integer _fraction)] (i.e., a list containing @scheme['+], an exact
integer, and an exact rational less than @scheme[1] and greater than
@scheme[-1]). The initial value of the parameter is @scheme[#f].}

144
collects/scribblings/reference/match-grammar.ss
View File

@ -1,9 +1,5 @@
#lang scheme/base
(require scribble/scheme
scribble/basic
scribble/struct
scribble/manual
(for-label scheme/base))
(require "match-parse.ss")
(provide match-grammar)
@ -60,141 +56,5 @@ ooo ::= *** @zero or more; *** is literal
| __K @K or more
")
(define (match-nonterm s)
(make-element "schemevariable" (list s)))
(define (fixup s middle)
(lambda (m)
(make-element #f
(list (fixup-meaning (substring s 0 (caar m)))
middle
(fixup-meaning (substring s (cdar m)))))))
(define (fixup-meaning s)
(cond
[(regexp-match-positions #rx"pattern" s)
=> (fixup s "pattern")]
[(regexp-match-positions #rx"equal%" s)
=> (fixup s (scheme equal?))]
[(regexp-match-positions #rx"pat" s)
=> (fixup s (fixup-sexp 'pat))]
[(regexp-match-positions #rx"qp" s)
=> (fixup s (fixup-sexp 'qp))]
[(regexp-match-positions #rx"lvp" s)
=> (fixup s (fixup-sexp 'lvp))]
[(regexp-match-positions #rx"struct-id" s)
=> (fixup s (fixup-sexp 'struct-id))]
[(regexp-match-positions #rx"pred-expr" s)
=> (fixup s (fixup-sexp 'pred-expr))]
[(regexp-match-positions #rx"expr" s)
=> (fixup s (fixup-sexp 'expr))]
[(regexp-match-positions #rx"[*][*][*]" s)
=> (fixup s (schemeidfont "..."))]
[(regexp-match-positions #rx"[(]" s)
=> (fixup s (schemeparenfont "("))]
[(regexp-match-positions #rx"[)]" s)
=> (fixup s (schemeparenfont ")"))]
[(regexp-match-positions #rx"K" s)
=> (fixup s (match-nonterm "k"))]
[else s]))
(define (fixup-rhs s)
(let ([r (read (open-input-string s))])
(to-element (fixup-sexp r))))
(define (fixup-sexp s)
(cond
[(pair? s)
(cons (fixup-sexp (car s))
(fixup-sexp (cdr s)))]
[(vector? s)
(list->vector (map fixup-sexp (vector->list s)))]
[(box? s)
(box (fixup-sexp (unbox s)))]
[(symbol? s)
(case s
[(lvp pat qp literal ooo datum struct-id
string bytes number character expr id
rx-expr px-expr pred-expr
derived-pattern)
(match-nonterm (symbol->string s))]
[(QUOTE LIST LIST-REST LIST-NO-ORDER VECTOR HASH-TABLE BOX STRUCT
REGEXP PREGEXP AND OR NOT APP ? get! set! QUASIQUOTE)
(make-element "schemesymbol" (list (string-downcase (symbol->string s))))]
[(***)
(make-element "schemesymbol" '("..."))]
[(___) (make-element "schemesymbol" '("___"))]
[(__K)
(make-element #f (list (make-element "schemesymbol" '("__"))
(match-nonterm "k")))]
[(..K)
(make-element #f (list (make-element "schemesymbol" '(".."))
(match-nonterm "k")))]
[else
s])]
[else s]))
(define re:start-prod "^([^ ]*)( +)::= (.*[^ ])( +)[@](.*)$")
(define re:or-prod "^( +) [|] (.*[^ ])( +)[@](.*)$")
(define re:eng-prod "^([^ ]*)( +):== (.*)$")
(define lines (let ([lines (regexp-split "\r?\n" grammar)])
(reverse (cdr (reverse (cdr lines))))))
(define spacer (hspace 1))
(define (to-flow e)
(make-flow (list (make-paragraph (list e)))))
(define (table-line lhs eql rhs desc)
(list (to-flow lhs)
(to-flow spacer)
(to-flow eql)
(to-flow spacer)
(to-flow rhs)
(to-flow spacer)
(to-flow desc)))
(define equals (tt "::="))
(define -or- (tt " | "))
(define match-grammar
(make-table
#f
(map
(lambda (line)
(cond
[(regexp-match re:start-prod line)
=> (lambda (m)
(let ([prod (list-ref m 1)]
[lspace (list-ref m 2)]
[val (list-ref m 3)]
[rspace (list-ref m 4)]
[meaning (list-ref m 5)])
(table-line (match-nonterm prod)
equals
(fixup-rhs val)
(fixup-meaning meaning))))]
[(regexp-match re:eng-prod line)
=> (lambda (m)
(let ([prod (list-ref m 1)]
[lspace (list-ref m 2)]
[meaning (list-ref m 3)])
(table-line (match-nonterm prod)
equals
"???"
(fixup-meaning meaning))))]
[(regexp-match re:or-prod line)
=> (lambda (m)
(let ([lspace (list-ref m 1)]
[val (list-ref m 2)]
[rspace (list-ref m 3)]
[meaning (list-ref m 4)])
(table-line spacer
-or-
(fixup-rhs val)
(fixup-meaning meaning))))]
[else (error 'make-match-grammar
"non-matching line: ~e"
line)]))
lines)))
(parse-match-grammar grammar))

149
collects/scribblings/reference/match-parse.ss Normal file
View File

@ -0,0 +1,149 @@
#lang scheme/base
(require scribble/scheme
scribble/basic
scribble/struct
scribble/manual
(for-label scheme/base))
(provide parse-match-grammar)
(define (match-nonterm s)
(make-element "schemevariable" (list s)))
(define (fixup s middle)
(lambda (m)
(make-element #f
(list (fixup-meaning (substring s 0 (caar m)))
middle
(fixup-meaning (substring s (cdar m)))))))
(define (fixup-meaning s)
(cond
[(regexp-match-positions #rx"pattern" s)
=> (fixup s "pattern")]
[(regexp-match-positions #rx"equal%" s)
=> (fixup s (scheme equal?))]
[(regexp-match-positions #rx"pat" s)
=> (fixup s (fixup-sexp 'pat))]
[(regexp-match-positions #rx"qp" s)
=> (fixup s (fixup-sexp 'qp))]
[(regexp-match-positions #rx"lvp" s)
=> (fixup s (fixup-sexp 'lvp))]
[(regexp-match-positions #rx"struct-id" s)
=> (fixup s (fixup-sexp 'struct-id))]
[(regexp-match-positions #rx"pred-expr" s)
=> (fixup s (fixup-sexp 'pred-expr))]
[(regexp-match-positions #rx"expr" s)
=> (fixup s (fixup-sexp 'expr))]
[(regexp-match-positions #rx"[*][*][*]" s)
=> (fixup s (schemeidfont "..."))]
[(regexp-match-positions #rx"[(]" s)
=> (fixup s (schemeparenfont "("))]
[(regexp-match-positions #rx"[)]" s)
=> (fixup s (schemeparenfont ")"))]
[(regexp-match-positions #rx"K" s)
=> (fixup s (match-nonterm "k"))]
[else s]))
(define (fixup-rhs s)
(let ([r (read (open-input-string s))])
(to-element (fixup-sexp r))))
(define (fixup-sexp s)
(cond
[(pair? s)
(cons (fixup-sexp (car s))
(fixup-sexp (cdr s)))]
[(vector? s)
(list->vector (map fixup-sexp (vector->list s)))]
[(box? s)
(box (fixup-sexp (unbox s)))]
[(symbol? s)
(case s
[(lvp pat qp literal ooo datum struct-id
string bytes number character expr id
rx-expr px-expr pred-expr
derived-pattern)
(match-nonterm (symbol->string s))]
[(QUOTE LIST LIST-REST LIST-NO-ORDER VECTOR HASH-TABLE BOX STRUCT
REGEXP PREGEXP AND OR NOT APP ? get! set! QUASIQUOTE)
(make-element "schemesymbol" (list (string-downcase (symbol->string s))))]
[(***)
(make-element "schemesymbol" '("..."))]
[(___) (make-element "schemesymbol" '("___"))]
[(__K)
(make-element #f (list (make-element "schemesymbol" '("__"))
(match-nonterm "k")))]
[(..K)
(make-element #f (list (make-element "schemesymbol" '(".."))
(match-nonterm "k")))]
[else
s])]
[else s]))
(define re:start-prod #rx"^([^ ]*)( +)::= (.*[^ ])( +)[@](.*)$")
(define re:or-prod #rx"^( +) [|] (.*[^ ])( +)[@](.*)$")
(define re:eng-prod #rx"^([^ ]*)( +):== (.*)$")
(define (parse-match-grammar grammar)
(define lines (let ([lines (regexp-split "\r?\n" grammar)])
(reverse (cdr (reverse (cdr lines))))))
(define spacer (hspace 1))
(define (to-flow e)
(make-flow (list (make-paragraph (list e)))))
(define (table-line lhs eql rhs desc)
(list (to-flow lhs)
(to-flow spacer)
(to-flow eql)
(to-flow spacer)
(to-flow rhs)
(to-flow spacer)
(to-flow desc)))
(define equals (tt "::="))
(define -or- (tt " | "))
(make-table
#f
(map
(lambda (line)
(cond
[(regexp-match re:start-prod line)
=> (lambda (m)
(let ([prod (list-ref m 1)]
[lspace (list-ref m 2)]
[val (list-ref m 3)]
[rspace (list-ref m 4)]
[meaning (list-ref m 5)])
(table-line (match-nonterm prod)
equals
(fixup-rhs val)
(fixup-meaning meaning))))]
[(regexp-match re:eng-prod line)
=> (lambda (m)
(let ([prod (list-ref m 1)]
[lspace (list-ref m 2)]
[meaning (list-ref m 3)])
(table-line (match-nonterm prod)
equals
"???"
(fixup-meaning meaning))))]
[(regexp-match re:or-prod line)
=> (lambda (m)
(let ([lspace (list-ref m 1)]
[val (list-ref m 2)]
[rspace (list-ref m 3)]
[meaning (list-ref m 4)])
(table-line spacer
-or-
(fixup-rhs val)
(fixup-meaning meaning))))]
[else (error 'make-match-grammar
"non-matching line: ~e"
line)]))
lines)))

10
collects/scribblings/reference/match.scrbl
View File

@ -16,7 +16,7 @@ on regular-expression matching on strings, bytes, and streams.
@defform/subs[(match val-expr clause ...)
([clause [pat expr ...+]
[pat (=> identifier) expr ...+]])]{
[pat (=> id) expr ...+]])]{
Finds the first @scheme[pat] that matches the result of
@scheme[val-expr], and evaluates the corresponding @scheme[expr]s with
@ -27,7 +27,7 @@ the @scheme[match] expression.
The @scheme[clause]s are tried in order to find a match. If no
@scheme[clause] matches, then the @exnraise[exn:fail].
An optional @scheme[(=> identifier)] between a @scheme[pat] and the
An optional @scheme[(=> id)] between a @scheme[pat] and the
@scheme[expr]s is bound to a @defterm{failure procedure} of zero
arguments. If this procedure is invoked, it escapes back to the
pattern matching expression, and resumes the matching process as if
@ -74,9 +74,9 @@ In more detail, patterns match as follows:
[(list _ _ a) a])
]}
@item{@scheme[#t], @scheme[#f], @scheme[_string], @scheme[_number],
@scheme[_char], or @scheme[(#,(schemeidfont "quote") _datum)]
--- matches an @scheme[equal?] constant.
@item{@scheme[#t], @scheme[#f], @scheme[_string], @scheme[_bytes],
@scheme[_number], @scheme[_char], or @scheme[(#,(schemeidfont
"quote") _datum)] --- matches an @scheme[equal?] constant.
@examples[
#:eval match-eval

4
collects/scribblings/reference/pairs.scrbl
View File

@ -319,10 +319,10 @@ Returns @scheme[(remove* v lst eq?)].}
Returns @scheme[(remove* v lst eqv?)].}
@defproc[(sort [lst list?] [less-than procedure?])
@defproc[(sort [lst list?] [less-than? (any/c any/c . -> . any/c)])
list?]{
Returns a list sorted according to the @scheme[less-than] procedure,
Returns a list sorted according to the @scheme[less-than?] procedure,
which takes two elements of @scheme[lst] and returns a true value if
the first is less than (i.e., should be sorted earlier) than the
second.