get rid of for-values, change document format for mini-grammars

svn: r6549
This commit is contained in:
Matthew Flatt 2007-06-09 01:13:52 +00:00
parent 6ced0347a5
commit 7d7cae8bf2
10 changed files with 211 additions and 213 deletions

View File

@ -1,13 +1,13 @@
(module for mzscheme
(provide for/fold for/fold-values for*/fold for*/fold-values
for for-values for* for*-values
for/list for/list-values for*/list for*/list-values
for/lists for/lists-values for*/lists for*/lists-values
for/and for/and-values for*/and for*/and-values
for/or for/or-values for*/or for*/or-values
for/first for/first-values for*/first for*/first-values
for/last for/last-values for*/last for*/last-values
(provide for/fold for*/fold
for for*
for/list for*/list
for/lists for*/lists
for/and for*/and
for/or for*/or
for/first for*/first
for/last for*/last
(rename *in-range in-range)
(rename *in-naturals in-naturals)
@ -587,13 +587,13 @@
(define-syntax (for/foldX/derived stx)
(syntax-case stx ()
;; Done case (no more clauses, and no generated clauses to emit):
[(_ [orig-stx multi? first-multi? nested? emit? ()] ([fold-var fold-init] ...) () expr1 expr ...)
[(_ [orig-stx nested? emit? ()] ([fold-var fold-init] ...) () expr1 expr ...)
#`(let ([fold-var fold-init] ...) (let () expr1 expr ...))]
;; Switch-to-emit case (no more clauses to generate):
[(_ [orig-stx multi? first-multi? nested? #f binds] ([fold-var fold-init] ...) () . body)
#`(for/foldX/derived [orig-stx multi? first-multi? nested? #t binds] ([fold-var fold-init] ...) () . body)]
[(_ [orig-stx nested? #f binds] ([fold-var fold-init] ...) () . body)
#`(for/foldX/derived [orig-stx nested? #t binds] ([fold-var fold-init] ...) () . body)]
;; Emit case:
[(_ [orig-stx multi? first-multi? nested? #t binds] ([fold-var fold-init] ...) rest . body)
[(_ [orig-stx nested? #t binds] ([fold-var fold-init] ...) rest . body)
(with-syntax ([(([outer-binding ...]
outer-check
[loop-binding ...]
@ -610,7 +610,7 @@
(let-values (inner-binding ... ...)
(if (and pre-guard ...)
(let-values ([(fold-var ...)
(for/foldX/derived [orig-stx multi? first-multi? nested? #f ()] ([fold-var fold-var] ...) rest . body)])
(for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-var] ...) rest . body)])
(if (and post-guard ...)
(comp-loop fold-var ... loop-arg ... ...)
(values* fold-var ...)))
@ -628,17 +628,17 @@
"bad syntax (illegal use of `.') after sequence bindings"
#'orig-stx)]
;; Guard case, no pending emits:
[(_ [orig-stx multi? first-multi? nested? #f ()] ([fold-var fold-init] ...) (#:when expr . rest) . body)
[(_ [orig-stx nested? #f ()] ([fold-var fold-init] ...) (#:when expr . rest) . body)
#'(if expr
(for/foldX/derived [orig-stx multi? first-multi? nested? #f ()] ([fold-var fold-init] ...) rest . body)
(for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-init] ...) rest . body)
(values* fold-init ...))]
;; Guard case, pending emits need to be flushed first
[(_ [orig-stx multi? first-multi? nested? #f binds] ([fold-var fold-init] ...) (#:when expr . rest) . body)
#'(_ [orig-stx multi? first-multi? nested? #t binds] ([fold-var fold-init] ...) (#:when expr . rest) . body)]
[(_ [orig-stx nested? #f binds] ([fold-var fold-init] ...) (#:when expr . rest) . body)
#'(_ [orig-stx nested? #t binds] ([fold-var fold-init] ...) (#:when expr . rest) . body)]
;; Convert single-value form to multi-value form:
[(_ [orig-stx #f #f nested? #f binds] fold-bind ([id rhs] . rest) . body)
[(_ [orig-stx nested? #f binds] fold-bind ([id rhs] . rest) . body)
(identifier? #'id)
#'(for/foldX/derived [orig-stx #f #t nested? #f binds] fold-bind ([(id) rhs] . rest) . body)]
#'(for/foldX/derived [orig-stx nested? #f binds] fold-bind ([(id) rhs] . rest) . body)]
;; If we get here in single-value mode, then it's a bad clause:
[(_ [orig-stx #f #f nested? #f binds] fold-bind (clause . rest) . body)
(raise-syntax-error
@ -647,31 +647,21 @@
#'orig-stx
#'clause)]
;; Expand one multi-value clause, and push it into the results to emit:
[(_ [orig-stx multi? #t nested? #f binds] ([fold-var fold-init] ...) (clause . rest) . body)
[(_ [orig-stx nested? #f binds] ([fold-var fold-init] ...) (clause . rest) . body)
(with-syntax ([bind (expand-clause #'orig-stx #'clause)])
#`(_ [orig-stx multi? multi? nested? nested? (bind . binds)] ([fold-var fold-init] ...) rest . body))]
#`(_ [orig-stx nested? nested? (bind . binds)] ([fold-var fold-init] ...) rest . body))]
[(_ [orig-stx . _rest] . _rest2)
(raise-syntax-error #f "bad syntax" #'orig-stx)]))
(define-syntax for/fold/derived
(syntax-rules ()
[(_ orig-stx . rest)
(for/foldX/derived [orig-stx #f #f #f #f ()] . rest)]))
(define-syntax for/fold-values/derived
(syntax-rules ()
[(_ orig-stx . rest)
(for/foldX/derived [orig-stx #t #t #f #f ()] . rest)]))
(for/foldX/derived [orig-stx #f #f ()] . rest)]))
(define-syntax for*/fold/derived
(syntax-rules ()
[(_ orig-stx . rest)
(for/foldX/derived [orig-stx #f #f #t #f ()] . rest)]))
(define-syntax for*/fold-values/derived
(syntax-rules ()
[(_ orig-stx . rest)
(for/foldX/derived [orig-stx #t #t #t #f ()] . rest)]))
(for/foldX/derived [orig-stx #t #f ()] . rest)]))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; derived `for' syntax
@ -714,39 +704,31 @@
(define-syntax define-for-variants
(syntax-rules ()
[(_ (for for-values for* for*-values) fold-bind wrap rhs-wrap combine)
[(_ (for for*) fold-bind wrap rhs-wrap combine)
(begin
(define-syntax-via-derived for for/fold/derived fold-bind wrap rhs-wrap combine #f)
(define-syntax-via-derived for-values for/fold-values/derived fold-bind wrap rhs-wrap combine #t)
(define-syntax-via-derived for* for*/fold/derived fold-bind wrap rhs-wrap combine #f)
(define-syntax-via-derived for*-values for*/fold-values/derived fold-bind wrap rhs-wrap combine #t))]))
(define-syntax-via-derived for* for*/fold/derived fold-bind wrap rhs-wrap combine #f))]))
(define-syntax (for/fold stx)
(syntax-case stx ()
[(_ . rest) (quasisyntax/loc stx (for/fold/derived #,stx . rest))]))
(define-syntax (for/fold-values stx)
(syntax-case stx ()
[(_ . rest) (quasisyntax/loc stx (for/fold-values/derived #,stx . rest))]))
(define-syntax (for*/fold stx)
(syntax-case stx ()
[(_ . rest) (quasisyntax/loc stx (for*/fold/derived #,stx . rest))]))
(define-syntax (for*/fold-values stx)
(syntax-case stx ()
[(_ . rest) (quasisyntax/loc stx (for*/fold-values/derived #,stx . rest))]))
(define-for-variants (for for-values for* for*-values)
(define-for-variants (for for*)
([fold-var (void)])
(lambda (x) x)
(lambda (x) x)
(lambda (x) `(,#'begin ,x ,#'(void))))
(define-for-variants (for/list for/list-values for*/list for*/list-values)
(define-for-variants (for/list for*/list)
([fold-var null])
(lambda (x) `(,#'reverse ,x))
(lambda (x) x)
(lambda (x) `(,#'cons ,x ,#'fold-var)))
(define-for-syntax (make-for/lists-values for/fold-id)
(define-for-syntax (make-for/lists for/fold-id)
(lambda (stx)
(syntax-case stx ()
[(_ (id ...) bindings expr1 expr ...)
@ -769,30 +751,28 @@
(values* (cons id2 id) ...)))])
(values* (reverse id) ...))))])))
(define-syntax for/lists (make-for/lists-values #'for/fold/derived))
(define-syntax for/lists-values (make-for/lists-values #'for/fold-values/derived))
(define-syntax for*/lists (make-for/lists-values #'for*/fold/derived))
(define-syntax for*/lists-values (make-for/lists-values #'for*/fold-values/derived))
(define-syntax for/lists (make-for/lists #'for/fold/derived))
(define-syntax for*/lists (make-for/lists #'for*/fold/derived))
(define-for-variants (for/and for/and-values for*/and for*/and-values)
(define-for-variants (for/and for*/and)
([result #t])
(lambda (x) x)
(lambda (rhs) #`(stop-after #,rhs (lambda x (not result))))
(lambda (x) x))
(define-for-variants (for/or for/or-values for*/or for*/or-values)
(define-for-variants (for/or for*/or)
([result #f])
(lambda (x) x)
(lambda (rhs) #`(stop-after #,rhs (lambda x result)))
(lambda (x) x))
(define-for-variants (for/first for/first-values for*/first for*/first-values)
(define-for-variants (for/first for*/first)
([val #f][stop? #f])
(lambda (x) #`(let-values ([(val _) #,x]) val))
(lambda (rhs) #`(stop-after #,rhs (lambda x stop?)))
(lambda (x) #`(values #,x #t)))
(define-for-variants (for/last for/last-values for*/last for*/last-values)
(define-for-variants (for/last for*/last)
([result #f])
(lambda (x) x)
(lambda (rhs) rhs)

View File

@ -203,6 +203,7 @@
`(td (,@(case a
[(#f) null]
[(right) '((align "right"))]
[(center) '((align "center"))]
[(left) '((align "left"))])
,@(case va
[(#f) null]

View File

@ -241,6 +241,9 @@
[(#\<) (if (rendering-tt)
(display "{\\texttt <}")
(display "$<$"))]
[(#\|) (if (rendering-tt)
(display "{\\texttt |}")
(display "$|$"))]
[(#\? #\! #\. #\:) (if (rendering-tt)
(printf "{\\hbox{\\texttt{~a}}}" c)
(display c))]

View File

@ -146,8 +146,9 @@
;; ----------------------------------------
(provide defproc defproc* defstruct defthing defform defform* defform/none
(provide defproc defproc* defstruct defthing defform defform* defform/subs defform*/subs defform/none
specform specsubform specsubform/inline
schemegrammar
var svar void-const undefined-const)
(define void-const
@ -205,9 +206,9 @@
(syntax-rules ()
[(_ name fields desc ...)
(*defstruct 'name 'fields (lambda () (list desc ...)))]))
(define-syntax (defform* stx)
(define-syntax (defform*/subs stx)
(syntax-case stx ()
[(_ [spec spec1 ...] desc ...)
[(_ [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
(with-syntax ([new-spec
(syntax-case #'spec ()
[(name . rest)
@ -218,17 +219,32 @@
#'name)
#'rest)
#'spec)])])
#'(*defforms #t '(spec spec1 ...)
#'(*defforms #t
'(spec spec1 ...)
(list (lambda (x) (schemeblock0 new-spec))
(lambda (ignored) (schemeblock0 spec1)) ...)
'((non-term-id non-term-form ...) ...)
(list (list (lambda () (scheme non-term-id))
(lambda () (schemeblock0 non-term-form))
...)
...)
(lambda () (list desc ...))))]))
(define-syntax (defform* stx)
(syntax-case stx ()
[(_ [spec ...] desc ...) #'(defform*/subs [spec ...] () desc ...)]))
(define-syntax (defform stx)
(syntax-case stx ()
[(_ spec desc ...) #'(defform* [spec] desc ...)]))
[(_ spec desc ...) #'(defform*/subs [spec] () desc ...)]))
(define-syntax (defform/subs stx)
(syntax-case stx ()
[(_ spec subs desc ...) #'(defform*/subs [spec] subs desc ...)]))
(define-syntax (defform/none stx)
(syntax-case stx ()
[(_ spec desc ...)
#'(*defforms #f '(spec) (list (lambda (ignored) (schemeblock0 spec))) (lambda () (list desc ...)))]))
#'(*defforms #f
'(spec) (list (lambda (ignored) (schemeblock0 spec)))
null null
(lambda () (list desc ...)))]))
(define-syntax specsubform
(syntax-rules ()
[(_ spec desc ...)
@ -245,6 +261,9 @@
(syntax-rules ()
[(_ id result desc ...)
(*defthing 'id 'result (lambda () (list desc ...)))]))
(define-syntax schemegrammar
(syntax-rules ()
[(_ id clause ...) (*schemegrammar (scheme id) (schemeblock0 clause) ...)]))
(define-syntax var
(syntax-rules ()
[(_ id) (*var 'id)]))
@ -450,12 +469,13 @@
(define (meta-symbol? s) (memq s '(... ...+ ?)))
(define (*defforms kw? forms form-procs content-thunk)
(define (*defforms kw? forms form-procs subs sub-procs content-thunk)
(parameterize ([current-variable-list
(apply
append
(map (lambda (form)
(let loop ([form (if kw? (cdr form) form)])
(let loop ([form (cons (if kw? (cdr form) form)
subs)])
(cond
[(symbol? form) (if (meta-symbol? form)
null
@ -468,24 +488,32 @@
(cons
(make-table
'boxed
(map (lambda (form form-proc)
(list
(make-flow
(list
((or form-proc
(lambda (x)
(make-paragraph
(list
(to-element
`(,x
. ,(cdr form)))))))
(and kw?
(eq? form (car forms))
(make-target-element
#f
(list (to-element (car form)))
(register-scheme-form-definition (car form)))))))))
forms form-procs))
(append
(map (lambda (form form-proc)
(list
(make-flow
(list
((or form-proc
(lambda (x)
(make-paragraph
(list
(to-element
`(,x
. ,(cdr form)))))))
(and kw?
(eq? form (car forms))
(make-target-element
#f
(list (to-element (car form)))
(register-scheme-form-definition (car form)))))))))
forms form-procs)
(apply
append
(map (lambda (sub)
(list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
(list (make-flow (list (apply *schemegrammar
(map (lambda (f) (f)) sub)))))))
sub-procs))))
(content-thunk)))))
(define (*specsubform form has-kw? form-thunk content-thunk)
@ -512,6 +540,26 @@
(make-paragraph (list (to-element form)))))))))
(flow-paragraphs (decode-flow (content-thunk)))))))
(define (*schemegrammar nonterm clause1 . clauses)
(make-table
'((valignment baseline baseline baseline baseline baseline)
(alignment left left center left left))
(let ([empty-line (make-flow (list (make-paragraph (list (tt 'nbsp)))))]
[to-flow (lambda (i) (make-flow (list (make-paragraph (list i)))))])
(cons
(list (to-flow nonterm)
empty-line
(to-flow "=")
empty-line
(make-flow (list clause1)))
(map (lambda (clause)
(list empty-line
empty-line
(to-flow "|")
empty-line
(make-flow (list clause))))
clauses)))))
(define (*var id)
(to-element (*var-sym id)))

View File

@ -105,7 +105,10 @@
(set! col-map next-col-map)
(set! next-col-map (make-hash-table 'equal))
(init-line!))
(let ([d-col (hash-table-get col-map c (+ dest-col (- c src-col)))])
(let ([d-col (let ([def-val (+ dest-col (- c src-col))])
(if new-line?
(hash-table-get col-map c def-val)
def-val))])
(let ([amt (- d-col dest-col)])
(when (positive? amt)
(let ([old-dest-col dest-col])

View File

@ -347,21 +347,21 @@ elements. For example, a hash table as a sequence generates two
values for each iteration: a key and a value.
In the same way that @scheme[let-values] binds multiple results to
multiple identifiers, @scheme[for-values] binds multiple sequence
elements to multiple iteration identifiers:
multiple identifiers, @scheme[for] can bind multiple sequence elements
to multiple iteration identifiers:
@interaction[
(for-values ([(k v) #hash(("apple" . 1) ("banana" . 3))])
(for ([(k v) #hash(("apple" . 1) ("banana" . 3))])
(printf "~a count: ~a\n" k v))
]
A @schemekeywordfont{-values} variant exists for all @scheme[for]
variants. For example, @scheme[for*/list-values] nests iterations,
builds a list, and works with multiple-valued sequences:
This extension to multiple-value bindings works for all @scheme[for]
variants. For example, @scheme[for*/list] nests iterations, builds a
list, and also works with multiple-valued sequences:
@interaction[
(for*/list-values ([(k v) #hash(("apple" . 1) ("banana" . 3))]
[(i) (in-range v)])
(for*/list ([(k v) #hash(("apple" . 1) ("banana" . 3))]
[(i) (in-range v)])
k)
]
@ -380,19 +380,36 @@ loops when enough information is apparent about the sequences to
iterate. Specifically, the clause should have one of the following
@scheme[_fast-clause] forms:
@schemeblock[
#, @is-one-of[@scheme[_fast-clause]]
[_id (in-range _expr)]
[_id (in-range _expr _expr)]
[_id (in-range _expr _expr _expr)]
[_id (in-naturals)]
[_id (in-naturals _expr)]
[_id (in-list _expr)]
[_id (in-vector _expr)]
[_id (in-string _expr)]
[_id (in-bytes _expr)]
[_id (stop-before _fast-clause _predicate-expr)]
[_id (stop-after _fast-clause _predicate-expr)]
@schemegrammar[
_fast-clause [_id _fast-seq]
[(_id) _fast-seq]
[(_id _id) _fast-indexed-seq]
[(_id ...) _fast-parallel-seq]
]
@schemegrammar[
_fast-seq (in-range _expr _expr)
(in-range _expr _expr _expr)
(in-naturals)
(in-naturals _expr)
(in-list _expr)
(in-vector _expr)
(in-string _expr)
(in-bytes _expr)
(stop-before _fast-seq _predicate-expr)
(stop-after _fast-seq _predicate-expr)
]
@schemegrammar[
_fast-indexed-seq (in-indexed _fast-seq)
(stop-before _fast-indexed-seq _predicate-expr)
(stop-after _fast-indexed-seq _predicate-expr)
]
@schemegrammar[
_fast-parallel-seq (in-parallel _fast-seq ...)
(stop-before _fast-parallel-seq _predicate-expr)
(stop-after _fast-parallel-seq _predicate-expr)
]
@examples[
@ -408,18 +425,6 @@ iterate. Specifically, the clause should have one of the following
(void)))))
]
In the case of @scheme[for-values] forms, a few more
@scheme[_fast-values-clause]s provide good performance, in addition to
the obvious variants of @scheme[_fast-clause] forms:
@schemeblock[
#, @is-one-of[@scheme[_fast-values-clause]]
[(_id) (in-range _expr)]
...
[(_id _id) (in-indexed _fast-clause)]
[(_id ...) (in-parallel _fast-clause ...)]
]
The grammars above are not complete, because the set of syntactic
patterns that provide good performance is extensible, just like the
set of sequence values. The documentation for a sequence constructor

View File

@ -471,8 +471,8 @@ procedure. In other words, the @scheme[lambda]-generated procedure
@interaction[
(define louder (make-add-suffix "!"))
(define less-sure (make-add-suffix "?"))
(twice less-sure "yeah")
(twice louder "yeah")
(twice less-sure "really")
(twice louder "really")
]
We have so far referred to definitions of the form @scheme[(define #,

View File

@ -1,40 +1,47 @@
#reader(lib "docreader.ss" "scribble")
@require["mz.ss"]
@interaction-eval[(require (lib "for.ss"))]
@title[#:tag "mz:derived-syntax"]{Derived Syntactic Forms}
@section[#:tag "mz:for"]{Iterations and Comprehensions: @scheme[for], @scheme[for/list], ...}
@guideintro["guide:for"]{iterations and comprehensions}
@defform[(for (for-clause ...) . body)]{
@defform/subs[(for (for-clause ...) . body)
([for-clause [id seq-expr]
[(id ...) seq-expr]
(code:line #:when guard-expr)])]{
Iteratively evaluates @scheme[body]. The @scheme[for-clause]s
introduce bindings whose scope inculdes @scheme[body] and that
determine the number of times that @scheme[body] is evaluated.
In the simple case, each @scheme[for-clause] has the form
In the simple case, each @scheme[for-clause] has one of its first two
forms, where @scheme[[id seq-expr]] is a shorthand for @scheme[[(id
...) seq-expr]]. In this simple case, the @scheme[seq-expr]s are
evaluated left-to-right, and each must produce a sequence value (see
@secref["mz:sequences"]).
@specsubform[[id seq-expr]]{}
The @scheme[for] form iterates by drawing an element from each
sequence; if any sequence is empty, then the iteration stops, and
@|void-const| is the result of the @scheme[for] expression. Otherwise
a location is created for each @scheme[id] to hold the values of each
element; the sequence produced by a @scheme[seq-expr] must return as
many values for each iteration as corresponding @scheme[id]s.
In this case, the @scheme[_seq-expr]s are evaluated left-to-right, and
each must produce a sequence value (see @secref["mz:sequences"]). The
@scheme[for] form iterates by drawing an element from each sequence;
if any sequence is empty, then the iteration stops, and @|void-const|
is the result of the @scheme[for] expression. Otherwise a location is
created for each @scheme[_id] to hold the corresponding element. The
@scheme[_id]s are then bound in the @scheme[body], which is evaluated,
and whose result(s) is(are) ignored. Iteration continues with the next
element in each sequence and with fresh locations for each
@scheme[_id]. Zero @scheme[for-clause]s is equivalent to a single
@scheme[for-clause] that binds an unreferenced @scheme[_id] to a
sequence containing one element. All of the @scheme[_id]s must be
distinct according to @scheme[bound-identifier=?].
The @scheme[id]s are then bound in the @scheme[body], which is
evaluated, and whose results are ignored. Iteration continues with the
next element in each sequence and with fresh locations for each
@scheme[id].
If any @scheme[for-clause] has the form
@specsubform[(code:line #:when guard-expr)]{}
A @scheme[for] form with zero @scheme[for-clause]s is equivalent to a
single @scheme[for-clause] that binds an unreferenced @scheme[id] to
a sequence containing a single element. All of the @scheme[id]s must
be distinct according to @scheme[bound-identifier=?].
If any @scheme[for-clause] has the form @scheme[#:when guard-expr],
then only the preceding clauses (containing no @scheme[#:when])
determine iteration as above, and the @scheme[body] is effectively
wrapped as
@ -52,6 +59,8 @@ using the remaining @scheme[for-clauses].
#:when (odd? i)
[k #2(#t #f)])
(display (list i j k)))
(for ([(i j) #hash(("a" . 1) ("b" . 20))])
(display (list i j)))
(for ()
(display "here"))
(for ([i '()])
@ -146,8 +155,8 @@ for each @scheme[accum-id], and the correspinding current accumulator
value is placed into the location. The last expression in
@scheme[body] must produce as many values as @scheme[accum-id]s, and
those values become the current accumulator values. When iteration
terminates, the result of the @scheme[fold/for] expression is(are) the
accumulator value(s).
terminates, the results of the @scheme[fold/for] expression are the
accumulator values.
@examples[
(for/fold ([sum 0]
@ -189,64 +198,3 @@ Like @scheme[for/last], but with the implicit nesting of @scheme[for*].}
@defform[(for*/fold ([accum-id init-expr] ...) (for-clause ...) . body)]{
Like @scheme[for/fold], but with the implicit nesting of @scheme[for*].}
@defform[(for-values (for-values-clause ...) . body)]{ Like
@scheme[for], but each @scheme[for-values-clause] has one of the
following two forms:
@specsubform[[(id ...) seq-expr]]{ The sequence produced by
@scheme[_seq-expr] must return as many values for each iteration as
@scheme[id]s, and the values are placed in the locations generated
for the @scheme[id]s.}
@specsubform[(code:line #:when guard-expr)]{As in @scheme[for].}
@examples[
(for-values ([(i j) #hash(("a" . 1) ("b" . 20))])
(display (list i j)))
]}
@defform[(for/list-values (for-values-clause ...) . body)]{ Like
@scheme[for/list], but with multiple-value clauses like
@scheme[for-values].}
@defform[(for/and-values (for-values-clause ...) . body)]{ Like
@scheme[for-and], but with multiple-value clauses like
@scheme[for-values].}
@defform[(for/or-values (for-values-clause ...) . body)]{ Like
@scheme[for/or], but with multiple-value clauses like
@scheme[for-values].}
@defform[(for/first-values (for-values-clause ...) . body)]{ Like
@scheme[for/first], but with multiple-value clauses like
@scheme[for-values].}
@defform[(for/last-values (for-values-clause ...) . body)]{ Like
@scheme[for/last], but with multiple-value clauses like
@scheme[for-values].}
@defform[(for/fold-values ([id expr] ...) (for-values-clause ...) . body)]{ Like
@scheme[for/fold], but with multiple-value clauses like
@scheme[for-values].}
@defform[(for*-values (for-values-clause ...) . body)]{
Like @scheme[for-values], but with the implicit nesting of @scheme[for*].}
@defform[(for*/list-values (for-values-clause ...) . body)]{
Like @scheme[for/list-values], but with the implicit nesting of @scheme[for*].}
@defform[(for*/and-values (for-values-clause ...) . body)]{
Like @scheme[for/and-values], but with the implicit nesting of @scheme[for*].}
@defform[(for*/or-values (for-values-clause ...) . body)]{
Like @scheme[for/or-values], but with the implicit nesting of @scheme[for*].}
@defform[(for*/first-values (for-values-clause ...) . body)]{
Like @scheme[for/first-values], but with the implicit nesting of @scheme[for*].}
@defform[(for*/last-values (for-values-clause ...) . body)]{
Like @scheme[for/last-values], but with the implicit nesting of @scheme[for*].}
@defform[(for*/fold-values ([id expr] ...) (for-values-clause ...) . body)]{
Like @scheme[for/fold-values], but with the implicit nesting of @scheme[for*].}

View File

@ -152,15 +152,25 @@ according to their order in the application form.
@guideintro["guide:lambda"]{procedure expressions}
@defform[(lambda formals* . body)]{
@defform/subs[(lambda formals* . body)
([formals (id ...)
(id ...+ . rest-id)
rest-id]
[formals* formals
(formal-arg ...)
(formal-arg ...+ . rest-id)]
[formal-arg id
[id default-expr]
(code:line keyword id)
(code:line keyword [id default-expr])])]{
Procedures a procedure. The @scheme[formals*] determines the number of
Produces a procedure. The @scheme[formals*] determines the number of
arguments that the procedure accepts. It is either a simple
@scheme[_formals], or one of the extended forms.
A simple @scheme[_formals] has one of the following three forms:
@specsubform[(id ... )]{ The procedure accepts as many non-keyword
@specsubform[(id ...)]{ The procedure accepts as many non-keyword
argument values as the number of @scheme[id]s. Each @scheme[id]
is associated with an argument value by position.}

View File

@ -13,20 +13,20 @@
[((v2 ...) ...)
(apply map list (map syntax->list (syntax->list #'((v ...) ...))))])
#'(begin
(test '((v2 ...) ...) 'gen (for/list-values ([(id ...) gen])
(test '((v2 ...) ...) 'gen (for/list ([(id ...) gen])
(list id ...)))
(test-values '((v ...) ...) (lambda ()
(for/lists-values (id2 ...) ([(id ...) gen])
(for/lists (id2 ...) ([(id ...) gen])
(values id ...))))
(test #t 'gen (for/and-values ([(id ...) gen])
(test #t 'gen (for/and ([(id ...) gen])
(and (member (list id ...) '((v2 ...) ...)) #t)))
(test (list (for/last-values ([(id ...) gen])
(test (list (for/last ([(id ...) gen])
(list id ...)))
'gen (for/and-values ([(id ...) gen])
'gen (for/and ([(id ...) gen])
(member (list id ...) '((v2 ...) ...))))
(test (for/first-values ([(id ...) gen])
(test (for/first ([(id ...) gen])
(list id ...))
'gen (for/or-values ([(id ...) gen])
'gen (for/or ([(id ...) gen])
(car (member (list id ...) '((v2 ...) ...)))))
(void)))]))
@ -48,7 +48,7 @@
(reverse r)))
(test 'seq 'gen (reverse (for/fold ([a null]) ([i gen])
(cons i a))))
(test 'seq 'gen (let-values ([(more? next) (sequence-generator gen)])
(test 'seq 'gen (let-values ([(more? next) (sequence-generate gen)])
(let loop ()
(if (more?)
(cons (next) (loop))
@ -59,7 +59,7 @@
(test (list (for/last ([i gen]) i)) 'gen (for/and ([i gen]) (member i 'seq)))
(test 'seq 'gen (for/or ([i gen]) (member i 'seq)))
(test (for/first ([i gen]) i) 'gen (for/or ([i gen]) (and (member i 'seq) i)))
(test #t 'gen (for/and-values ([(i k) (in-parallel gen 'seq)])
(test #t 'gen (for/and ([(i k) (in-parallel gen 'seq)])
(equal? i k)))
(test #f 'gen (for/and ([i gen])
(member i (cdr (reverse 'seq)))))
@ -70,7 +70,7 @@
(test #f 'or (for/or ([i gen]) (set! count (add1 count)) #f))
(test (+ 1 (length 'seq)) 'count count)
(set! count 0)
(let ([second (for/last-values ([(i pos) (in-parallel gen (in-naturals))] #:when (< pos 2))
(let ([second (for/last ([(i pos) (in-parallel gen (in-naturals))] #:when (< pos 2))
(set! count (add1 count))
i)])
(test second list-ref 'seq 1)
@ -89,10 +89,10 @@
(for ([i g]) (set! count (add1 count))))
(test 10 values count))
(set! count 0)
(test #t 'and (for/and-values ([(e idx) (in-indexed gen)]) (set! count (add1 count)) (equal? idx (sub1 count))))
(test #t 'and (for/and ([(e idx) (in-indexed gen)]) (set! count (add1 count)) (equal? idx (sub1 count))))
(test #t 'and (let ([g (in-indexed gen)])
(set! count 0)
(for/and-values ([(e idx) g]) (set! count (add1 count)) (equal? idx (sub1 count)))))
(for/and ([(e idx) g]) (set! count (add1 count)) (equal? idx (sub1 count)))))
(void))
;; Run multi-value tests:
(test-multi-generator [seq] gen))]