Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

MU and NU substituting for CALL-WITH-VALUES and VALUES

2 views
Skip to first unread message

soo

unread,
Aug 27, 2005, 12:49:39 AM8/27/05
to

MU and NU substituting for VALUES and CALL-WITH-VALUES, and their related
LET-syntax

This article introduces syntactic forms, MU and NU that evaluate to procedures
of one argument, a procedure. While LAMBDA expression that consists of
<formals> and <body> requires some actual arguments later when the evaluated
LAMBDA expression is called, MU and NU expressions that consist of
<expression>s corresponding to actual arguments of LAMBDA require <formals>
and <body>, that is, evaluated LAMBDA expression, later when the evaluated MU
and NU expressions are called. The evaluated LAMBDA expression, an argument
procedure, is called with the <expression>s of MU expression in case of MU,
and applied with the <expression>s of NU to APPLY procedure in case of NU.
The constructs of MU and NU correspond to VALUES, and their evaluated
procedures correspond to CALL-WITH-VALUES. The following are those contructs
in comparison with CALL-WITH-VALUES and VALUES.

(call-with-values (lambda () (values <expression> ...))
(lambda <formals> body)
is equal to
((mu <expression> ...) (lambda <formals> body)).

(call-with-values (lambda () (apply values <expression1> <expression2> ...))
(lambda <formals> body)
is equal to
((nu <expression1> <expression2> ...) (lambda <formals> body)).

This article also introduces new LET-syntax depending on MU and NU to
manipulate multiple values, ALET and ALET* that are not only simple and rapid
in multiple binding forms but also compatible with LET and LET* of R5RS in
single binding form. In addition, they have a few new binding forms for
useful functions in programming such as escape, recursion, etc.


It is impossible to bind the evaluated result of VALUES expression to a
variable unlike other Scheme expressions. Moreover, the pair of VALUES and
CALL-WITH-VALUES is slow ,especially when a list-form argument is applied to
VALUES. Lastly, CALL-WITH-VALUES is clumsy to use. A solution would be to
enclose the arguments of VALUES expression in a procedure of one argument, a
consumer procedure of CALL-WITH-VALUS. The following are simple examples to
show the differences.

(define a (values 1 2 3)) => error
(define a (mu 1 2 3))
(define b (apply values 1 '(2 3))) => error
(define b (nu 1 '(2 3)))
(a +) => 6
((mu 1 2 3) +) => 6
(call-with-values (lambda () (values 1 2 3)) +) => 6
(b +) => 6
((nu 1 '(2 3)) +) => 6
(call-with-values (lambda () (apply values 1 '(2 3))) +) => 6

In fact, ALET and ALET* are examples to use MU and NU. However, they are not
only simple and rapid in multiple binding forms but also compatible with LET
and LET* of R5RS in single binding form. The differeces between this
LET-syntax and others, and the additional functions are best explained by
simple examples.

1. The followings are rest argument forms of each SRFI.

In SRFI-11:
(let-values ((a (values 1 2))
((b c) (values 3 4))) (list a b c))
=> ((1 2) 3 4)

In SRFI-71:
(srfi-let (((values . a) (values 1 2))
((values b c) (values 3 4))) (list a b c))
=> ((1 2) 3 4)

In this:
(alet (a (mu 1 2)
((b c) (mu 3 4))) (list a b c))
=> ((1 2) 3 4)

2. The expressions for ALET bindings are evaluated in sequence from left to
right unlike LET of R5RS and LET of SRFI-71.

In SRFI-71:
(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))
=> 2nd4th1st3rd(1 2 3 4 5 (6))

In this:
(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))
=> 1st2nd3rd4th(1 2 3 4 5 (6))

3. The binding forms that require multiple values can take multiple
expressions, if syntactically possible, as well as single expression that
produces multiple values.

(alet (((a b) (mu 1 2))
((c d) 3 4)
((e . f) (mu 5 6 7))
((g . h) 7 8 9)
((i j . k) (nu 9 '(10 11 12))))
(list a b c d e f g h i j k))
=> (1 2 3 4 5 (6 7) 7 (8 9) 9 10 (11 12))

4. The named-ALET and named-ALET* are allowed to take all binding forms
including multiple values binding forms.

In SRFI-71:
(srfi-let tag ((a 1) (b 2) (c 3) (d 4) (e 5))
(if (< a 10) (tag 10 b c d e) (list a b c d e)))
=> (10 2 3 4 5)

In this:
(alet* tag ((a 1) (b c (mu a 4)) ((d e) b 5))
(if (< a 10) (tag 10 b c d e) (list a b c d e)))
=> (10 1 4 1 5)

5. They have a new binding form that has a recursive function like named-ALET.
All binding forms and nested recursions are also allowed.

(alet ((a 11)
((b 1) (c d (mu 2 3)) ((e f (mu 4 5)) . intag) . tag)
(g 22))
(if (< e 10)
(intag 1000 f)
(if (< c 10)
(tag b 100 d e f intag)
(list a b c d e f g))))
=> (11 1 100 3 1000 5 22)

6. They have a new binding form that has an escape function.

(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"))
=> 1st2nd3rd(1 2 3)10

7. The AND-LET and AND-LET* are integrated into the ALET and ALET* with a
syntactic keyword `and'. This is not allowed to receive multiple values.

(alet ((and (a (begin (display "1st") 1))
(b #f)
(c (begin (display "2nd") 2)))
d (mu 4 5))
(list a b c d))
=> 1st#f

8. The REST-VALUES of SRFI-51 is integrated into the ALET and ALET* with
syntactic keywords `opt' and `cat' as LET-OPTIONALS in Scsh.

(define z '(1 2))
(alet ((opt z (a 10) (b 20 (number? b) (< b 10)) (c 30) d)
(cat z (e 40 (number? e)) (f 50 (> f 10)) (g 60 (number? g)))
h (mu 70 80))
(list a b c d e f g h))
=> (1 2 30 () 1 50 2 (70 80))

9. The FLUID-LET and FLUID-LET* for dynamic scoping are integrated into the
ALET and ALET* with a syntactic keyward `dyn'.

(define a 1) (define b 2) (define c 3)
(define (current-ab-c) (list 'current-ab-c ': a b c))
(define (dynamic-ab-c) (alet ((dyn (a 10) (b 20)) (c 30)) (current-ab-c)))
(define (lexical-ab-c) (alet ((a 10) (b 20) (c 30)) (current-ab-c)))
(current-ab-c)
=> (current-ab-c : 1 2 3)
(dynamic-ab-c)
=> (current-ab-c : 10 20 3)
(lexical-ab-c)
=> (current-ab-c : 1 2 3)

10. They have a new binding form that works as an external environment in ALET
and as an intervening environment in ALET*.

(alet ((a 1)
(() (define a 10) (define b 100))
(b a))
(list a b))
=> (1 10)

(alet* ((a 1)
(() (define a 10) (define b 100))
(b a))
(list a b))
=> (10 10)

(mu <expr> ...) => (lambda (f) (f <expr> ...))
(nu <expr> <expr1> ...) => (lambda (f) (apply f <expr> <expr1> ...))

Each macro evaluates to a procedure of one argument, a procedure. The
environment in effect when the macro expression was evaluated is remembered as
part of the procedure. When the procedure is later called with a actual
argument, a procedure, the environment in which the macro was evaluated is
extended by binding <expr>s to the corresponding variables in the formal
argument list of the argument procedure. The argument procedure of MU is
called with the <expr>s, and that of NU is applied to APPLY procedure with the
<expr>s.

(alet (<binding spec> ...) body ...)
(alet* (<binding spec> ...) body ...)
syntactic keywords: opt cat and dyn
<binding spec>: 1. (<var> <expr>)
2. (<var1> <var2> <var3> ... <expr>)
3. ((<var>) <expr>)
4. ((<var1> <var2> <var3> ... ) <expr>)
5. ((<var1> <var2> ... . <varn>) <expr>)
6. ((<var1> <var2> <var3> ... ) <expr1> <expr2> <expr3> ...)
7. ((<var1> <var2> ... . <varn>) <expr1> <expr2> ...)
8. <var> <expr>
9. (<var>)
10. (<binding spec1> <binding spec2> ... . <var>)
11. (() . <var>)
12. (and (<var1> <expr1>) (<var2> <expr2> ...)
13. (opt <rest-list> (<var1> <default-expr1> <test1> ...)
(<var2> <default-expr2> <test2> ...)
... [<rest-var>])
14. (cat <rest-list> (<var1> <default-expr1> <test1> ...)
(<var2> <default-expr2> <test2> ...)
... [<rest-var>])
15. (dyn (<var1> <expr1>) (<var2> <expr2>) ...)
16. (() <expr1> <expr2> ...)

The ALET* is to the ALET what the LET* is to the LET. However, the
expressions for ALET bindings are evaluated in sequence from left to right
unlike LET of R5RS.
The ALET and ALET* make use of MU or NU instead of VALUES to handle multiple
values. So, the single <expr> of multiple binding forms should be a MU or NU
expression or its equivalent. And the number of arguments of MU or the number
of `applied' arguments of NU must match the number of values expected by the
binding specification. Otherwise an error is signaled, as LAMBDA expression
would.

1. (<var> <expr>)
This is the same as LET (R5RS, 4.2.2).

2. (<var1> <var2> <var3> ... <expr>)
This is the same as 4.

3. ((<var>) <expr>)
This is the same as 1.

4. ((<var1> <var2> <var3> ... ) <expr>)
5. ((<var1> <var2> ... . <varn>) <expr>)
The <expr> must be a MU or NU expression or its equivalent. The matching of
<var>s to the arguments of MU or the `applied' arguments of NU is as for the
matching of <formals> to arguments in a LAMBDA expression (R5RS, 4.1.4).

6. ((<var1> <var2> <var3> ... ) <expr1> <expr2> <expr3> ...)
7. ((<var1> <var2> ... . <varn>) <expr1> <expr2> ...)
These are the same as 4 and 5 respectively except multiple expressions, that
is, the matching of <var>s to <expr>s is as for the matching of <formals> to
arguments in a LAMBDA expression (R5RS, 4.1.4).

8. <var> <expr>
The <var> is a rest argument, so the <expr> should be a form that can deliver
multiple values, that is, MU or NU or its equivalent.

9. (<var>)
The <var> becomes an escape procedure that can take return value(s) as its
arguments.

10. (<binding spec1> <binding spec2> ... . <var>)
The <var> becomes a recursive procedure that takes all <vars> of <binding
spec>s as arguments.

11. (() . <var>)
The <var> becomes a recursive thunk that takes no argument.

12. (and (<var1> <expr1>) (<var2> <expr2> ...)
This is the same as (and-let ((<var1> <expr1>) (<var2> <expr2>) ...) of SRFI-2.

13. (opt <rest-list> (<var1> <default-expr1> <test1> ...)
(<var2> <default-expr2> <test2> ...)
... [<rest-var>])
This binds each <var> to a corresponding element of <rest-list>. If there is
no more element, then the corresponding <default-expr> is evaluated and bound
to the <var>. An error is signaled when there are more elements than <var>s.
But if <rest-var> is given, it is bound to the remaining elements. If there
are <test>s, they are evaluated only when <var> is bound to an element of
<rest-list>. If any of them returns a false value, an error is signaled.

14. (cat <rest-list> (<var1> <default-expr1> <test1> ...)
(<var2> <default-expr2> <test2> ...)
... [<rest-var>])
This is the same as the above `opt' spec except the binding method. It
temporarily binds <var> to each elements of <rest-list> sequentally, until all
<test>s return true values, then the <var> is finally bound to the passed
element. If there is no <test>, the first element of the remained <rest-list>
is regarded as passing. If any element of the <rest-list> does not pass the
<test>, the <default> is bound to the <var> instead of signaling an error.

15. (dyn (<var1> <expr1>) (<var2> <expr2>) ...)
This is the same as (fluid-let ((<var1> <expr1>) (<var2> <expr2>) ...) of
SRFI-15.

16. (() <expr1> <expr2> ...)
This works as an external environment in ALET, and an intervening environment
in ALET*.

(alet name (<binding spec> ...) body ...)
(alet* name (<binding spec> ...) body ...)
These are the same as the named-LET (R5RS, 4.2.4) except binding
specification. These allow all sorts of bindings in <binding spec>.


The following implementation is written in R5RS hygienic macros and requires
SRFI-23 (Error reporting mechanism).

;;; new syntax
(define-syntax mu
(syntax-rules ()
((mu argument ...)
(lambda (f) (f argument ...)))))

(define-syntax nu
(syntax-rules ()
((nu argument arguments ...)
(lambda (f) (apply f argument arguments ...)))))

;;; alet
(define-syntax alet
(syntax-rules ()
((alet (bn ...) bd ...)
(%alet% () () (bn ...) bd ...))
((alet tag (bn ...) bd ...)
(%alet% (tag) () (bn ...) bd ...))))

(define-syntax %alet%
(syntax-rules (opt cat and dyn)
((%alet% () ((n v) ...) () bd ...)
((lambda (n ...) bd ...) v ...))
((%alet% (((n0 t0 o0) ...)) ((n v) ...) () bd ...)
(dynamic-wind
(lambda () (set! n0 t0) ...)
(lambda () ((lambda (n ...) bd ...) v ...))
(lambda () (set! n0 o0) ...)))
((%alet% (tag) ((n v) ...) () bd ...)
((letrec ((tag (lambda (n ...) bd ...)))
tag)
v ...))
((%alet% (var (p0 ...) ((n0 v0) ...) (bn ...) ((n1 t1 o1) ...) ...)
((n v) ...) () bd ...)
((letrec ((tmp (lambda (v ...)
(%alet% (p0 ...) ((n0 v0) ... (n v) ... (var tmp))
(bn ...) bd ...))))
tmp) v ...))
((%alet% (p ...) ((n v) ...) ((() a b ...) bn ...) bd ...)
((lambda () a b ... (%alet% (p ...) ((n v) ...) (bn ...) bd ...))))
((%alet% (p ...) ((n v) ...) (((a) c) bn ...) bd ...)
((lambda (t) (%alet% (p ...) ((n v) ... (a t)) (bn ...) bd ...)) c))
((%alet% (p ...) ((n v) ...) (((a . b) c ...) bn ...) bd ...)
(%alet% "dot" (p ...) ((n v) ... (a t)) (t) ((b) c ...) (bn ...) bd ...))
((%alet% "dot" (p ...) ((n v) ...) (t ...) (((a . b)) c ...) (bn ...)
bd ...)
(%alet% "dot" (p ...) ((n v) ... (a tn)) (t ... tn) ((b) c ...) (bn ...)
bd ...))
((%alet% "dot" (p ...) ((n v) ...) (t ...) ((()) c) (bn ...) bd ...)
(c (lambda (t ...) (%alet% (p ...) ((n v) ...) (bn ...) bd ...))))
((%alet% "dot" (p ...) ((n v) ...) (t ...) ((()) c ...) (bn ...) bd ...)
((lambda (t ...) (%alet% (p ...) ((n v) ...) (bn ...) bd ...)) c ...))
((%alet% "dot" (p ...) ((n v) ...) (t ...) ((b) c) (bn ...) bd ...)
(c (lambda (t ... . tn)
(%alet% (p ...) ((n v) ... (b tn)) (bn ...) bd ...))))
((%alet% "dot" (p ...) ((n v) ...) (t ...) ((b) c ...) (bn ...) bd ...)
((lambda (t ... . tn)
(%alet% (p ...) ((n v) ... (b tn)) (bn ...) bd ...)) c ...))

((%alet% (p ...) ((n v) ...) ((and (n1 v1)) bn ...) bd ...)
((lambda (t)
(and t (%alet% (p ...) ((n v) ... (n1 t)) (bn ...) bd ...))) v1))
((%alet% (p ...) ((n v) ...) ((and (n1 v1) (n2 v2) ...) bn ...) bd ...)
((lambda (t)
(and t (%alet% (p ...) ((n v) ... (n1 t)) ((and (n2 v2) ...) bn ...)
bd ...))) v1))
((%alet% (p ...) ((n v) ...) ((opt rest c1 c2 ...) bn ...) bd ...)
(%alet-opt% ((p ...) ((n v) ...) (bn ...)) () rest (c1 c2 ...) bd ...))
((%alet% (p ...) ((n v) ...) ((cat rest c1 c2 ...) bn ...) bd ...)
(%alet-cat% ((p ...) ((n v) ...) (bn ...)) () rest (c1 c2 ...) bd ...))
((%alet% (p ...) ((n v) ...) ((dyn (n1 v1) (n2 v2) ...) bn ...) bd ...)
((lambda (o1 t1)
(%alet% "dyn" (p ...) ((n v) ... (n1 t1))
((n1 t1 o1)) ((n2 v2) ...) (bn ...) bd ...))
n1 v1))
((%alet% "dyn" (p ...) ((n v) ...)
((n0 t0 o0) ...) ((n1 v1) (n2 v2) ...) (bn ...) bd ...)
((lambda (o1 t1)
(%alet% "dyn" (p ...) ((n v) ... (n1 t1))
((n0 t0 o0) ... (n1 t1 o1)) ((n2 v2) ...) (bn ...) bd ...))
n1 v1))
((%alet% "dyn" (p ...) ((n v) ...) ((n0 t0 o0) ...) () (bn ...) bd ...)
(%alet% (p ... ((n0 t0 o0) ...)) ((n v) ...) (bn ...) bd ...))

((%alet% (p ...) ((n v) ...) ((a b) bn ...) bd ...)
((lambda (t) (%alet% (p ...) ((n v) ... (a t)) (bn ...) bd ...)) b))
((%alet% (p ...) ((n v) ...) ((a b c ...) bn ...) bd ...)
(%alet% "not" (p ...) ((n v) ... (a t)) (t) (b c ...) (bn ...) bd ...))
((%alet% "not" (p ...) ((n v) ...) (t ...) (a b c ...) (bn ...) bd ...)
(%alet% "not" (p ...) ((n v) ... (a tn)) (t ... tn) (b c ...) (bn ...)
bd ...))
((%alet% "not" (p ...) ((n v) ...) (t ...) (z) (bn ...) bd ...)
(z (lambda (t ...) (%alet% (p ...) ((n v) ...) (bn ...) bd ...))))
((%alet% (p ...) ((n v) ...) ((a) bn ...) bd ...)
(call-with-current-continuation
(lambda (t) (%alet% (p ...) ((n v) ... (a t)) (bn ...) bd ...))))
((%alet% (p ...) ((n v) ...) ((a . b) bn ...) bd ...)
(%alet% "rot" (p ...) ((n v) ...) (a) (b) (bn ...) bd ...))
((%alet% "rot" (p ...) ((n v) ...) (new-bn ...) ((a . b)) (bn ...) bd ...)
(%alet% "rot" (p ...) ((n v) ...) (new-bn ... a) (b) (bn ...) bd ...))
((%alet% "rot" (p ...) ((n v) ...) (()) (b) (bn ...) bd ...)
(%alet% (b (p ...) ((n v) ...) (bn ...)) () () bd ...))
((%alet% "rot" (p ...) ((n v) ...) (new-bn ...) (b) (bn ...) bd ...)
(%alet% (b (p ...) ((n v) ...) (bn ...)) () (new-bn ...) bd ...))
((%alet% (p ...) ((n v) ...) (a b bn ...) bd ...)
(b (lambda t (%alet% (p ...) ((n v) ... (a t)) (bn ...) bd ...))))))

;;; alet*
(define-syntax alet*
(syntax-rules (opt cat and dyn)
((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* (((a . b) c) bn ...) bd ...)
(c (lambda (a . b) (alet* (bn ...) bd ...))))
((alet* (((a . b) c ...) bn ...) bd ...)
((lambda (a . b) (alet* (bn ...) bd ...)) c ...))

((alet* ((and (n1 v1) (n2 v2) ...) bn ...) bd ...)
(and-let* ((n1 v1) (n2 v2) ...) (alet* (bn ...) bd ...)))
((alet* ((opt rest c1 c2 ...) bn ...) bd ...)
(alet-opt* rest (c1 c2 ...) (alet* (bn ...) bd ...)))
((alet* ((cat rest c1 c2 ...) bn ...) bd ...)
(alet-cat* rest (c1 c2 ...) (alet* (bn ...) bd ...)))
((alet* ((dyn (n1 v1) (n2 v2) ...) bn ...) bd ...)
((lambda (o1) (alet* "dyn" ((n1 v1 o1)) ((n2 v2) ...) (bn ...) bd ...))
n1))
((alet* "dyn" ((n v o) ...) ((n1 v1) (n2 v2) ...) (bn ...) bd ...)
((lambda (o1)
(alet* "dyn" ((n v o) ... (n1 v1 o1)) ((n2 v2) ...) (bn ...) bd ...))
n1))
((alet* "dyn" ((n v o) ...) () (bn ...) bd ...)
(dynamic-wind
(lambda () (set! n v) ...)
(lambda () (alet* (bn ...) bd ...))
(lambda () (set! n o) ...)))

((alet* ((a b) bn ...) bd ...)
((lambda (a) (alet* (bn ...) bd ...)) b))
((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* tag (bn ...) bd ...)
(%alet*% (tag) () (bn ...) bd ...))))

(define-syntax %alet*%
(syntax-rules (opt cat and dyn)
((%alet*% (tag) (n ...) () bd ...)
((letrec ((tag (lambda (n ...) bd ...)))
tag)
n ...))
((%alet*% (var (bn ...)) (n ...) () bd ...)
((letrec ((var (lambda (n ...) (alet* (bn ...) bd ...))))
var)
n ...))
((%alet*% (var (p ...) (n0 ...) (bn ...)) (n ...) () bd ...)
((letrec ((var (lambda (n ...)
(%alet*% (p ...) (n0 ... 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) b) bn ...) bd ...)
((lambda (a) (%alet*% (p ...) (n ... a) (bn ...) bd ...)) b))
((%alet*% (p ...) (n ...) (((a b c ...) d) bn ...) bd ...)
(d (lambda (a b c ...)
(%alet*% (p ...) (n ... a b c ...) (bn ...) bd ...))))
((%alet*% (p ...) (n ...) (((a b c ...) d ...) bn ...) bd ...)
((lambda (a b c ...)
(%alet*% (p ...) (n ... a b c ...) (bn ...) bd ...)) d ...))
((%alet*% (p ...) (n ...) (((a . b) c ...) bn ...) bd ...)
(%alet*% "dot" (p ...) (n ... a) (a) ((b) c ...) (bn ...) bd ...))
((%alet*% "dot" (p ...) (n ...) (r ...) (((a . b)) c ...) (bn ...) bd ...)
(%alet*% "dot" (p ...) (n ... a) (r ... a) ((b) c ...) (bn ...) bd ...))
((%alet*% "dot" (p ...) (n ...) (r ...) ((b) c) (bn ...) bd ...)
(c (lambda (r ... . b) (%alet*% (p ...) (n ... b) (bn ...) bd ...))))
((%alet*% "dot" (p ...) (n ...) (r ...) ((b) c ...) (bn ...) bd ...)
((lambda (r ... . b) (%alet*% (p ...) (n ... b) (bn ...) bd ...)) c ...))

((%alet*% (p ...) (n ...) ((and (n1 v1) (n2 v2) ...) bn ...) bd ...)
(and-let* ((n1 v1) (n2 v2) ...)
(%alet*% (p ...) (n ... n1 n2 ...) (bn ...) bd ...)))
((%alet*% (p ...) (n ...) ((opt rest c c1 ...) bn ...) bd ...)
(%alet-opt*% ((p ...) (n ...) (bn ...)) () rest (c c1 ...) bd ...))
((%alet*% (p ...) (n ...) ((cat rest c c1 ...) bn ...) bd ...)
(%alet-cat*% ((p ...) (n ...) (bn ...)) () rest (c c1 ...) bd ...))
((%alet*% (p ...) (n ...) ((dyn (n1 v1) (n2 v2) ...) bn ...) bd ...)
((lambda (o1)
(%alet*% "dyn" (p ...) (n ... n1)
((n1 v1 o1)) ((n2 v2) ...) (bn ...) bd ...))
n1))
((%alet*% "dyn" (p ...) (n ...)
((n0 v0 o0) ...) ((n1 v1) (n2 v2) ...) (bn ...) bd ...)
((lambda (o1)
(%alet*% "dyn" (p ...) (n ... n1)
((n0 v0 o0) ... (n1 v1 o1)) ((n2 v2) ...) (bn ...) bd ...))
n1))
((%alet*% "dyn" (p ...) (n ...) ((n0 v0 o0) ...) () (bn ...) bd ...)
(dynamic-wind
(lambda () (set! n0 v0) ...)
(lambda () (%alet*% (p ...) (n ...) (bn ...) bd ...))
(lambda () (set! n0 o0) ...)))

((%alet*% (p ...) (n ...) ((a b) bn ...) bd ...)
((lambda (a) (%alet*% (p ...) (n ... a) (bn ...) bd ...)) b))
((%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 ...))))))

(define-syntax and-let
(syntax-rules ()
((and-let ((n v) ...) bd ...)
(%and-let% () ((n v) ...) bd ...))))

(define-syntax %and-let%
(syntax-rules ()
((%and-let% ((n v) ...) () bd ...)
((lambda (n ...) bd ...) v ...))
((%and-let% ((n v) ...) ((n1 v1) (n2 v2) ...) bd ...)
((lambda (t)
(and t (%and-let% ((n v) ... (n1 t)) ((n2 v2) ...) bd ...))) v1))))

(define-syntax and-let*
(syntax-rules ()
((and-let* () bd ...)
((lambda () bd ...)))
((and-let* ((n v) (n1 v1) ...) bd ...)
((lambda (n)
(and n (and-let* ((n1 v1) ...) bd ...))) v))))

(define-syntax fluid-let
(syntax-rules ()
((fluid-let ((n1 v1) (n2 v2) ...) body ...)
((lambda (o1 t1)
(fluid-let "fluid" ((n1 t1 o1)) ((n2 v2) ...) body ...))
n1 v1))
((fluid-let "fluid" ((n t o) ...) ((n1 v1) (n2 v2) ...) body ...)
((lambda (o1 t1)
(fluid-let "fluid" ((n t o) ... (n1 t1 o1)) ((n2 v2) ...) body ...))
n1 v1))
((fluid-let "fluid" ((n t o) ...) () body ...)
(dynamic-wind
(lambda () (set! n t) ...)
(lambda () ((lambda (n ...) body ...) t ...))
(lambda () (set! n o) ...)))))

(define-syntax fluid-let*
(syntax-rules ()
((fluid-let* ((n1 v1) (n2 v2) ...) body ...)
((lambda (o1)
(fluid-let* "fluid" ((n1 v1 o1)) ((n2 v2) ...) body ...))
n1))
((fluid-let* "fluid" ((n v o) ...) ((n1 v1) (n2 v2) ...) body ...)
((lambda (o1)
(fluid-let* "fluid" ((n v o) ... (n1 v1 o1)) ((n2 v2) ...) body ...))
n1))
((fluid-let* "fluid" ((n v o) ...) () body ...)
(dynamic-wind
(lambda () (set! n v) ...)
(lambda () body ...)
(lambda () (set! n o) ...)))))

(define-syntax %alet-opt%
(syntax-rules ()
((%alet-opt% ((p ...) ((n0 v0) ...) (bn ...)) ((n v) ...) rest
((var def)) bd ...)
(alet ((val (if (null? rest)
def
(if (null? (cdr rest))
(car rest)
(error "alet: too many arguments" (cdr rest))))))
(%alet% (p ...) ((n0 v0) ... (n v) ... (var val)) (bn ...) bd ...)))
((%alet-opt% ((p ...) ((n0 v0) ...) (bn ...)) ((n v) ...) rest
((var def test ...)) bd ...)
(alet ((val (if (null? rest)
def
(if (null? (cdr rest))
(alet ((var (car rest)))
(if (and test ...)
var
(error "alet: bad argument"
var 'var '(and test ...))))
(error "alet: too many arguments" (cdr rest))))))
(%alet% (p ...) ((n0 v0) ... (n v) ... (var val)) (bn ...) bd ...)))
((%alet-opt% ((p ...)((n0 v0) ...) (bn ...)) ((n v) ...) rest (var) bd ...)
((lambda (t)
(%alet% (p ...) ((n0 v0) ... (n v) ... (var t)) (bn ...) bd ...))
rest))
((%alet-opt% (g ...) ((n v) ...) rest ((var def) cl ...) bd ...)
(alet* ((lis (if (null? rest) (cons def '()) rest))
((val rem) (car lis) (cdr lis)))
(%alet-opt% (g ...) ((n v) ... (var val)) rem (cl ...) bd ...)))
((%alet-opt% (g ...) ((n v) ...) rest ((var def test ...) cl ...) bd ...)
(alet* ((lis (if (null? rest)
(cons def '())
(alet ((var (car rest)))
(if (and test ...)
rest
(error "alet*: bad argument"
var 'var '(and test ...))))))
((val rem) (car lis) (cdr lis)))
(%alet-opt% (g ...) ((n v) ... (var val)) rem (cl ...) bd ...)))))

(define-syntax %alet-opt*%
(syntax-rules ()
((%alet-opt*% ((p ...) (n0 ...) (bn ...)) (n ...) rest ((var def)) bd ...)
(alet ((var (if (null? rest)
def
(if (null? (cdr rest))
(car rest)
(error "alet*: too many arguments" (cdr rest))))))
(%alet*% (p ...) (n0 ... n ... var) (bn ...) bd ...)))
((%alet-opt*% ((p ...) (n0 ...) (bn ...)) (n ...) rest ((var def test ...))
bd ...)
(alet ((var (if (null? rest)
def
(if (null? (cdr rest))
(alet ((var (car rest)))
(if (and test ...)
var
(error "alet*: bad argument"
var 'var '(and test ...))))
(error "alet*: too many arguments" (cdr rest))))))
(%alet*% (p ...) (n0 ... n ... var) (bn ...) bd ...)))
((%alet-opt*% ((p ...) (n0 ...) (bn ...)) (n ...) rest (var) bd ...)
((lambda (var)
(%alet*% (p ...) (n0 ... n ... var) (bn ...) bd ...)) rest))
((%alet-opt*% (g ...) (n ...) rest ((var def) cl ...) bd ...)
(alet* ((lis (if (null? rest) (cons def '()) rest))
((var rem) (car lis) (cdr lis)))
(%alet-opt*% (g ...) (n ... var) rem (cl ...) bd ...)))
((%alet-opt*% (g ...) (n ...) rest ((var def test ...) cl ...) bd ...)
(alet* ((lis (if (null? rest)
(cons def '())
(alet ((var (car rest)))
(if (and test ...)
rest
(error "alet*: bad argument"
var 'var '(and test ...))))))
((var rem) (car lis) (cdr lis)))
(%alet-opt*% (g ...) (n ... var) rem (cl ...) bd ...)))))

(define-syntax alet-opt*
(syntax-rules ()
((alet-opt* rest ((var def)) bd ...)
(alet ((var (if (null? rest)
def
(if (null? (cdr rest))
(car rest)
(error "alet*: too many arguments" (cdr rest))))))
bd ...))
((alet-opt* rest ((var def test ...)) bd ...)
(alet ((var (if (null? rest)
def
(if (null? (cdr rest))
(alet ((var (car rest)))
(if (and test ...)
var
(error "alet*: bad argument"
var 'var '(and test ...))))
(error "alet*: too many arguments" (cdr rest))))))
bd ...))
((alet-opt* rest (var) bd ...)
((lambda (var) bd ...) rest))
((alet-opt* rest ((var def) cl ...) bd ...)
(alet* ((lis (if (null? rest) (cons def '()) rest))
((var rem) (car lis) (cdr lis)))
(alet-opt* rem (cl ...) bd ...)))
((alet-opt* rest ((var def test ...) cl ...) bd ...)
(alet* ((lis (if (null? rest)
(cons def '())
(alet ((var (car rest)))
(if (and test ...)
rest
(error "alet*: bad argument"
var 'var '(and test ...))))))
((var rem) (car lis) (cdr lis)))
(alet-opt* rem (cl ...) bd ...)))))

(define-syntax %alet-cat%
(syntax-rules ()
((%alet-cat% (g ...) ((n v) ...) rest ((var def test ...) cl ...) bd ...)
(alet* ((lis (if (null? rest)
(cons def rest)
(alet ((var (car rest)))
(if (and test ...)
rest
(alet lp ((head (list var)) (tail (cdr rest)))
(if (null? tail)
(cons def rest)
(alet ((var (car tail)))
(if (and test ...)
(cons var (append (reverse head)
(cdr tail)))
(lp (cons var head)
(cdr tail))))))))))
((val rem) (car lis) (cdr lis)))
(%alet-cat% (g ...) ((n v) ... (var val)) rem (cl ...) bd ...)))
((%alet-cat% ((p ...)((n0 v0) ...) (bn ...)) ((n v) ...) rest () bd ...)
(if (null? rest)
(%alet% (p ...) ((n0 v0) ... (n v) ...) (bn ...) bd ...)
(error "alet: too many arguments" rest)))
((%alet-cat% ((p ...)((n0 v0) ...) (bn ...)) ((n v) ...) rest (var) bd ...)
((lambda (t)
(%alet% (p ...) ((n0 v0) ... (n v) ... (var t)) (bn ...) bd ...))
rest))))

(define-syntax %alet-cat*%
(syntax-rules ()
((%alet-cat*% (g ...) (n ...) rest ((var def test ...) cl ...) bd ...)
(alet* ((lis (if (null? rest)
(cons def rest)
(alet ((var (car rest)))
(if (and test ...)
rest
(alet lp ((head (list var)) (tail (cdr rest)))
(if (null? tail)
(cons def rest)
(alet ((var (car tail)))
(if (and test ...)
(cons var (append (reverse head)
(cdr tail)))
(lp (cons var head)
(cdr tail))))))))))
((var rem) (car lis) (cdr lis)))
(%alet-cat*% (g ...) (n ... var) rem (cl ...) bd ...)))
((%alet-cat*% ((p ...) (n0 ...) (bn ...)) (n ...) rest () bd ...)
(if (null? rest)
(%alet*% (p ...) (n0 ... n ...) (bn ...) bd ...)
(error "alet*: too many arguments" rest)))
((%alet-cat*% ((p ...) (n0 ...) (bn ...)) (n ...) rest (var) bd ...)
((lambda (var)
(%alet*% (p ...) (n0 ... n ... var) (bn ...) bd ...)) rest))))

(define-syntax alet-cat*
(syntax-rules ()
((alet-cat* rest ((var def test ...) cl ...) bd ...)
(alet* ((lis (if (null? rest)
(cons def rest)
(alet ((var (car rest)))
(if (and test ...)
rest
(alet lp ((head (list var)) (tail (cdr rest)))
(if (null? tail)
(cons def rest)
(alet ((var (car tail)))
(if (and test ...)
(cons var (append (reverse head)
(cdr tail)))
(lp (cons var head)
(cdr tail))))))))))
((var rem) (car lis) (cdr lis)))
(alet-cat* rem (cl ...) bd ...)))
((alet-cat* rest () bd ...)
(if (null? rest)
((lambda () bd ...))
(error "alet*: too many arguments" rest)))
((alet-cat* rest (var) bd ...)
((lambda (var) bd ...) rest))))


References

[R5RS] Richard Kelsey, William Clinger, and Jonathan Rees: Revised(5)
Report on the Algorithmic Language Scheme
http://www.schemers.org/Documents/Standards/R5Rs/
[SRFI 2] Oleg Kiselyov: AND-LET*: and AND with local bindings, a guarded
LET* special form.
http://srfi.schemers.org/srfi-2/
[SRFI 11] Lars T. Hansen: Syntax for receiving multipl values.
http://srfi.schemers.org/srfi-11/
[SRFI 15] Lars T. Hansen: Syntax for dynamic scoping.
http://srfi.schemers.org/srfi-15/
[SRFI 51] Joo ChurlSoo: Handling rest list.
http://srfi.schemers.org/srfi-51/
[SRFI 71] Sebastian Egner: Extended LET-syntax for multiple values.
http://srfi.schemers.org/srfi-71/
Scsh Olin Shivers, Brian Carlstrom, Martin Gasbichler, Mike Sperber
http://www.scsh.net

--
Joo ChurlSoo

0 new messages