From 15304f587024343e50fb72b6baed849459d76b6b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 6 Feb 2008 04:10:54 +0000 Subject: [PATCH] more mzlib scribbling svn: r8552 --- collects/mzlib/list.ss | 12 +- collects/mzlib/scribblings/list.scrbl | 75 ++++++ collects/mzlib/scribblings/match-grammar.ss | 47 ++++ collects/mzlib/scribblings/match.scrbl | 54 ++++ collects/mzlib/scribblings/math.scrbl | 9 + collects/mzlib/scribblings/mzlib.scrbl | 30 +++ collects/mzlib/scribblings/os.scrbl | 31 +++ .../mzlib/scribblings/pconvert-prop.scrbl | 25 ++ collects/mzlib/scribblings/pconvert.scrbl | 238 ++++++++++++++++++ .../scribblings/reference/match-grammar.ss | 144 +---------- collects/scribblings/reference/match-parse.ss | 149 +++++++++++ collects/scribblings/reference/match.scrbl | 10 +- collects/scribblings/reference/pairs.scrbl | 4 +- 13 files changed, 673 insertions(+), 155 deletions(-) create mode 100644 collects/mzlib/scribblings/list.scrbl create mode 100644 collects/mzlib/scribblings/match-grammar.ss create mode 100644 collects/mzlib/scribblings/match.scrbl create mode 100644 collects/mzlib/scribblings/math.scrbl create mode 100644 collects/mzlib/scribblings/os.scrbl create mode 100644 collects/mzlib/scribblings/pconvert-prop.scrbl create mode 100644 collects/mzlib/scribblings/pconvert.scrbl create mode 100644 collects/scribblings/reference/match-parse.ss diff --git a/collects/mzlib/list.ss b/collects/mzlib/list.ss index f3e58957cd..9b9850cf2c 100644 --- a/collects/mzlib/list.ss +++ b/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))) - - (define cons? (lambda (x) (pair? x))) - (define empty? (lambda (x) (null? x))) - (define empty '())) + (raise-type-error 'last-pair "pair" l)))) diff --git a/collects/mzlib/scribblings/list.scrbl b/collects/mzlib/scribblings/list.scrbl new file mode 100644 index 0000000000..d2e1de94e6 --- /dev/null +++ b/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].} diff --git a/collects/mzlib/scribblings/match-grammar.ss b/collects/mzlib/scribblings/match-grammar.ss new file mode 100644 index 0000000000..185be7a131 --- /dev/null +++ b/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)) diff --git a/collects/mzlib/scribblings/match.scrbl b/collects/mzlib/scribblings/match.scrbl new file mode 100644 index 0000000000..1eb5dc11fe --- /dev/null +++ b/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].} diff --git a/collects/mzlib/scribblings/math.scrbl b/collects/mzlib/scribblings/math.scrbl new file mode 100644 index 0000000000..5f937c3b98 --- /dev/null +++ b/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]. diff --git a/collects/mzlib/scribblings/mzlib.scrbl b/collects/mzlib/scribblings/mzlib.scrbl index e7e051b057..84c608902d 100644 --- a/collects/mzlib/scribblings/mzlib.scrbl +++ b/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" diff --git a/collects/mzlib/scribblings/os.scrbl b/collects/mzlib/scribblings/os.scrbl new file mode 100644 index 0000000000..56d143ab0c --- /dev/null +++ b/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.} + + diff --git a/collects/mzlib/scribblings/pconvert-prop.scrbl b/collects/mzlib/scribblings/pconvert-prop.scrbl new file mode 100644 index 0000000000..943be116ef --- /dev/null +++ b/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.} + diff --git a/collects/mzlib/scribblings/pconvert.scrbl b/collects/mzlib/scribblings/pconvert.scrbl new file mode 100644 index 0000000000..f74855958c --- /dev/null +++ b/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].} + diff --git a/collects/scribblings/reference/match-grammar.ss b/collects/scribblings/reference/match-grammar.ss index 5fb30c1b8c..25aa21bcd8 100644 --- a/collects/scribblings/reference/match-grammar.ss +++ b/collects/scribblings/reference/match-grammar.ss @@ -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)) diff --git a/collects/scribblings/reference/match-parse.ss b/collects/scribblings/reference/match-parse.ss new file mode 100644 index 0000000000..07aced6557 --- /dev/null +++ b/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))) + + diff --git a/collects/scribblings/reference/match.scrbl b/collects/scribblings/reference/match.scrbl index 8b5ecf2264..a309b9c344 100644 --- a/collects/scribblings/reference/match.scrbl +++ b/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], - @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 diff --git a/collects/scribblings/reference/pairs.scrbl b/collects/scribblings/reference/pairs.scrbl index 1325aa0a4f..ca8aa686f4 100644 --- a/collects/scribblings/reference/pairs.scrbl +++ b/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.