more mzlib scribbling

svn: r8552

collects/mzlib/list.ss

@@ -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)))
+      (raise-type-error 'last-pair "pair" l))))
-
-  (define cons? (lambda (x) (pair? x)))
-  (define empty? (lambda (x) (null? x)))
-  (define empty '()))
 

collects/mzlib/scribblings/list.scrbl

@@ -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].}

collects/mzlib/scribblings/match-grammar.ss

@@ -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))

collects/mzlib/scribblings/match.scrbl

@@ -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].}

collects/mzlib/scribblings/math.scrbl

@@ -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].

collects/mzlib/scribblings/mzlib.scrbl

@@ -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"

collects/mzlib/scribblings/os.scrbl

@@ -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.}
+
+

collects/mzlib/scribblings/pconvert-prop.scrbl

@@ -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.}
+

collects/mzlib/scribblings/pconvert.scrbl

@@ -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].}
+

collects/scribblings/reference/match-grammar.ss

@@ -1,9 +1,5 @@
 #lang scheme/base
-(require scribble/scheme
+(require "match-parse.ss")
-         scribble/basic
-         scribble/struct
-         scribble/manual
-         (for-label scheme/base))
 
 (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
+  (parse-match-grammar grammar))
-   #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)))

collects/scribblings/reference/match-parse.ss

@@ -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)))
+
+

collects/scribblings/reference/match.scrbl

@@ -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],
+ @item{@scheme[#t], @scheme[#f], @scheme[_string], @scheme[_bytes],
-       @scheme[_char], or @scheme[(#,(schemeidfont "quote") _datum)]
+       @scheme[_number], @scheme[_char], or @scheme[(#,(schemeidfont
-       --- matches an @scheme[equal?] constant.
+       "quote") _datum)] --- matches an @scheme[equal?] constant.
 
        @examples[
        #:eval match-eval

collects/scribblings/reference/pairs.scrbl

@@ -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.