racket/doc/srfi-std/srfi-86.html
Matthew Flatt 28a3f3f0e7 r5rs and srfi docs and bindings
svn: r9336
2008-04-16 20:52:39 +00:00

1938 lines
69 KiB
HTML

<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html><head><title>SRFI 86: MU and NU simulating VALUES &amp; CALL-WITH-VALUES, and their related LET-syntax</title></head><body>
<h1>Title</h1>
MU and NU simulating VALUES &amp; CALL-WITH-VALUES, and their related LET-syntax
<h1>Author</h1>
Joo ChurlSoo
<h1>Status</h1>
This SRFI is currently in ``final'' status. To see an explanation of each
status that a SRFI can hold, see
<a href="http://srfi.schemers.org/srfi%20minus%20process.html">here</a>.
To
provide input on this SRFI, please <code>
<a href="mailto:srfi-86%20at%20srfi%20dot%20schemers%20dot%20org">mailto:srfi minus 86 at srfi dot schemers dot org</a></code>.
See <a href="http://srfi.schemers.org/srfi%20minus%20list-subscribe.html">instructions
here</a> to subscribe to the list. You can access the discussion via
<a href="http://srfi.schemers.org/srfi-86/mail-archive/maillist.html">the
archive of the mailing list</a>.
You can access
post-finalization messages via
<a href="http://srfi.schemers.org/srfi-86/post-mail-archive/maillist.html">
the archive of the mailing list</a>.
<p>
</p><ul>
<li>Received: <a href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-86/srfi-86.txt?rev=1.1">2006/04/03</a></li>
<li>Revised: <a href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-86/srfi-86.txt?rev=1.2">2006/05/08</a></li>
<li>Revised: <a href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-86/srfi-86.txt?rev=1.3">2006/05/22</a></li>
<li>Revised: <a href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-86/srfi-86.txt?rev=1.4">2006/06/20</a></li>
<li>Final: <a href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-86/srfi-86.html?rev=1.7">2006/06/20</a></li>
<li>Draft: 2006/04/04 - 2006/06/01</li>
</ul>
<h1>Abstract</h1>
<p>
Unlike the <code>values</code>/<code>call-with-values</code> mechanism of
R5RS, this SRFI uses an explicit representation for multiple return
values as a single value, namely a procedure. Decomposition of
multiple values is done by simple application. Each of the two
macros, <code>mu</code> and <code>nu</code>, evaluates to a procedure
that takes one procedure argument. The <code>mu</code> and
<code>nu</code> can be compared with <code>lambda</code>. While
<code>lambda</code> expression that consists of &lt;formals&gt; and &lt;body&gt;
requires some actual arguments later when the evaluated
<code>lambda</code> expression is called, <code>mu</code> and
<code>nu</code> expressions that consist of &lt;expression&gt;s
corresponding to actual arguments of <code>lambda</code> require
&lt;formals&gt; and &lt;body&gt;, that is, an evaluated <code>lambda</code>
expression, later when the evaluated <code>mu</code> and
<code>nu</code> expressions are called.
</p>
<p>
This SRFI also introduces new <code>let</code>-syntax depending on
<code>mu</code> and <code>nu</code> to manipulate multiple values,
<code>alet</code> and <code>alet*</code> that are compatible with
<code>let</code> and <code>let*</code> of R5RS in single value
bindings. They also have a binding form making use of
<code>values</code> and <code>call-with-values</code> to handle
multiple values. In addition, they have several new binding forms for
useful functions such as escape, recursion, etc.
</p>
<h1>Rationale</h1>
<p>
It is impossible to bind the evaluated result of <code>values</code>
expression to a single variable unlike other Scheme expressions.
Moreover, the pair of <code>values</code> and
<code>call-with-values</code> is clumsy to use and somewhat slow under
some circumstances. A solution would be to enclose the arguments of
<code>values</code> expression in a procedure of one argument, a
consumer procedure of <code>call-with-values</code>. The following are examples to
show the differences.
</p>
<pre>(define v (values 1 2 3)) =&gt; error
(define v (lambda () (values 1 2 3))) =&gt; (lambda () (values 1 2 3))
(define m (mu 1 2 3)) =&gt; (lambda (f) (f 1 2 3))
(define a (apply values 1 '(2 3))) =&gt; error
(define a
(lambda () (apply values 1 '(2 3)))) =&gt; (lambda () (apply values 1 '(2 3)))
(define n (nu 1 '(2 3))) =&gt; (lambda (f) (apply f 1 '(2 3)))
(call-with-values v list) =&gt; (1 2 3)
(m list) =&gt; (1 2 3)
(call-with-values a list) =&gt; (1 2 3)
(n list) =&gt; (1 2 3)
</pre>
<p>
The <code>alet</code> and <code>alet*</code> are cases in point to use
<code>mu</code> and <code>nu</code>. The differences between this
<code>let</code>-syntax and others, and some additional functions are
best explained by simple examples.
</p>
<ol>
<li>
<p>The following are rest argument forms of each SRFI.</p>
<p>In <a href="#SRFI11">SRFI 11</a>:</p>
<pre>(let-values ((a (values 1 2)) ((b c) (values 3 4)))
(list a b c))
=&gt; ((1 2) 3 4)
</pre>
<p>In <a href="#SRFI71">SRFI 71</a>:</p>
<pre>(srfi-let (((values . a) (values 1 2)) ((values b c) (values 3 4)))
(list a b c))
=&gt; ((1 2) 3 4)
</pre>
<p>In this SRFI:</p>
<pre>(alet (a (mu 1 2) ((b c) (mu 3 4)))
(list a b c))
=&gt; ((1 2) 3 4)
</pre>
</li>
<li><p>The expressions for <code>alet</code> bindings are evaluated in
sequence from left to right unlike <code>let</code> of R5RS and
<code>let</code> of <a href="#SRFI71">SRFI 71</a>.</p>
<p>In <a href="#SRFI71">SRFI 71</a>:</p>
<pre>(srfi-let ((a (begin (display "1st") 1))
(b c (values (begin (display "2nd") 2) 3))
(d (begin (display "3rd") 4))
((values e . f) (values (begin (display "4th") 5) 6)))
(list a b c d e f))
=&gt; 2nd4th1st3rd(1 2 3 4 5 (6))
</pre>
<p>In this SRFI:</p>
<pre>(alet ((a (begin (display "1st") 1))
(b c (mu (begin (display "2nd") 2) 3))
(d (begin (display "3rd") 4))
((e . f) (mu (begin (display "4th") 5) 6)))
(list a b c d e f))
=&gt; 1st2nd3rd4th(1 2 3 4 5 (6))
</pre>
</li>
<li><p>The bindings that require multiple values can take multiple expressions, if
syntactically possible, as well as a single expression that produce
multiple values.</p>
<pre>(alet* (((a b) (mu 1 2))
((c d e) a (+ a b c) (+ a b c d))
((f . g) (mu 5 6 7))
((h i j . k) e 9 10 h i j))
(list a b c d e f g h i j k))
=&gt; (1 2 1 4 8 5 (6 7) 8 9 10 (8 9 10))
</pre>
</li>
<li><p>The named-<code>alet</code> and named-<code>alet*</code> are
allowed to take multiple values bindings.</p>
<p>In <a href="#SRFI71">SRFI 71</a>:</p>
<pre>(srfi-let tag ((a 1) (b 2) (c 3) (d 4) (e 5))
(if (&lt; a 10) (tag 10 b c d e) (list a b c d e)))
=&gt; (10 2 3 4 5)
</pre>
<p>In this SRFI:</p>
<pre>(alet* tag ((a 1) (a b b c (mu (+ a 2) 4 5 6)) ((d e e) b 5 (+ a b c)))
(if (&lt; a 10) (tag a 10 b c c d e d) (list a b c d e)))
=&gt; (10 6 6 5 5)
</pre>
</li>
<li><p>They have a new binding form that has a recursive function like
named-<code>alet</code>. It is also allowed to take multiple values
bindings.</p>
<pre>(alet* ((a 1)
((b 2) (b c c (mu 3 4 5)) ((d e d (mu a b c)) . intag) . tag)
(f 6))
(if (&lt; d 10)
(intag d e 10)
(if (&lt; c 10)
(tag b 11 c 12 a b d intag)
(list a b c d e f))))
=&gt; (1 11 12 10 3 6)
</pre>
</li>
<li><p>They have a new binding form that has an escape function.</p>
<pre>(alet ((exit)
(a (begin (display "1st") 1))
(b c (mu (begin (display "2nd") 2) (begin (display "3rd") 3))))
(display (list a b c))
(exit 10)
(display "end"))
=&gt; 1st2nd3rd(1 2 3)10
</pre>
</li>
<li><p> The <code>and-let</code> and <code>and-let*</code> are
integrated into the <code>alet</code> and <code>alet*</code> with a
syntactic keyword <code>and</code>.</p>
<pre>(alet ((and (a (begin (display "1st") 1))
(b (begin (display "2nd") 2))
(c (begin (display "false") #f))
(d (begin (display "3nd") 3))))
(list a b c d))
=&gt; 1st2ndfalse#f
(alet ((and (a (begin (display "1st") 1))
(b (begin (display "2nd") 2) (&lt; b 2)) ; different from <a href="#SRFI2">SRFI 2</a>
(c (begin (display "false") #f))
(d (begin (display "3nd") 3))))
(list a b c d))
=&gt; 1st2nd#f
</pre>
</li>
<li><p>The <code>rest-values</code> of <a href="#SRFI51">SRFI 51</a> is integrated into the
<code>alet</code> and <code>alet*</code> with
syntactic keywords <code>opt</code> and <code>cat</code> in the
similar way to <code>let-optionals</code> in Scsh.</p>
<pre>((lambda (str . rest)
(alet* ((len (string-length str))
(opt rest
(start 0 (integer? start)
(if (&lt; start 0) 0 (if (&lt; len start) len start))) ;true
(end len (integer? end)
(if (&lt; end start) start (if (&lt; len end) len end)))));true
(substring str start end))) "abcdefg" 1 20)
=&gt; "bcdefg"
((lambda (str . rest)
(alet* ((len (string-length str))
(min (apply min rest))
(cat rest
(start 0 (= start min)
(if (&lt; start 0) 0 (if (&lt; len start) len start))) ;true
(end len (integer? end)
(if (&lt; end start) start (if (&lt; len end) len end)))));true
(substring str start end))) "abcdefg" 20 1)
=&gt; "bcdefg"
((lambda (str . rest)
(alet ((cat rest
(start 0
(and (list? start) (= 2 (length start))
(eq? 'start (car start)))
(cadr start)) ; true
(end (string-length str)
(and (list? end) (= 2 (length end)) (eq? 'end (car end)))
(cadr end)))) ; true
(substring str start end))) "abcdefg" '(end 6) '(start 1))
=&gt; "bcdef"
</pre>
</li>
<li><p>The <code>let-keywords</code> and <code>let-keywords*</code>
are integrated into the <code>alet</code> and
<code>alet*</code> with a syntactic keyword <code>key</code>.
They use any Scheme objects as keywords.
</p><pre>(define rest-list '(a 10 cc 30 40 b 20))
(alet ((key rest-list (a 1) (b 2) ((c 'cc) 3) . d)) (list a b c d))
=&gt; (10 2 30 (40 b 20))
(alet ((key rest-list (a 1) (b 2) ((c 'cc) 3) #f . d)) (list a b c d))
=&gt; (10 2 30 (40 b 20))
(alet ((key rest-list (a 1) (b 2) ((c 'cc) 3) #t . d)) (list a b c d))
=&gt; (10 20 30 (40))
(define rest (list 'a 10 'd 40 "c" 30 50 'b 20))
(alet ((key rest (a 1) (b 2) ((c "c") 3) . d)) (list a b c d))
=&gt; (10 2 30 (d 40 50 b 20))
(alet ((key rest (a 1) (b 2) ((c "c") 3) #f . d)) (list a b c d))
=&gt; (10 2 3 (d 40 "c" 30 50 b 20))
(alet ((key rest (a 1) (b 2) ((c "c") 3) #t . d)) (list a b c d))
=&gt; (10 20 30 (d 40 50))
((lambda (m . n)
(alet* ((opt n (a 10) (b 20) (c 30) . d)
(key d (x 100) (y 200) (a 300)))
(list m a b c x y)))
0 1 2 3 'a 30 'y 20 'x 10)
=&gt; (0 30 2 3 10 20)
((lambda (m . n)
(alet* ((key n (x 100) (y 200) (a 300) . d)
(opt d (a 10) (b 20) (c 30)))
(list m a b c x y)))
0 'a 30 'y 20 'x 10 1 2 3)
=&gt; (0 1 2 3 10 20)
</pre>
</li>
<li><p>The <code>letrec</code>and <code>letrec*</code> are integrated
into the <code>alet</code> and <code>alet*</code> with a
syntactic keyword <code>rec</code>.</p>
<pre>(alet* ((a 1)
(rec (a 2) (b 3) (b (lambda () c)) (c a))
(d 50))
(list a (b) c d))
=&gt; '(2 2 2 50)
</pre>
</li>
<li><p>They have a binding form that use <code>call-with-values</code>
and <code>values</code> to handle multiple values with a syntactic
keyword <code>values</code> like <a href="#SRFI71">SRFI 71</a>.</p>
<pre>(alet ((a b (mu 1 2))
(values c d (values 3 4)) ;This is different from <a href="#SRFI71">SRFI 71</a>.
((e f) (mu 5 6))
((values g h) (values 7 8))
((i j . k) (nu 9 '(10 11 12)))
((values l m . n) (apply values 13 '(14 15 16)))
o (mu 17 18)
((values . p) (values 19 20)))
(list a b c d e f g h i j k l m n o p))
=&gt; (1 2 3 4 5 6 7 8 9 10 (11 12) 13 14 (15 16) (17 18) (19 20))
</pre>
</li>
<li><p>They have a new binding form that works as an intervening external
environment in <code>alet</code> and as an intervening internal
environment in <code>alet*</code>.</p>
<pre>(alet ((a 1)
(() (define a 10) (define b 100))
(b a))
(list a b))
=&gt; (1 10)
(alet* ((a 1)
(() (define a 10) (define b 100))
(b a))
(list a b))
=&gt; (10 10)
</pre>
</li>
</ol>
<h1>Specification</h1>
<pre>(mu &lt;expr&gt; ...) =&gt; (lambda (f) (f &lt;expr&gt; ...))
(nu &lt;expr&gt; ... &lt;exprn&gt;) =&gt; (lambda (f) (apply f &lt;expr&gt; ... &lt;exprn&gt;))
</pre>
<p>The &lt;exprn&gt; should be a list.</p>
<p>
Each macro evaluates to a procedure of one argument. The environment
in effect when the macro expression was evaluated is remembered as
part of the procedure. When the procedure is later called with an
actual argument, a procedure, the environment in which the macro was
evaluated is extended by binding &lt;expr&gt;s to the corresponding
variables in the formal argument list of the argument procedure. The
argument procedure of <code>mu</code> is called with the &lt;expr&gt;s,
and that of <code>nu</code> is applied to APPLY procedure with the
&lt;expr&gt;s.</p>
<pre>(alet (&lt;binding spec&gt; ...) body ...)
(alet* (&lt;binding spec&gt; ...) body ...)
</pre>
<p>
<code>syntax-rules</code> identifier: <code>opt</code>
<code>cat</code> <code>key</code> <code>and</code>
<code>rec</code> <code>values</code>
</p>
<p>&lt;binding spec&gt;:</p>
<ol>
<li><pre>(&lt;var&gt; &lt;expr&gt;)</pre></li>
<li><pre>(&lt;var1&gt; &lt;var2&gt; &lt;var3&gt; ... &lt;expr&gt;)</pre></li>
<li><pre>((&lt;var&gt;) &lt;expr&gt;)</pre></li>
<li><pre>((&lt;var1&gt; &lt;var2&gt; &lt;var3&gt; ... ) &lt;expr&gt;)</pre></li>
<li><pre>((&lt;var1&gt; ... &lt;varm&gt; . &lt;varn&gt;) &lt;expr&gt;)</pre></li>
<li><pre>((&lt;var1&gt; &lt;var2&gt; &lt;var3&gt; ... ) &lt;expr1&gt; &lt;expr2&gt; &lt;expr3&gt; ...)</pre></li>
<li><pre>((&lt;var1&gt; ... &lt;varm&gt; . &lt;varn&gt;) &lt;expr1&gt; ... &lt;exprm&gt; &lt;exprn&gt; ...)</pre></li>
<li><pre>&lt;var&gt; &lt;expr&gt; </pre></li>
<li><pre>(&lt;var&gt;) </pre></li>
<li><pre>(&lt;binding spec1&gt; &lt;binding spec2&gt; ... . &lt;var&gt;)</pre></li>
<li><pre>(() . &lt;var&gt;)</pre></li>
<li><pre>(and (&lt;var1&gt; &lt;expr1&gt; [&lt;test1&gt;]) (&lt;var2&gt; &lt;expr2&gt; [&lt;test2&gt;]) ...)</pre></li>
<li><pre>(opt &lt;rest list&gt;
(&lt;var1&gt; &lt;default1&gt; [&lt;test1&gt; [&lt;true substitute1&gt; [&lt;false substitute1&gt;]]])
...
(&lt;varn&gt; &lt;defaultn&gt; [&lt;testn&gt; [&lt;true substituten&gt; [&lt;false substituten&gt;]]])
. [&lt;rest var&gt;])</pre></li>
<li><pre>(cat &lt;rest list&gt;
(&lt;var1&gt; &lt;default1&gt; [&lt;test1&gt; [&lt;true substitute1&gt; [&lt;false substitute1&gt;]]])
...
(&lt;varn&gt; &lt;defaultn&gt; [&lt;testn&gt; [&lt;true substituten&gt; [&lt;false substituten&gt;]]])
. [&lt;rest var&gt;])</pre></li>
<li><pre>(key &lt;rest list&gt;
(&lt;var spec1&gt; &lt;default1&gt; [&lt;test1&gt; [&lt;true substitute1&gt; [&lt;false substitute1&gt;]]])
...
(&lt;var specn&gt; &lt;defaultn&gt; [&lt;testn&gt; [&lt;true substituten&gt; [&lt;false substituten&gt;]]])
[&lt;option&gt;]
. [&lt;rest var&gt;])</pre></li>
<li><pre>(rec (&lt;var1&gt; &lt;expr1&gt;) (&lt;var2&gt; &lt;expr2&gt;) ...)</pre></li>
<li><pre>(values &lt;var1&gt; &lt;var2&gt; ... &lt;expr&gt;)</pre></li>
<li><pre>((values &lt;var1&gt; &lt;var2&gt; ...) &lt;expr&gt;)</pre></li>
<li><pre>((values &lt;var1&gt; ... . &lt;varn&gt;) &lt;expr&gt;) </pre></li>
<li><pre>((values &lt;var1&gt; &lt;var2&gt; &lt;var3&gt; ...) &lt;expr1&gt; &lt;expr2&gt; &lt;expr3&gt; ...)</pre></li>
<li><pre>((values &lt;var1&gt; ... . &lt;varn&gt;) &lt;expr1&gt; ... &lt;exprn&gt; ...) </pre></li>
<li><pre>(() &lt;expr1&gt; &lt;expr2&gt; ...)</pre></li>
</ol>
<p>
The <code>alet*</code> is to the <code>alet</code> what the
<code>let*</code> is to the <code>let</code>. However, the &lt;binding
spec&gt;s of <code>alet</code> are evaluated in sequence from left to
spec&gt;right unlike <code>let</code> of
R5RS. The <code>alet</code> and <code>alet*</code> make use of
<code>mu</code> or <code>nu</code> instead of <code>values</code> to
handle multiple values. So, the single &lt;expr&gt; of multiple values
binding should be a <code>mu</code> or <code>nu</code> expression, or
its equivalent. And the number of arguments of <code>mu</code> or the
number of `applied' arguments of <code>nu</code> must match the number
of values expected by the binding specification. Otherwise an error
is signaled, as <code>lambda</code> expression would.
</p>
<ol>
<li><pre>(&lt;var&gt; &lt;expr&gt;)</pre>
This is the same as <code>let</code> (R5RS, 4.2.2).
</li>
<li><pre>(&lt;var1&gt; &lt;var2&gt; &lt;var3&gt; ... &lt;expr&gt;)</pre>
This is the same as 4.</li>
<li><pre>((&lt;var&gt;) &lt;expr&gt;)</pre>
This is the same as 1.</li>
<li><pre>((&lt;var1&gt; &lt;var2&gt; &lt;var3&gt; ... ) &lt;expr&gt;)</pre></li>
<li><pre>((&lt;var1&gt; ... &lt;varm&gt; . &lt;varn&gt;) &lt;expr&gt;)</pre>
The &lt;expr&gt; must be a <code>mu</code> or <code>nu</code>
expression or its equivalent. The matching of &lt;var&gt;s to the
values of &lt;expr&gt; is as for the matching of &lt;formals&gt; to
arguments in a <code>lambda</code> expression (R5RS, 4.1.4).
</li>
<li><pre>((&lt;var1&gt; &lt;var2&gt; &lt;var3&gt; ... ) &lt;expr1&gt; &lt;expr2&gt; &lt;expr3&gt; ...)</pre>
This is the same as
<pre>(let[*] ((&lt;var1&gt; &lt;expr1&gt;) (&lt;var2&gt; &lt;expr2&gt;) (&lt;var3&gt; &lt;expr3&gt;) ...).</pre>
</li>
<li><pre>((&lt;var1&gt; ... &lt;varm&gt; . &lt;varn&gt;) &lt;expr1&gt; ... &lt;exprm&gt; &lt;exprn&gt; ...) </pre>
This is the same as
<pre>(let[*] ((&lt;var1&gt; &lt;expr1&gt;) ... (&lt;varm&gt; &lt;exprm&gt;) (&lt;varn&gt; (list &lt;exprn&gt; ...))).</pre>
</li>
<li><pre>&lt;var&gt; &lt;expr&gt;</pre>
The &lt;var&gt; is a rest argument, so the &lt;expr&gt; should be a form that can deliver
multiple values, that is, a <code>mu</code> or <code>nu</code> expression or its equivalent.
</li>
<li><pre>(&lt;var&gt;)</pre>
The &lt;var&gt; becomes an escape procedure that can take return
values of <code>alet</code>[*] as its arguments.
</li><li><pre>(&lt;binding spec1&gt; &lt;binding spec2&gt; ... . &lt;var&gt;)</pre>
The &lt;var&gt; becomes a recursive procedure that takes all &lt;vars&gt; of &lt;binding
spec&gt;s as arguments.
</li>
<li><pre>(() . &lt;var&gt;)</pre>
The &lt;var&gt; becomes a recursive thunk that takes no argument.
</li>
<li><pre>(and (&lt;var1&gt; &lt;expr1&gt; [&lt;test1&gt;]) (&lt;var2&gt; &lt;expr2&gt; [&lt;test2&gt;]) ...)</pre>
Each &lt;expr&gt; is evaluated sequentially and bound to the
corresponding &lt;var&gt;. During the process, if there is no
&lt;test&gt; and the value of &lt;expr&gt; is false, it stops and
returns <code>#f</code>. When there is a &lt;test&gt;, the process is continued
regardless of the value of &lt;expr&gt; unless the value of &lt;test&gt; is
false. If the value of &lt;test&gt; is false, it stops and returns #f.
</li>
<li>
<pre>(opt &lt;rest list&gt;
(&lt;var1&gt; &lt;default1&gt; [&lt;test1&gt; [&lt;true substitute1&gt; [&lt;false substitute1&gt;]]])
...
(&lt;varn&gt; &lt;defaultn&gt; [&lt;testn&gt; [&lt;true substituten&gt; [&lt;false substituten&gt;]]])
. [&lt;rest var&gt;])
</pre>
This binds each &lt;var&gt; to a corresponding element of &lt;rest list&gt;.
If there is no more element, then the corresponding &lt;default&gt; is
evaluated and bound to the &lt;var&gt;. An error is signaled when
there are more elements than &lt;var&gt;s. But if &lt;rest var&gt; is
given, it is bound to the remaining elements. If there is a
&lt;test&gt;, it is evaluated only when &lt;var&gt; is bound to an
element of &lt;rest list&gt;. If it returns a false value and there is no
&lt;false substitute&gt;, an error is signaled. If it returns a false value
and there is a &lt;false
substitute&gt;, &lt;var&gt; is rebound to the result of evaluating &lt;false substitute&gt;
instead of signaling an error. If it returns a true value and there is a
&lt;true substitute&gt;, &lt;var&gt; is rebound to the result of evaluating &lt;true
substitute&gt;.
</li>
<li><pre>(cat &lt;rest list&gt;
(&lt;var1&gt; &lt;default1&gt; [&lt;test1&gt; [&lt;true substitute1&gt; [&lt;false substitute1&gt;]]])
...
(&lt;varn&gt; &lt;defaultn&gt; [&lt;testn&gt; [&lt;true substituten&gt; [&lt;false substituten&gt;]]])
. [&lt;rest var&gt;])
</pre>
This is the same as the above <code>opt</code> except the binding
method. It temporarily binds &lt;var&gt; to each elements of &lt;rest
list&gt; sequentally, until &lt;test&gt; returns a true value, then
the &lt;var&gt; is finally bound to the passed element. If there is
no &lt;test&gt;, the first element of the remained &lt;rest list&gt;
is regarded as passing. If any element of the &lt;rest list&gt; does
not pass the &lt;test&gt;, the &lt;default&gt; is bound to the
&lt;var&gt; instead of signaling an error. If there is a &lt;false
substitute&gt; and &lt;test&gt; returns a false value, &lt;var&gt; is
finally bound to the result of evaluating &lt;false substitute&gt;
instead of the above process. If there is a &lt;true substitute&gt;
and &lt;test&gt; returns a true value, &lt;var&gt; is finally bound to
the result of evaluating &lt;true substitute&gt;.
</li>
<li><pre>(key &lt;rest list&gt;
(&lt;var spec1&gt; &lt;default1&gt; [&lt;test1&gt; [&lt;true substitute1&gt; [&lt;false substitute1&gt;]]])
...
(&lt;var specn&gt; &lt;defaultn&gt; [&lt;testn&gt; [&lt;true substituten&gt; [&lt;false substituten&gt;]]])
[&lt;option&gt;]
. [&lt;rest var&gt;])
&lt;var spec&gt; --&gt; &lt;var&gt; | (&lt;var&gt; &lt;keyword&gt;)
&lt;option&gt; --&gt; #f | #t
&lt;keyword&gt; --&gt; &lt;any scheme object&gt;
&lt;default&gt; --&gt; &lt;expression&gt;
&lt;test&gt; --&gt; &lt;expression&gt;
&lt;true substitute&gt; --&gt; &lt;expression&gt;
&lt;false substitute&gt; --&gt; &lt;expression&gt;
</pre>
This <code>key</code> form is the same as the <code>cat</code> form in view of the fact that both
don't use argument position for binding &lt;var&gt;s to elements of &lt;rest list&gt;.
However, for extracting values from &lt;rest list&gt;, the former uses explicitly
keywords and the latter uses implicitly &lt;test&gt;s. The keywords in this form
are not self-evaluating symbols (keyword objects) but any scheme objects. The
keyword used in &lt;rest list&gt; for the corresponding variable is a symbol of the
same name as the variable of the &lt;var spec&gt; composed of a single &lt;var&gt;. But
the keyword can be any scheme object when the &lt;var spec&gt; is specified as a
parenthesized variable and a keyword.
The elements of &lt;rest list&gt; are sequentially interpreted as a series of pairs,
where the first member of each pair is a keyword and the second is the
corresponding value. If there is no element for a particular keyword, the
&lt;var&gt; is bound to the result of evaluating &lt;default&gt;. When there is a &lt;test&gt;,
it is evaluated only when &lt;var&gt; is bound to an element of &lt;rest list&gt;. If it
returns a false value and there is no &lt;false substitute&gt;, an error is
signaled. If it returns a false value and there is a &lt;false substitute&gt;,
&lt;var&gt; is rebound to the result of evaluating &lt;false substitute&gt; instead of
signaling an error. If it returns a true value and there is a &lt;true
substitute&gt;, &lt;var&gt; is rebound to the result of evaluating &lt;true substitute&gt;.
When there are more elements than ones that are specified by &lt;var spec&gt;s, an
error is signaled. But if &lt;rest var&gt; is given, it is bound to the remaining
elements.
The following options can be used to control binding behavior when the keyword
of keyword-value pair at the bind processing site is different from any
keywords specified by &lt;var spec&gt;s.
<ol>
<li>default -- the remaining elements of &lt;rest list&gt; are continually
interpreted as a series of pairs.</li>
<li><code>#f</code> - the variable is bound to the corresponding &lt;default&gt;.</li>
<li><code>#t</code> - the remaining elements of &lt;rest list&gt; are
continually interpreted as a single element until the element is a
particular keyword.</li>
</ol>
</li>
<li><pre>(rec (&lt;var1&gt; &lt;expr1&gt;) (&lt;var2&gt;
&lt;expr2&gt;) ...)</pre>
This is the same as <pre>(letrec[*] ((&lt;var1&gt; &lt;expr1&gt;) (&lt;var2&gt; &lt;expr2&gt;) ...)</pre>
</li>
<li><pre>(values &lt;var1&gt; &lt;var2&gt; ... &lt;expr&gt;)</pre>
This is the same as 17.
</li>
<li><pre>((values &lt;var1&gt; &lt;var2&gt; ...) &lt;expr&gt;)</pre></li>
<li><pre>((values &lt;var1&gt; ... . &lt;varn&gt;) &lt;expr&gt;)</pre>
The &lt;expr&gt; should be a <code>values</code> expression or its
equivalent. The matching of &lt;var&gt;s to the values of
&lt;expr&gt; is as for the matching of &lt;formals&gt; to arguments in a
<code>lambda</code> expression.
</li>
<li><pre>((values &lt;var1&gt; &lt;var2&gt; &lt;var3&gt; ...) &lt;expr1&gt; &lt;expr2&gt; &lt;expr3&gt; ...)</pre>
This is the same as
<pre>(let[*] ((&lt;var1&gt; &lt;expr1&gt;) (&lt;var2&gt; &lt;expr2&gt;) (&lt;var3&gt; &lt;expr3&gt;) ...)</pre>
</li>
<li><pre> ((values &lt;var1&gt; ... . &lt;varn&gt;) &lt;expr1&gt; ... &lt;exprn&gt; ...) </pre>
This is the same as (let[*] ((&lt;var1&gt; &lt;expr1&gt;)
... (&lt;varn&gt; (list &lt;exprn&gt; ...))).
</li>
<li><pre>(() &lt;expr1&gt; &lt;expr2&gt; ...)</pre>
This works as an intervening external environment in
<code>alet</code>, and an intervening internal environment in
<code>alet*</code>.
</li>
</ol>
<pre>(alet name (&lt;binding spec&gt; ...) body ...)
(alet* name (&lt;binding spec&gt; ...) body ...)
</pre>
<p>
These are the same as the named-<code>let</code> (R5RS, 4.2.4) except
binding specification. These allow all sorts of bindings in &lt;binding
spec&gt;.</p>
<h1>Examples</h1>
<pre>(alet ((a (begin (display "1st") 1))
((b c) 2 (begin (display "2nd") 3))
(() (define m #f) (define n (list 8)))
((d (begin (display "3rd") 4))
(key '(e 5 tmp 6) (e 0) ((f 'tmp) 55)) . p)
g (nu (begin (display "4th") 7) n)
((values . h) (apply values 7 (begin (display "5th") n)))
((m 11) (n n) . q)
(rec (i (lambda () (- (j) 1)))
(j (lambda () 10)))
(and (k (begin (display "6th") m))
(l (begin (display "end") (newline) 12)))
(o))
(if (&lt; d 10)
(p 40 50 60)
(if (&lt; m 100)
(q 111 n)
(begin (display (list a b c d e f g h (i) (j) k l m n))
(newline))))
(o (list o p q))
(display "This is not displayed"))
=&gt; 1st2nd3rd4th5th6th#f
(alet* ((a (begin (display "1st") 1))
((b c) 2 (begin (display "2nd") 3))
(() (define m #f) (define n (list 8)))
((d (begin (display "3rd") 4))
(key '(e 5 tmp 6) (e 0) ((f 'tmp) 55)) . p)
g (nu (begin (display "4th") 7) n)
((values . h) (apply values 7 (begin (display "5th") n)))
((m 11) (n n) . q)
(rec (i (lambda () (- (j) 1)))
(j (lambda () 10)))
(and (k (begin (display "6th") m))
(l (begin (display "end") (newline) 12)))
(o))
(if (&lt; d 10)
(p 40 50 60)
(if (&lt; m 100)
(q 111 n)
(begin (display (list a b c d e f g h (i) (j) k l m n))
(newline))))
(o (list o p q))
(display "This is not displayed"))
=&gt; 1st2nd3rd4th5th6thend
4th5th6thend
6thend
(1 2 3 40 50 60 (7 8) (7 8) 9 10 111 12 111 (8))
(#&lt;continuation&gt; #&lt;procedure:p&gt; #&lt;procedure:q&gt;)
(define (arg-message head-message proc . message)
(display head-message) (newline)
(alet ((() . lp)
(() (for-each display message))
(arg (read)))
(if (proc arg) arg (lp))))
(define (substr str . rest)
(alet* ((len (string-length str))
(opt rest
(start 0
(and (integer? start) (&lt;= 0 start len))
start
(arg-message
"The first argument:"
(lambda (n) (and (integer? n) (&lt;= 0 n len)))
"Write number (" 0 " &lt;= number &lt;= " len "): "))
(end len
(and (integer? end) (&lt;= start end len))
end
(arg-message
"The second argument:"
(lambda (n) (and (integer? n) (&lt;= start n len)))
"Write number (" start " &lt;= number &lt;= " len "): "))))
(substring str start end)))
(substr "abcdefghi" 3)
=&gt; "defghi"
(substr "abcdefghi" 3 7)
=&gt; "defg"
(substr "abcdefghi" 20 7)
=&gt; The first argument:
Write number (0 &lt;= number &lt;= 9): 3
"defg"
(substr "abcdefghi" "a" 20)
=&gt; The first argument:
Write number (0 &lt;= number &lt;= 9): 2
The second argument:
Write number (2 &lt;= number &lt;= 9): 10
Write number (2 &lt;= number &lt;= 9): 9
"cdefghi"
</pre>
<h1>Implementation</h1>
<p>
The following implementation is written in R5RS hygienic macros and
requires SRFI 23 (Error reporting mechanism).
</p>
<pre>;;; mu &amp; nu
(define-syntax mu
(syntax-rules ()
((mu argument ...)
(lambda (f) (f argument ...)))))
(define-syntax nu
(syntax-rules ()
((nu argument ...)
(lambda (f) (apply f argument ...)))))
;;; alet
(define-syntax alet
(syntax-rules ()
((alet (bn ...) bd ...)
(%alet () () (bn ...) bd ...))
((alet var (bn ...) bd ...)
(%alet (var) () (bn ...) bd ...))))
(define-syntax %alet
(syntax-rules (opt cat key rec and values)
((%alet () ((n v) ...) () bd ...)
((lambda (n ...) bd ...) v ...))
((%alet (var) ((n v) ...) () bd ...)
((letrec ((var (lambda (n ...) bd ...)))
var) v ...))
((%alet (var (p ...) (nv ...) (bn ...)) ((n v) ...) () bd ...)
((letrec ((t (lambda (v ...)
(%alet (p ...) (nv ... (n v) ... (var t))
(bn ...) bd ...))))
t) v ...))
((%alet (p ...) (nv ...) ((() a b ...) bn ...) bd ...)
((lambda () a b ... (%alet (p ...) (nv ...) (bn ...) bd ...))))
((%alet (p ...) (nv ...) (((a) c) bn ...) bd ...)
((lambda (t) (%alet (p ...) (nv ... (a t)) (bn ...) bd ...)) c))
((%alet (p ...) (nv ...) (((values a) c) bn ...) bd ...)
((lambda (t) (%alet (p ...) (nv ... (a t)) (bn ...) bd ...)) c))
((%alet (p ...) (nv ...) (((values . b) c d ...) bn ...) bd ...)
(%alet "dot" (p ...) (nv ...) (values) (b c d ...) (bn ...) bd ...))
((%alet "dot" (p ...) (nv ...) (values t ...) ((a . b) c ...)
(bn ...) bd ...)
(%alet "dot" (p ...) (nv ... (a tn)) (values t ... tn) (b c ...)
(bn ...) bd ...))
((%alet "dot" (p ...) (nv ...) (values t ...) (() c) (bn ...) bd ...)
(call-with-values (lambda () c)
(lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))
((%alet "dot" (p ...) (nv ...) (values t ...) (() c ...) (bn ...) bd ...)
((lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...)) c ...))
((%alet "dot" (p ...) (nv ...) (values t ...) (b c) (bn ...) bd ...)
(call-with-values (lambda () c)
(lambda (t ... . tn)
(%alet (p ...) (nv ... (b tn)) (bn ...) bd ...))))
((%alet "dot" (p ...) (nv ...) (values t ...) (b c ...) (bn ...) bd ...)
((lambda (t ... . tn)
(%alet (p ...) (nv ... (b tn)) (bn ...) bd ...)) c ...))
((%alet (p ...) (nv ...) (((a . b) c d ...) bn ...) bd ...)
(%alet "dot" (p ...) (nv ... (a t)) (t) (b c d ...) (bn ...) bd ...))
((%alet "dot" (p ...) (nv ...) (t ...) ((a . b) c ...) (bn ...) bd ...)
(%alet "dot" (p ...) (nv ... (a tn)) (t ... tn) (b c ...) (bn ...)
bd ...))
((%alet "dot" (p ...) (nv ...) (t ...) (() c) (bn ...) bd ...)
(c (lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))
((%alet "dot" (p ...) (nv ...) (t ...) (() c ...) (bn ...) bd ...)
((lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...)) c ...))
((%alet "dot" (p ...) (nv ...) (t ...) (b c) (bn ...) bd ...)
(c (lambda (t ... . tn) (%alet (p ...) (nv ... (b tn)) (bn ...) bd ...))))
((%alet "dot" (p ...) (nv ...) (t ...) (b c ...) (bn ...) bd ...)
((lambda (t ... . tn)
(%alet (p ...) (nv ... (b tn)) (bn ...) bd ...)) c ...))
((%alet (p ...) (nv ...) ((and (n1 v1 t1 ...) (n2 v2 t2 ...) ...) bn ...)
bd ...)
(%alet "and" (p ...) (nv ...) ((n1 v1 t1 ...) (n2 v2 t2 ...) ...) (bn ...)
bd ...))
((%alet "and" (p ...) (nv ...) ((n v) nvt ...) (bn ...) bd ...)
(let ((t v))
(and t (%alet "and" (p ...) (nv ... (n t)) (nvt ...) (bn ...) bd ...))))
((%alet "and" (p ...) (nv ...) ((n v t) nvt ...) (bn ...) bd ...)
(let ((tt v))
(and (let ((n tt)) t)
(%alet "and" (p ...) (nv ... (n tt)) (nvt ...) (bn ...) bd ...))))
((%alet "and" (p ...) (nv ...) () (bn ...) bd ...)
(%alet (p ...) (nv ...) (bn ...) bd ...))
((%alet (p ...) (nv ...) ((opt z a . e) bn ...) bd ...)
(%alet "opt" (p ...) (nv ...) z (a . e) (bn ...) bd ...))
((%alet "opt" (p ...) (nv ...) z ((n d t ...)) (bn ...) bd ...)
(let ((x (if (null? z)
d
(if (null? (cdr z))
(wow-opt n (car z) t ...)
(error "alet: too many arguments" (cdr z))))))
(%alet (p ...) (nv ... (n x)) (bn ...) bd ...)))
((%alet "opt" (p ...) (nv ...) z ((n d t ...) . e) (bn ...) bd ...)
(let ((y (if (null? z) z (cdr z)))
(x (if (null? z)
d
(wow-opt n (car z) t ...))))
(%alet "opt" (p ...) (nv ... (n x)) y e (bn ...) bd ...)))
((%alet "opt" (p ...) (nv ...) z e (bn ...) bd ...)
(let ((te z))
(%alet (p ...) (nv ... (e te)) (bn ...) bd ...)))
((%alet (p ...) (nv ...) ((cat z a . e) bn ...) bd ...)
(let ((y z))
(%alet "cat" (p ...) (nv ...) y (a . e) (bn ...) bd ...)))
((%alet "cat" (p ...) (nv ...) z ((n d t ...)) (bn ...) bd ...)
(let ((x (if (null? z)
d
(if (null? (cdr z))
(wow-cat-end z n t ...)
(error "alet: too many arguments" (cdr z))))))
(%alet (p ...) (nv ... (n x)) (bn ...) bd ...)))
((%alet "cat" (p ...) (nv ...) z ((n d t ...) . e) (bn ...) bd ...)
(let ((x (if (null? z)
d
(wow-cat! z n d t ...))))
(%alet "cat" (p ...) (nv ... (n x)) z e (bn ...) bd ...)))
((%alet "cat" (p ...) (nv ...) z e (bn ...) bd ...)
(let ((te z))
(%alet (p ...) (nv ... (e te)) (bn ...) bd ...)))
((%alet (p ...) (nv ...) ((key z a . e) bn ...) bd ...)
(let ((y z))
(%alet "key" (p ...) (nv ...) y () () (a . e) () (bn ...) bd ...)))
((%alet "key" (p ...) (nv ...) z ()
(ndt ...) (((n k) d t ...) . e) (kk ...) (bn ...) bd ...)
(%alet "key" (p ...) (nv ...) z ()
(ndt ... ((n k) d t ...)) e (kk ... k) (bn ...) bd ...))
((%alet "key" (p ...) (nv ...) z ()
(ndt ...) ((n d t ...) . e) (kk ...) (bn ...) bd ...)
(%alet "key" (p ...) (nv ...) z ()
(ndt ... ((n 'n) d t ...)) e (kk ... 'n) (bn ...) bd ...))
((%alet "key" (p ...) (nv ...) z ()
(ndt nd ...) (#t . e) (kk k ...) (bn ...) bd ...)
(%alet "key" (p ...) (nv ...) z (#t)
(ndt nd ...) e (kk k ...) (bn ...) bd ...))
((%alet "key" (p ...) (nv ...) z ()
(ndt nd ...) (#f . e) (kk k ...) (bn ...) bd ...)
(%alet "key" (p ...) (nv ...) z (#f)
(ndt nd ...) e (kk k ...) (bn ...) bd ...))
((%alet "key" (p ...) (nv ...) z (o ...)
(((n k) d t ...) ndt ...) e (kk ...) (bn ...) bd ...)
(let ((x (if (null? z)
d
(wow-key! z (o ...) (kk ...) (n k) d t ...))))
(%alet "key" (p ...) (nv ... (n x)) z (o ...)
(ndt ...) e (kk ...) (bn ...) bd ...)))
((%alet "key" (p ...) (nv ...) z (o ...) () () (kk ...) (bn ...) bd ...)
(if (null? z)
(%alet (p ...) (nv ...) (bn ...) bd ...)
(error "alet: too many arguments" z)))
((%alet "key" (p ...) (nv ...) z (o ...) () e (kk ...) (bn ...) bd ...)
(let ((te z)) (%alet (p ...) (nv ... (e te)) (bn ...) bd ...)))
((%alet (p ...) (nv ...) ((rec (n v) (nn vv) ...) bn ...) bd ...)
(%alet "rec" (p ...) (nv ... (n t)) ((n v t))
((nn vv) ...) (bn ...) bd ...))
((%alet "rec" (p ...) (nv ...) (nvt ...) ((n v) (nn vv) ...)
(bn ...) bd ...)
(%alet "rec" (p ...) (nv ... (n t)) (nvt ... (n v t)) ((nn vv) ...)
(bn ...) bd ...))
((%alet "rec" (p ...) (nv ...) ((n v t) ...) () (bn ...) bd ...)
((let ((n '&lt;undefined&gt;) ...)
(let ((t v) ...)
(set! n t) ...
(mu n ...)))
(lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))
((%alet (p ...) (nv ...) ((a b) bn ...) bd ...)
((lambda (t) (%alet (p ...) (nv ... (a t)) (bn ...) bd ...)) b))
((%alet (p ...) (nv ...) ((values a c) bn ...) bd ...)
((lambda (t) (%alet (p ...) (nv ... (a t)) (bn ...) bd ...)) c))
((%alet (p ...) (nv ...) ((values a b c ...) bn ...) bd ...)
(%alet "not" (p ...) (nv ... (a t)) (values t) (b c ...) (bn ...) bd ...))
((%alet "not" (p ...) (nv ...) (values t ...) (a b c ...) (bn ...) bd ...)
(%alet "not" (p ...) (nv ... (a tn)) (values t ... tn) (b c ...)
(bn ...) bd ...))
((%alet "not" (p ...) (nv ...) (values t ...) (z) (bn ...) bd ...)
(call-with-values (lambda () z)
(lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))
((%alet (p ...) (nv ...) ((a b c ...) bn ...) bd ...)
(%alet "not" (p ...) (nv ... (a t)) (t) (b c ...) (bn ...) bd ...))
((%alet "not" (p ...) (nv ...) (t ...) (a b c ...) (bn ...) bd ...)
(%alet "not" (p ...) (nv ... (a tn)) (t ... tn) (b c ...) (bn ...)
bd ...))
((%alet "not" (p ...) (nv ...) (t ...) (z) (bn ...) bd ...)
(z (lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))
((%alet (p ...) (nv ...) ((a) bn ...) bd ...)
(call-with-current-continuation
(lambda (t) (%alet (p ...) (nv ... (a t)) (bn ...) bd ...))))
((%alet (p ...) (nv ...) ((a . b) bn ...) bd ...)
(%alet "rot" (p ...) (nv ...) (a) b (bn ...) bd ...))
((%alet "rot" (p ...) (nv ...) (new-bn ...) (a . b) (bn ...) bd ...)
(%alet "rot" (p ...) (nv ...) (new-bn ... a) b (bn ...) bd ...))
((%alet "rot" (p ...) (nv ...) (()) b (bn ...) bd ...)
(%alet (b (p ...) (nv ...) (bn ...)) () () bd ...))
((%alet "rot" (p ...) (nv ...) (new-bn ...) b (bn ...) bd ...)
(%alet (b (p ...) (nv ...) (bn ...)) () (new-bn ...) bd ...))
((%alet (p ...) (nv ...) (a b bn ...) bd ...)
(b (lambda t (%alet (p ...) (nv ... (a t)) (bn ...) bd ...))))))
;;; alet*
(define-syntax alet*
(syntax-rules (opt cat key rec and values)
((alet* () bd ...)
((lambda () bd ...)))
((alet* ((() a b ...) bn ...) bd ...)
((lambda () a b ... (alet* (bn ...) bd ...))))
((alet* (((a) c) bn ...) bd ...)
((lambda (a) (alet* (bn ...) bd ...)) c))
((alet* (((values a) c) bn ...) bd ...)
((lambda (a) (alet* (bn ...) bd ...)) c))
((alet* (((values . b) c) bn ...) bd ...)
(call-with-values (lambda () c)
(lambda* b (alet* (bn ...) bd ...))))
((alet* (((values . b) c d ...) bn ...) bd ...)
(alet* "dot" (b c d ...) (bn ...) bd ...))
((alet* "dot" ((a . b) c d ...) (bn ...) bd ...)
((lambda (a) (alet* "dot" (b d ...) (bn ...) bd ...)) c))
((alet* "dot" (()) (bn ...) bd ...)
(alet* (bn ...) bd ...))
((alet* "dot" (b c ...) (bn ...) bd ...)
((lambda b (alet* (bn ...) bd ...)) c ...))
((alet* (((a . b) c) bn ...) bd ...)
(c (lambda* (a . b) (alet* (bn ...) bd ...))))
((alet* (((a . b) c d ...) bn ...) bd ...)
((lambda (a) (alet* "dot" (b d ...) (bn ...) bd ...)) c))
((alet* ((and (n1 v1 t1 ...) (n2 v2 t2 ...) ...) bn ...) bd ...)
(alet-and* ((n1 v1 t1 ...) (n2 v2 t2 ...) ...) (alet* (bn ...) bd ...)))
((alet* ((opt z a . e) bn ...) bd ...)
(%alet-opt* z (a . e) (alet* (bn ...) bd ...)))
((alet* ((cat z a . e) bn ...) bd ...)
(let ((y z))
(%alet-cat* y (a . e) (alet* (bn ...) bd ...))))
((alet* ((key z a . e) bn ...) bd ...)
(let ((y z))
(%alet-key* y () () (a . e) () (alet* (bn ...) bd ...))))
((alet* ((rec (n1 v1) (n2 v2) ...) bn ...) bd ...)
(alet-rec* ((n1 v1) (n2 v2) ...) (alet* (bn ...) bd ...)))
((alet* ((a b) bn ...) bd ...)
((lambda (a) (alet* (bn ...) bd ...)) b))
((alet* ((values a c) bn ...) bd ...)
((lambda (a) (alet* (bn ...) bd ...)) c))
((alet* ((values a b c ...) bn ...) bd ...)
(alet* "not" (values a) (b c ...) (bn ...) bd ...))
((alet* "not" (values r ...) (a b c ...) (bn ...) bd ...)
(alet* "not" (values r ... a) (b c ...) (bn ...) bd ...))
((alet* "not" (values r ...) (z) (bn ...) bd ...)
(call-with-values (lambda () z)
(lambda* (r ...) (alet* (bn ...) bd ...))))
((alet* ((a b c ...) bn ...) bd ...)
(alet* "not" (a) (b c ...) (bn ...) bd ...))
((alet* "not" (r ...) (a b c ...) (bn ...) bd ...)
(alet* "not" (r ... a) (b c ...) (bn ...) bd ...))
((alet* "not" (r ...) (z) (bn ...) bd ...)
(z (lambda* (r ...) (alet* (bn ...) bd ...))))
((alet* ((a) bn ...) bd ...)
(call-with-current-continuation (lambda (a) (alet* (bn ...) bd ...))))
((alet* ((a . b) bn ...) bd ...)
(%alet* () () ((a . b) bn ...) bd ...))
((alet* (a b bn ...) bd ...)
(b (lambda a (alet* (bn ...) bd ...))))
((alet* var (bn ...) bd ...)
(%alet* (var) () (bn ...) bd ...))))
(define-syntax %alet*
(syntax-rules (opt cat key rec and values)
((%alet* (var) (n ...) () bd ...)
((letrec ((var (lambda* (n ...) bd ...)))
var) n ...))
((%alet* (var (bn ...)) (n ...) () bd ...)
((letrec ((var (lambda* (n ...) (alet* (bn ...) bd ...))))
var) n ...))
((%alet* (var (p ...) (nn ...) (bn ...)) (n ...) () bd ...)
((letrec ((var (lambda* (n ...)
(%alet* (p ...) (nn ... n ... var) (bn ...)
bd ...))))
var) n ...))
((%alet* (p ...) (n ...) ((() a b ...) bn ...) bd ...)
((lambda () a b ... (%alet* (p ...) (n ...) (bn ...) bd ...))))
((%alet* (p ...) (n ...) (((a) c) bn ...) bd ...)
((lambda (a) (%alet* (p ...) (n ... a) (bn ...) bd ...)) c))
((%alet* (p ...) (n ...) (((values a) c) bn ...) bd ...)
((lambda (a) (%alet* (p ...) (n ... a) (bn ...) bd ...)) c))
((%alet* (p ...) (n ...) (((values . b) c) bn ...) bd ...)
(%alet* "one" (p ...) (n ...) (values) (b c) (bn ...) bd ...))
((%alet* "one" (p ...) (n ...) (values r ...) ((a . b) c) (bn ...) bd ...)
(%alet* "one" (p ...) (n ... a) (values r ... a) (b c) (bn ...) bd ...))
((%alet* "one" (p ...) (n ...) (values r ...) (() c) (bn ...) bd ...)
(call-with-values (lambda () c)
(lambda* (r ...) (%alet* (p ...) (n ...) (bn ...) bd ...))))
((%alet* "one" (p ...) (n ...) (values r ...) (b c) (bn ...) bd ...)
(call-with-values (lambda () c)
(lambda* (r ... . b) (%alet* (p ...) (n ... b) (bn ...) bd ...))))
((%alet* (p ...) (n ...) (((values . b) c d ...) bn ...) bd ...)
(%alet* "dot" (p ...) (n ...) (b c d ...) (bn ...) bd ...))
((%alet* (p ...) (n ...) (((a . b) c) bn ...) bd ...)
(%alet* "one" (p ...) (n ... a) (a) (b c) (bn ...) bd ...))
((%alet* "one" (p ...) (n ...) (r ...) ((a . b) c) (bn ...) bd ...)
(%alet* "one" (p ...) (n ... a) (r ... a) (b c) (bn ...) bd ...))
((%alet* "one" (p ...) (n ...) (r ...) (() c) (bn ...) bd ...)
(c (lambda* (r ...) (%alet* (p ...) (n ...) (bn ...) bd ...))))
((%alet* "one" (p ...) (n ...) (r ...) (b c) (bn ...) bd ...)
(c (lambda* (r ... . b) (%alet* (p ...) (n ... b) (bn ...) bd ...))))
((%alet* (p ...) (n ...) (((a . b) c d ...) bn ...) bd ...)
((lambda (a)
(%alet* "dot" (p ...) (n ... a) (b d ...) (bn ...) bd ...)) c))
((%alet* "dot" (p ...) (n ...) ((a . b) c d ...) (bn ...) bd ...)
((lambda (a)
(%alet* "dot" (p ...) (n ... a) (b d ...) (bn ...) bd ...)) c))
((%alet* "dot" (p ...) (n ...) (()) (bn ...) bd ...)
(%alet* (p ...) (n ...) (bn ...) bd ...))
((%alet* "dot" (p ...) (n ...) (b c ...) (bn ...) bd ...)
((lambda b (%alet* (p ...) (n ... b) (bn ...) bd ...)) c ...))
((%alet* (p ...) (n ...) ((and (n1 v1 t1 ...) (n2 v2 t2 ...) ...) bn ...)
bd ...)
(alet-and* ((n1 v1 t1 ...) (n2 v2 t2 ...) ...)
(%alet* (p ...) (n ... n1 n2 ...) (bn ...) bd ...)))
((%alet* (p ...) (n ...) ((opt z a . e) bn ...) bd ...)
(%alet* "opt" (p ...) (n ...) z (a . e) (bn ...) bd ...))
((%alet* "opt" (p ...) (nn ...) z ((n d t ...)) (bn ...) bd ...)
(let ((n (if (null? z)
d
(if (null? (cdr z))
(wow-opt n (car z) t ...)
(error "alet*: too many arguments" (cdr z))))))
(%alet* (p ...) (nn ... n) (bn ...) bd ...)))
((%alet* "opt" (p ...) (nn ...) z ((n d t ...) . e) (bn ...) bd ...)
(let ((y (if (null? z) z (cdr z)))
(n (if (null? z)
d
(wow-opt n (car z) t ...))))
(%alet* "opt" (p ...) (nn ... n) y e (bn ...) bd ...)))
((%alet* "opt" (p ...) (nn ...) z e (bn ...) bd ...)
(let ((e z))
(%alet* (p ...) (nn ... e) (bn ...) bd ...)))
((%alet* (p ...) (nn ...) ((cat z a . e) bn ...) bd ...)
(let ((y z))
(%alet* "cat" (p ...) (nn ...) y (a . e) (bn ...) bd ...)))
((%alet* "cat" (p ...) (nn ...) z ((n d t ...)) (bn ...) bd ...)
(let ((n (if (null? z)
d
(if (null? (cdr z))
(wow-cat-end z n t ...)
(error "alet*: too many arguments" (cdr z))))))
(%alet* (p ...) (nn ... n) (bn ...) bd ...)))
((%alet* "cat" (p ...) (nn ...) z ((n d t ...) . e) (bn ...) bd ...)
(let ((n (if (null? z)
d
(wow-cat! z n d t ...))))
(%alet* "cat" (p ...) (nn ... n) z e (bn ...) bd ...)))
((%alet* "cat" (p ...) (nn ...) z e (bn ...) bd ...)
(let ((e z))
(%alet* (p ...) (nn ... e) (bn ...) bd ...)))
((%alet* (p ...) (m ...) ((key z a . e) bn ...) bd ...)
(let ((y z))
(%alet* "key" (p ...) (m ...) y () () (a . e) () (bn ...) bd ...)))
((%alet* "key" (p ...) (m ...) z ()
(ndt ...) (((n k) d t ...) . e) (kk ...) (bn ...) bd ...)
(%alet* "key" (p ...) (m ...) z ()
(ndt ... ((n k) d t ...)) e (kk ... k) (bn ...) bd ...))
((%alet* "key" (p ...) (m ...) z ()
(ndt ...) ((n d t ...) . e) (kk ...) (bn ...) bd ...)
(%alet* "key" (p ...) (m ...) z ()
(ndt ... ((n 'n) d t ...)) e (kk ... 'n) (bn ...) bd ...))
((%alet* "key" (p ...) (m ...) z ()
(ndt nd ...) (#t . e) (kk k ...) (bn ...) bd ...)
(%alet* "key" (p ...) (m ...) z (#t)
(ndt nd ...) e (kk k ...) (bn ...) bd ...))
((%alet* "key" (p ...) (m ...) z ()
(ndt nd ...) (#f . e) (kk k ...) (bn ...) bd ...)
(%alet* "key" (p ...) (m ...) z (#f)
(ndt nd ...) e (kk k ...) (bn ...) bd ...))
((%alet* "key" (p ...) (m ...) z (o ...)
(((n k) d t ...) ndt ...) e (kk ...) (bn ...) bd ...)
(let ((n (if (null? z)
d
(wow-key! z (o ...) (kk ...) (n k) d t ...))))
(%alet* "key" (p ...) (m ... n) z (o ...)
(ndt ...) e (kk ...) (bn ...) bd ...)))
((%alet* "key" (p ...) (m ...) z (o ...) () () (kk ...) (bn ...) bd ...)
(if (null? z)
(%alet* (p ...) (m ...) (bn ...) bd ...)
(error "alet*: too many arguments" z)))
((%alet* "key" (p ...) (m ...) z (o ...) () e (kk ...) (bn ...) bd ...)
(let ((e z)) (%alet* (p ...) (m ... e) (bn ...) bd ...)))
((%alet* (p ...) (n ...) ((rec (n1 v1) (n2 v2) ...) bn ...) bd ...)
(alet-rec* ((n1 v1) (n2 v2) ...)
(%alet* (p ...) (n ... n1 n2 ...) (bn ...) bd ...)))
((%alet* (p ...) (n ...) ((a b) bn ...) bd ...)
((lambda (a) (%alet* (p ...) (n ... a) (bn ...) bd ...)) b))
((%alet* (p ...) (n ...) ((values a c) bn ...) bd ...)
((lambda (a) (%alet* (p ...) (n ... a) (bn ...) bd ...)) c))
((%alet* (p ...) (n ...) ((values a b c ...) bn ...) bd ...)
(%alet* "not" (p ...) (n ... a) (values a) (b c ...) (bn ...) bd ...))
((%alet* "not" (p ...) (n ...) (values r ...) (a b c ...) (bn ...) bd ...)
(%alet* "not" (p ...) (n ... a) (values r ... a) (b c ...) (bn ...)
bd ...))
((%alet* "not" (p ...) (n ...) (values r ...) (z) (bn ...) bd ...)
(call-with-values (lambda () z)
(lambda* (r ...) (%alet* (p ...) (n ...) (bn ...) bd ...))))
((%alet* (p ...) (n ...) ((a b c ...) bn ...) bd ...)
(%alet* "not" (p ...) (n ... a) (a) (b c ...) (bn ...) bd ...))
((%alet* "not" (p ...) (n ...) (r ...) (a b c ...) (bn ...) bd ...)
(%alet* "not" (p ...) (n ... a) (r ... a) (b c ...) (bn ...) bd ...))
((%alet* "not" (p ...) (n ...) (r ...) (z) (bn ...) bd ...)
(z (lambda* (r ...) (%alet* (p ...) (n ...) (bn ...) bd ...))))
((%alet* (p ...) (n ...) ((a) bn ...) bd ...)
(call-with-current-continuation
(lambda (a) (%alet* (p ...) (n ... a) (bn ...) bd ...))))
((%alet* (p ...) (n ...) ((a . b) bn ...) bd ...)
(%alet* "rot" (p ...) (n ...) (a) b (bn ...) bd ...))
((%alet* "rot" (p ...) (n ...) (new-bn ...) (a . b) (bn ...) bd ...)
(%alet* "rot" (p ...) (n ...) (new-bn ... a) b (bn ...) bd ...))
((%alet* "rot" () () (()) b (bn ...) bd ...)
(%alet* (b (bn ...)) () () bd ...))
((%alet* "rot" (p ...) (n ...) (()) b (bn ...) bd ...)
(%alet* (b (p ...) (n ...) (bn ...)) () () bd ...))
((%alet* "rot" () () (new-bn ...) b (bn ...) bd ...)
(%alet* (b (bn ...)) () (new-bn ...) bd ...))
((%alet* "rot" (p ...) (n ...) (new-bn ...) b (bn ...) bd ...)
(%alet* (b (p ...) (n ...) (bn ...)) () (new-bn ...) bd ...))
((%alet* (p ...) (n ...) (a b bn ...) bd ...)
(b (lambda a (%alet* (p ...) (n ... a) (bn ...) bd ...))))))
;;; auxiliaries
(define-syntax lambda*
(syntax-rules ()
((lambda* (a . e) bd ...)
(lambda* "star" (ta) (a) e bd ...))
((lambda* "star" (t ...) (n ...) (a . e) bd ...)
(lambda* "star" (t ... ta) (n ... a) e bd ...))
((lambda* "star" (t ...) (n ...) () bd ...)
(lambda (t ...)
(let* ((n t) ...) bd ...)))
((lambda* "star" (t ...) (n ...) e bd ...)
(lambda (t ... . te)
(let* ((n t) ... (e te)) bd ...)))
((lambda* e bd ...)
(lambda e bd ...))))
(define-syntax alet-and
(syntax-rules ()
((alet-and ((n v t ...) ...) bd ...)
(alet-and "and" () ((n v t ...) ...) bd ...))
((alet-and "and" (nt ...) ((n v) nvt ...) bd ...)
(let ((t v))
(and t (alet-and "and" (nt ... (n t)) (nvt ...) bd ...))))
((alet-and "and" (nt ...) ((n v t) nvt ...) bd ...)
(let ((tt v))
(and (let ((n tt)) t)
(alet-and "and" (nt ... (n tt)) (nvt ...) bd ...))))
((alet-and "and" ((n t) ...) () bd ...)
((lambda (n ...) bd ...) t ...))))
(define-syntax alet-and*
(syntax-rules ()
((alet-and* () bd ...)
((lambda () bd ...)))
((alet-and* ((n v) nvt ...) bd ...)
(let ((n v))
(and n (alet-and* (nvt ...) bd ...))))
((alet-and* ((n v t) nvt ...) bd ...)
(let ((n v))
(and t (alet-and* (nvt ...) bd ...))))))
(define-syntax alet-rec
(syntax-rules ()
((alet-rec ((n v) ...) bd ...)
(alet-rec "rec" () ((n v) ...) bd ...))
((alet-rec "rec" (nvt ...) ((n v) nv ...) bd ...)
(alet-rec "rec" (nvt ... (n v t)) (nv ...) bd ...))
((alet-rec "rec" ((n v t) ...) () bd ...)
(let ((n '&lt;undefined&gt;) ...)
(let ((t v) ...)
(set! n t) ...
;;(let ()
;; bd ...))))))
bd ...)))))
(define-syntax alet-rec*
(syntax-rules ()
((alet-rec* ((n v) ...) bd ...)
(let* ((n '&lt;undefined&gt;) ...)
(set! n v) ...
;;(let ()
;; bd ...)))))
bd ...))))
(define-syntax wow-opt
(syntax-rules ()
((wow-opt n v)
v)
((wow-opt n v t)
(let ((n v))
(if t n (error "alet[*]: bad argument" n 'n 't))))
((wow-opt n v t ts)
(let ((n v))
(if t ts (error "alet[*]: bad argument" n 'n 't))))
((wow-opt n v t ts fs)
(let ((n v))
(if t ts fs)))))
(define-syntax wow-opt!
(syntax-rules ()
((wow-opt! z n)
(let ((n (car z)))
(set! z (cdr z))
n))
((wow-opt! z n t)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) n)
(error "alet[*]: bad argument" n 'n 't))))
((wow-opt! z n t ts)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) ts)
(error "alet[*]: bad argument" n 'n 't))))
((wow-opt! z n t ts fs)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) ts)
(begin (set! z (cdr z)) fs))))))
(define-syntax wow-cat-end
(syntax-rules ()
((wow-cat-end z n)
(car z))
((wow-cat-end z n t)
(let ((n (car z)))
(if t n (error "alet[*]: too many argument" z))))
((wow-cat-end z n t ts)
(let ((n (car z)))
(if t ts (error "alet[*]: too many argument" z))))
((wow-cat-end z n t ts fs)
(let ((n (car z)))
(if t ts fs)))))
(define-syntax wow-cat
(syntax-rules ()
((wow-cat z n d)
z)
((wow-cat z n d t)
(let ((n (car z)))
(if t
z
(let lp ((head (list n)) (tail (cdr z)))
(if (null? tail)
(cons d z)
(let ((n (car tail)))
(if t
(cons n (append (reverse head) (cdr tail)))
(lp (cons n head) (cdr tail)))))))))
((wow-cat z n d t ts)
(let ((n (car z)))
(if t
(cons ts (cdr z))
(let lp ((head (list n)) (tail (cdr z)))
(if (null? tail)
(cons d z)
(let ((n (car tail)))
(if t
(cons ts (append (reverse head) (cdr tail)))
(lp (cons n head) (cdr tail)))))))))
((wow-cat z n d t ts fs)
(let ((n (car z)))
(if t
(cons ts (cdr z))
(cons fs (cdr z)))))))
(define-syntax wow-cat!
(syntax-rules ()
((wow-cat! z n d)
(let ((n (car z)))
(set! z (cdr z))
n))
((wow-cat! z n d t)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) n)
(let lp ((head (list n)) (tail (cdr z)))
(if (null? tail)
d
(let ((n (car tail)))
(if t
(begin (set! z (append (reverse head) (cdr tail))) n)
(lp (cons n head) (cdr tail)))))))))
((wow-cat! z n d t ts)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) ts)
(let lp ((head (list n)) (tail (cdr z)))
(if (null? tail)
d
(let ((n (car tail)))
(if t
(begin (set! z (append (reverse head) (cdr tail))) ts)
(lp (cons n head) (cdr tail)))))))))
((wow-cat! z n d t ts fs)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) ts)
(begin (set! z (cdr z)) fs))))))
(define-syntax wow-key!
(syntax-rules ()
((wow-key! z () (kk ...) (n key) d)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(begin (set! z (cdr y)) (car y))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(begin (set! z (append (reverse head) (cdr y)))
(car y))
(lp (cons (car y) (cons x head))
(cdr y)))))))))))
((wow-key! z (#f) (kk ...) (n key) d)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(begin (set! z (cdr y)) (car y))
(let ((lk (list kk ...)))
(if (not (member x lk))
d
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(begin (set! z (append (reverse head)
(cdr y)))
(car y))
(if (not (member x lk))
d
(lp (cons (car y) (cons x head))
(cdr y))))))))))))))
((wow-key! z (#t) (kk ...) (n key) d)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(begin (set! z (cdr y)) (car y))
(let* ((lk (list kk ...))
(m (member x lk)))
(let lp ((head (if m (list (car y) x) (list x)))
(tail (if m (cdr y) y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(begin (set! z (append (reverse head)
(cdr y)))
(car y))
(let ((m (member x lk)))
(lp (if m
(cons (car y) (cons x head))
(cons x head))
(if m (cdr y) y)))))))))))))
((wow-key! z () (kk ...) (n key) d t)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) n)
(error "alet[*]: bad argument" n 'n 't)))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
n)
(error "alet[*]: bad argument"
n 'n 't)))
(lp (cons (car y) (cons x head))
(cdr y)))))))))))
((wow-key! z (#f) (kk ...) (n key) d t)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) n)
(error "alet[*]: bad argument" n 'n 't)))
(let ((lk (list kk ...)))
(if (not (member x lk))
d
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin
(set! z (append (reverse head)
(cdr y)))
n)
(error "alet[*]: bad argument"
n 'n 't)))
(if (not (member x lk))
d
(lp (cons (car y) (cons x head))
(cdr y))))))))))))))
((wow-key! z (#t) (kk ...) (n key) d t)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) n)
(error "alet[*]: bad argument" n 'n 't)))
(let* ((lk (list kk ...))
(m (member x lk)))
(let lp ((head (if m (list (car y) x) (list x)))
(tail (if m (cdr y) y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
n)
(error "alet[*]: bad argument"
n 'n 't)))
(let ((m (member x lk)))
(lp (if m
(cons (car y) (cons x head))
(cons x head))
(if m (cdr y) y)))))))))))))
((wow-key! z () (kk ...) (n key) d t ts)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) ts)
(error "alet[*]: bad argument" n 'n 't)))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
ts)
(error "alet[*]: bad argument"
n 'n 't)))
(lp (cons (car y) (cons x head))
(cdr y)))))))))))
((wow-key! z (#f) (kk ...) (n key) d t ts)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) ts)
(error "alet[*]: bad argument" n 'n 't)))
(let ((lk (list kk ...)))
(if (not (member x lk))
d
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin
(set! z (append (reverse head)
(cdr y)))
ts)
(error "alet[*]: bad argument"
n 'n 't)))
(if (not (member x lk))
d
(lp (cons (car y) (cons x head))
(cdr y))))))))))))))
((wow-key! z (#t) (kk ...) (n key) d t ts)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) ts)
(error "alet[*]: bad argument" n 'n 't)))
(let* ((lk (list kk ...))
(m (member x lk)))
(let lp ((head (if m (list (car y) x) (list x)))
(tail (if m (cdr y) y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
ts)
(error "alet[*]: bad argument"
n 'n 't)))
(let ((m (member x lk)))
(lp (if m
(cons (car y) (cons x head))
(cons x head))
(if m (cdr y) y)))))))))))))
((wow-key! z () (kk ...) (n key) d t ts fs)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) ts)
(begin (set! z (cdr y)) fs)))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
ts)
(begin (set! z (append (reverse head)
(cdr y)))
fs)))
(lp (cons (car y) (cons x head))
(cdr y)))))))))))
((wow-key! z (#f) (kk ...) (n key) d t ts fs)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) ts)
(begin (set! z (cdr y)) fs)))
(let ((lk (list kk ...)))
(if (not (member x lk))
d
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin
(set! z (append (reverse head)
(cdr y)))
ts)
(begin
(set! z (append (reverse head)
(cdr y)))
fs)))
(if (not (member x lk))
d
(lp (cons (car y) (cons x head))
(cdr y))))))))))))))
((wow-key! z (#t) (kk ...) (n key) d t ts fs)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) ts)
(begin (set! z (cdr y)) fs)))
(let* ((lk (list kk ...))
(m (member x lk)))
(let lp ((head (if m (list (car y) x) (list x)))
(tail (if m (cdr y) y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (equal? key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
ts)
(begin (set! z (append (reverse head)
(cdr y)))
fs)))
(let ((m (member x lk)))
(lp (if m
(cons (car y) (cons x head))
(cons x head))
(if m (cdr y) y)))))))))))))))
(define-syntax alet-opt*
(syntax-rules ()
((alet-opt* z (a . e) bd ...)
(let ((y z))
(%alet-opt* y (a . e) bd ...)))))
(define-syntax %alet-opt*
(syntax-rules ()
((%alet-opt* z ((n d t ...)) bd ...)
(let ((n (if (null? z)
d
(if (null? (cdr z))
(wow-opt n (car z) t ...)
(error "alet*: too many arguments" (cdr z))))))
bd ...))
((%alet-opt* z ((n d t ...) . e) bd ...)
(let ((y (if (null? z) z (cdr z)))
(n (if (null? z)
d
(wow-opt n (car z) t ...))))
(%alet-opt* y e bd ...)))
((%alet-opt* z e bd ...)
(let ((e z)) bd ...))))
;; (define-syntax %alet-opt*
;; (syntax-rules ()
;; ((%alet-opt* z ((n d t ...)) bd ...)
;; (let ((n (if (null? z)
;; d
;; (if (null? (cdr z))
;; (wow-opt n (car z) t ...)
;; (error "alet*: too many arguments" (cdr z))))))
;; bd ...))
;; ((%alet-opt* z ((n d t ...) . e) bd ...)
;; (let ((n (if (null? z)
;; d
;; (wow-opt! z n t ...))))
;; (%alet-opt* z e bd ...)))
;; ((%alet-opt* z e bd ...)
;; (let ((e z)) bd ...))))
;; (define-syntax %alet-opt*
;; (syntax-rules ()
;; ((%alet-opt* z (ndt ...) (a . e) bd ...)
;; (%alet-opt* z (ndt ... a) e bd ...))
;; ((%alet-opt* z ((n d t ...) (nn dd tt ...) ...) () bd ...)
;; (if (null? z)
;; (let* ((n d) (nn dd) ...) bd ...)
;; (let ((y (cdr z))
;; (n (wow-opt n (car z) t ...)))
;; (%alet-opt* y ((nn dd tt ...) ...) () bd ...))))
;; ((%alet-opt* z () () bd ...)
;; (if (null? z)
;; (let () bd ...)
;; (error "alet*: too many arguments" z)))
;; ((%alet-opt* z ((n d t ...) (nn dd tt ...) ...) e bd ...)
;; (if (null? z)
;; (let* ((n d) (nn dd) ... (e z)) bd ...)
;; (let ((y (cdr z))
;; (n (wow-opt n (car z) t ...)))
;; (%alet-opt* y ((nn dd tt ...) ...) e bd ...))))
;; ((%alet-opt* z () e bd ...)
;; (let ((e z)) bd ...))))
(define-syntax alet-cat*
(syntax-rules ()
((alet-cat* z (a . e) bd ...)
(let ((y z))
(%alet-cat* y (a . e) bd ...)))))
;; (define-syntax %alet-cat*
;; (syntax-rules ()
;; ((%alet-cat* z ((n d t ...)) bd ...)
;; (let ((n (if (null? z)
;; d
;; (if (null? (cdr z))
;; (wow-cat-end z n t ...)
;; (error "alet*: too many arguments" (cdr z))))))
;; bd ...))
;; ((%alet-cat* z ((n d t ...) . e) bd ...)
;; (let* ((w (if (null? z)
;; (cons d z)
;; (wow-cat z n d t ...)))
;; (n (car w))
;; (y (cdr w)))
;; (%alet-cat* y e bd ...)))
;; ((%alet-cat* z e bd ...)
;; (let ((e z)) bd ...))))
(define-syntax %alet-cat*
(syntax-rules ()
((%alet-cat* z ((n d t ...)) bd ...)
(let ((n (if (null? z)
d
(if (null? (cdr z))
(wow-cat-end z n t ...)
(error "alet*: too many arguments" (cdr z))))))
bd ...))
((%alet-cat* z ((n d t ...) . e) bd ...)
(let ((n (if (null? z)
d
(wow-cat! z n d t ...))))
(%alet-cat* z e bd ...)))
((%alet-cat* z e bd ...)
(let ((e z)) bd ...))))
;; (define-syntax %alet-cat*
;; (syntax-rules ()
;; ((%alet-cat* z (ndt ...) (a . e) bd ...)
;; (%alet-cat* z (ndt ... a) e bd ...))
;; ((%alet-cat* z ((n d t ...) (nn dd tt ...) ...) () bd ...)
;; (if (null? z)
;; (let* ((n d) (nn dd) ...) bd ...)
;; (let* ((w (wow-cat z n d t ...))
;; (n (car w))
;; (y (cdr w)))
;; (%alet-cat* y ((nn dd tt ...) ...) () bd ...))))
;; ((%alet-cat* z () () bd ...)
;; (if (null? z)
;; (let () bd ...)
;; (error "alet*: too many arguments" z)))
;; ((%alet-cat* z ((n d t ...) (nn dd tt ...) ...) e bd ...)
;; (if (null? z)
;; (let* ((n d) (nn dd) ... (e z)) bd ...)
;; (let* ((w (wow-cat z n d t ...))
;; (n (car w))
;; (y (cdr w)))
;; (%alet-cat* y ((nn dd tt ...) ...) e bd ...))))
;; ((%alet-cat* z () e bd ...)
;; (let ((e z)) bd ...))))
(define-syntax alet-key*
(syntax-rules ()
((alet-key* z (a . e) bd ...)
(let ((y z))
(%alet-key* y () () (a . e) () bd ...)))))
(define-syntax %alet-key*
(syntax-rules ()
((%alet-key* z () (ndt ...) (((n k) d t ...) . e) (kk ...) bd ...)
(%alet-key* z () (ndt ... ((n k) d t ...)) e (kk ... k) bd ...))
((%alet-key* z () (ndt ...) ((n d t ...) . e) (kk ...) bd ...)
(%alet-key* z () (ndt ... ((n 'n) d t ...)) e (kk ... 'n) bd ...))
((%alet-key* z () (ndt nd ...) (#f . e) (kk k ...) bd ...)
(%alet-key* z (#f) (ndt nd ...) e (kk k ...) bd ...))
((%alet-key* z () (ndt nd ...) (#t . e) (kk k ...) bd ...)
(%alet-key* z (#t) (ndt nd ...) e (kk k ...) bd ...))
((%alet-key* z (o ...) (((n k) d t ...) ndt ...) e (kk ...) bd ...)
(let ((n (if (null? z)
d
(wow-key! z (o ...) (kk ...) (n k) d t ...))))
(%alet-key* z (o ...) (ndt ...) e (kk ...) bd ...)))
((%alet-key* z (o ...) () () (kk ...) bd ...)
(if (null? z)
(let () bd ...)
(error "alet*: too many arguments" z)))
((%alet-key* z (o ...) () e (kk ...) bd ...)
(let ((e z)) bd ...))))
</pre>
<h1>References</h1>
<ul>
<li><a name="R5RS">[R5RS]</a> Richard Kelsey, William Clinger, and Jonathan Rees: Revised(5)
Report on the Algorithmic Language Scheme
<a href="http://www.schemers.org/Documents/Standards/R5Rs/">Link</a></li>
<li><a name="SRFI2">[SRFI 2]</a> Oleg Kiselyov: <code>and-let*</code>: and <code>and</code> with local bindings, a guarded
<code>let*</code> special form.
<a href="http://srfi.schemers.org/srfi-2/">Link</a></li>
<li><a name="SRFI11">[SRFI 11]</a> Lars T. Hansen: Syntax for receiving multiple values.
<a href="http://srfi.schemers.org/srfi-11/">Link</a></li>
<li><a name="SRFI51">[SRFI 51]</a> Joo ChurlSoo: Handling rest list.
<a href="http://srfi.schemers.org/srfi-51/">Link</a></li>
<li><a name="SRFI71">[SRFI 71]</a> Sebastian Egner: Extended <code>let</code>-syntax for multiple values.
<a href="http://srfi.schemers.org/srfi-71/">Link</a></li>
<li><a name="Scsh">[Scsh]</a> Olin Shivers, Brian Carlstrom, Martin Gasbichler, Mike Sperber
<a href="http://www.scsh.net/">Link</a></li>
</ul>
<h1>Copyright</h1>
Copyright (c) 2006 Joo ChurlSoo.
<p>
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:
</p><p>
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
</p><p>
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.
</p><hr>
<address>Editor: <a href="mailto:srfi%20minus%20editors%20at%20srfi%20dot%20schemers%20dot%20org">Mike
Sperber</a></address>
</body></html>