Title MU and NU simulating VALUES & CALL-WITH-VALUES, and their related LET-syntax Author Joo ChurlSoo Abstract Unlike the VALUES/CALL-WITH-VALUES 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, MU and NU, evaluates to a procedure that takes one procedure argument. The MU and NU can be compared with LAMBDA. While LAMBDA expression that consists of and requires some actual arguments later when the evaluated LAMBDA expression is called, MU and NU expressions that consist of s corresponding to actual arguments of LAMBDA require and , that is, an evaluated LAMBDA expression, later when the evaluated MU and NU expressions are called. This SRFI also introduces new LET-syntax depending on MU and NU to manipulate multiple values, ALET and ALET* that are compatible with LET and LET* of R5RS in single value bindings. They also have a binding form making use of VALUES and CALL-WITH-VALUES to handle multiple values. In addition, they have several new binding forms for useful functions such as escape, recursion, etc. Rationale It is impossible to bind the evaluated result of VALUES expression to a single variable unlike other Scheme expressions. Moreover, the pair of VALUES and CALL-WITH-VALUES is clumsy to use and somewhat slow under some circumstances. 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 examples to show the differences. (define v (values 1 2 3)) => error (define v (lambda () (values 1 2 3))) => (lambda () (values 1 2 3)) (define m (mu 1 2 3)) => (lambda (f) (f 1 2 3)) (define a (apply values 1 '(2 3))) => error (define a (lambda () (apply values 1 '(2 3)))) => (lambda () (apply values 1 '(2 3))) (define n (nu 1 '(2 3))) => (lambda (f) (apply f 1 '(2 3))) (call-with-values v list) => (1 2 3) (m list) => (1 2 3) (call-with-values a list) => (1 2 3) (n list) => (1 2 3) The ALET and ALET* are cases in point to use MU and NU. The differences between this LET-syntax and others, and some additional functions are best explained by simple examples. 1. The following 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 SRFI: (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 SRFI: (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 bindings that require multiple values can take multiple expressions, if syntactically possible, as well as single expression that produce multiple values. (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)) => (1 2 1 4 8 5 (6 7) 8 9 10 (8 9 10)) 4. The named-ALET and named-ALET* are allowed to take multiple values bindings. 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 SRFI: (alet* tag ((a 1) (a b b c (mu (+ a 2) 4 5 6)) ((d e e) b 5 (+ a b c))) (if (< a 10) (tag a 10 b c c d e d) (list a b c d e))) => (10 6 6 5 5) 5. They have a new binding form that has a recursive function like named-ALET. It is also allowed to take multiple values bindings. (alet* ((a 1) ((b 2) (b c c (mu 3 4 5)) ((d e d (mu a b c)) . intag) . tag) (f 6)) (if (< d 10) (intag d e 10) (if (< c 10) (tag b 11 c 12 a b d intag) (list a b c d e f)))) => (1 11 12 10 3 6) 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'. (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)) => 1st2ndfalse#f (alet ((and (a (begin (display "1st") 1)) (b (begin (display "2nd") 2) (< b 2)) ; different from SRFI-2 (c (begin (display "false") #f)) (d (begin (display "3nd") 3)))) (list a b c d)) => 1st2nd#f 8. The REST-VALUES of SRFI-51 is integrated into the ALET and ALET* with syntactic keywords `opt' and `cat' in the similar way to 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 LETREC and LETREC* are integrated into the ALET and ALET* with a syntactic keyword `rec'. (alet* ((a 1) (rec (a 2) (b 3) (b (lambda () c)) (c a)) (d 50)) (list a (b) c d)) => '(2 2 2 50) 10. They have a binding form that use CALL-WITH-VALUES and VALUES to handle multiple values with a syntactic keyword `values' like SRFI-71 . (alet ((a b (mu 1 2)) (values c d (values 3 4)) ;This is different from SRFI-71. ((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)) => (1 2 3 4 5 6 7 8 9 10 (11 12) 13 14 (15 16) (17 18) (19 20)) 11. They have a new binding form that works as an intervening external environment in ALET and as an intervening internal 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) Specification (mu ...) => (lambda (f) (f ...)) (nu ... ) => (lambda (f) (apply f ... )) The should be a list. 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 s to the corresponding variables in the formal argument list of the argument procedure. The argument procedure of MU is called with the s, and that of NU is applied to APPLY procedure with the s. (alet ( ...) body ...) (alet* ( ...) body ...) syntax-rules identifier: opt cat rec and values : 1. () 2. ( ... ) 3. (() ) 4. (( ... ) ) 5. (( ... . ) ) 6. (( ... ) ...) 7. (( ... . ) ... ...) 8. 9. () 10. ( ... . ) 11. (() . ) 12. (and ( ...) ( ...) ...) 13. (opt ( ...) ... ( ...) . []) 14. (cat ( ...) ... ( ...) . []) 15. (rec ( ) ( ) ...) 16. (values ... ) 17. ((values ...) ) 18. ((values ... . ) ) 19. ((values ...) ...) 20. ((values ... . ) ... ...) 21. (() ...) The ALET* is to the ALET what the LET* is to the LET. However, the s of ALET 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 of multiple values binding 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. ( ) This is the same as LET (R5RS, 4.2.2). 2. ( ... ) This is the same as 4. 3. (() ) This is the same as 1. 4. (( ... ) ) 5. (( ... . ) ) The must be a MU or NU expression or its equivalent. The matching of s to the values of is as for the matching of to arguments in a LAMBDA expression (R5RS, 4.1.4). 6. (( ... ) ...) This is the same as (let[*] (( ) ( ) ( ) ...). 7. (( ... . ) ... ...) This is the same as (let[*] (( ) ... ( ) ( (list ...))). 8. The is a rest argument, so the should be a form that can deliver multiple values, that is, a MU or NU expression or its equivalent. 9. () The becomes an escape procedure that can take return values of ALET[*] as its arguments. 10. ( ... . ) The becomes a recursive procedure that takes all of s as arguments. 11. (() . ) The becomes a recursive thunk that takes no argument. 12. (and ( ...) ( ...) ...) Each is evaluated sequentially and bound to the corresponding . During the process, if there is no and the value of is false, it stops and returns #f. When there are s, the process is continued regardless of the value of until the value of is false. If the value of is false, it returns #f. 13. (opt ( ...) ... ( ...) . []) This binds each to a corresponding element of . If there is no more element, then the corresponding is evaluated and bound to the . An error is signaled when there are more elements than s. But if is given, it is bound to the remaining elements. If there are s, they are evaluated only when is bound to an element of . If any of them returns a false value, an error is signaled. 14. (cat ( ...) ... ( ...) . []) This is the same as the above `opt' spec except the binding method. It temporarily binds to each elements of sequentally, until all s return true values, then the is finally bound to the passed element. If there is no , the first element of the remained is regarded as passing. If any element of the does not pass the , the is bound to the instead of signaling an error. 15. (rec ( ) ( ) ...) This is the same as (letrec[*] (( ) ( ) ...). 16. (values ... ) This is the same as 17. 17. ((values ...) ) 18. ((values ... . ) ) The should be a VALUES expression or its equivalent. The matching of s to the values of is as for the matching of to arguments in a LAMBDA expression. 19. ((values ...) ...) This is the same as (let[*] (( ) ( ) ( ) ...). 20. ((values ... . ) ... ...) This is the same as (let[*] (( ) ... ( (list ...))). 21. (() ...) This works as an intervening external environment in ALET, and an intervening internal environment in ALET*. (alet name ( ...) body ...) (alet* name ( ...) body ...) These are the same as the named-LET (R5RS, 4.2.4) except binding specification. These allow all sorts of bindings in . Examples (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)) (e f (mu (begin (display "4th") 5) 6)) . p) g (nu 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 (< d 10) (p 40 50 60) (if (< 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 showed")) => 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)) (e f (mu (begin (display "4th") 5) 6)) . p) g (nu 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 (< d 10) (p 40 50 60) (if (< 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 showed")) => 1st2nd3rd4th5th6thend 5th6thend 6thend (1 2 3 40 50 60 (7 8) (7 8) 9 10 111 12 111 (8)) (# # #) Implementation The following implementation is written in R5RS hygienic macros and requires SRFI-23 (Error reporting mechanism). ;;; mu & 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 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 (n v)) bn ...) bd ...) (let ((t v)) (and t (%alet (p ...) (nv ... (n t)) (bn ...) bd ...)))) ((%alet (p ...) (nv ...) ((and (n v t ...)) bn ...) bd ...) (let ((tt v)) (and (let ((n tt)) (and t ...)) (%alet (p ...) (nv ... (n tt)) (bn ...) bd ...)))) ((%alet (p ...) (nv ...) ((and (n v) nvt ...) bn ...) bd ...) (let ((t v)) (and t (%alet (p ...) (nv ... (n t)) ((and nvt ...) bn ...) bd ...)))) ((%alet (p ...) (nv ...) ((and (n v t ...) nvt ...) bn ...) bd ...) (let ((tt v)) (and (let ((n tt)) (and t ...)) (%alet (p ...) (nv ... (n tt)) ((and nvt ...) 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-check 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-check 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-check n (car z) 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 ...) ((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 ') ...) (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 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 (n v t ...) nvt ...) bn ...) bd ...) (alet-and* ((n v t ...) nvt ...) (alet* (bn ...) bd ...))) ((alet* ((opt z a . c) bn ...) bd ...) (%alet-opt* z (a . c) (alet* (bn ...) bd ...))) ((alet* ((cat z a . c) bn ...) bd ...) (let ((y z)) (%alet-cat* y (a . c) (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 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-check 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-check 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-check n (car z) 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 ...) (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)) (and 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 ') ...) (let ((t v) ...) (set! n t) ... ;;(let () ;; bd ...)))))) bd ...))))) (define-syntax alet-rec* (syntax-rules () ((alet-rec* ((n v) ...) bd ...) (let* ((n ') ...) (set! n v) ... ;;(let () ;; bd ...))))) bd ...)))) (define-syntax wow-check ; wow means with-or-without. (syntax-rules () ((wow-check n v) v) ((wow-check n v t ...) (let ((n v)) (if (and t ...) n (error "alet[*]: bad argument" n 'n 't ...)))))) (define-syntax wow-check! (syntax-rules () ((wow-check! z n) (let ((n (car z))) (set! z (cdr z)) n)) ((wow-check! z n t ...) (let ((n (car z))) (if (and t ...) (begin (set! z (cdr z)) n) (error "alet[*]: bad argument" n 'n 't ...)))))) (define-syntax wow-cat (syntax-rules () ((wow-cat z n d) z) ((wow-cat z n d t ...) (let ((n (car z))) (if (and t ...) z (let lp ((head (list n)) (tail (cdr z))) (if (null? tail) (cons d z) (let ((n (car tail))) (if (and t ...) (cons n (append (reverse head) (cdr tail))) (lp (cons n head) (cdr tail))))))))))) (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 (and t ...) (begin (set! z (cdr z)) n) (let lp ((head (list n)) (tail (cdr z))) (if (null? tail) d (let ((n (car tail))) (if (and t ...) (begin (set! z (append (reverse head) (cdr tail))) n) (lp (cons n head) (cdr tail))))))))))) (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-check 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-check 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-check 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-check! 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-check 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-check 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-check n (car z) 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-check n (car z) 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 ...)))) 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 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 Copyright Copyright (c) 2006 Joo ChurlSoo. 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: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 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.