Title

ALAMBDA and ALAMBDA*

Author

Joo ChurlSoo

Abstract

This SRFI introduces ALAMBDA and ALAMBDA*, each of which has two modes of
operation:
1. it creates a procedure that checks actual arguments and takes optional
   arguments,
2. it returns a different procedure by checking each of actual arguments and
   the number of them.

Rationale

The first mode of operation reduces not only the clutter of various error
conditionals by checking actual arguments but also somewhat lengthy code by
combining optional argument handling methods such as LET-OPTIONALS and
LET-KEYWORDS into a single syntax.
Optional variables include not only optional fixed variables but also optional
non-fixed variables.  The formers are the same as those of `opt' form of ALET
and the latters are the same as those of `cat' and `key' forms of ALET (see
SRFI-86).  The following are examples to show the similarities.

1. optional fixed variables (`opt' form):

((lambda (str . rest)
   (alet* ((len (string-length str))
	   (opt rest
		(start 0 (and (integer? start) (<= 0 start len)))
		(end len (and (integer? end) (<= start end len)))))
     (substring str start end))) "abcdefg" 1 6)
=> "bcdef"

((alambda* (str
	    "opt"
	    (start 0 (and (integer? start) (<= 0 start (string-length str))))
	    (end (string-length str)
		 (and (integer? end) (<= start end (string-length str)))))
   (substring str start end)) "abcdefg" 1 6)
=> "bcdef"

2. optional non-fixed non-named variables (`cat' form):   

((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))
=> "bcdef"

((alambda* (str
	    "cat"
	    (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))
=> "bcdef"

3. optional non-fixed named variables (`key' form):   		 

((lambda (str . rest)
   (alet* ((len (string-length str))
	   (key rest
		(start 0 (and (integer? start) (<= 0 start len)))
		(end len (and (integer? end) (<= start end len)))))
     (substring str start end))) "abcdefg" 'end 6 'start 1)
=> "bcdef"

((alambda* (str
	    "key"
	    (start 0 (and (integer? start) (<= 0 start (string-length str))))
	    (end (string-length str)
		 (and (integer? end) (<= start end (string-length str)))))
   (substring str start end)) "abcdefg" 'end 6 'start 1)
=> "bcdef"

Like optional variables, required variables can be divded into three groups,
namely, conventional required fixed variables, required non-fixed non-named
variables, and required non-fixed named variables.  These are best explained
by simple examples.

1. required fixed variables:

(define vec-ref
  (alambda* ((vec (vector? vec))
	     (num (and (integer? num) (<= 0 num) (< num (vector-length vec)))))
    (vector-ref vec num)))
(vec-ref '#(1 2 3) 1)	=> 2
(vec-ref 1 '#(1 2 3))	=> bad argument 1 vec (vector? vec)
(vec-ref '#(1 2 3))	=> wrong number of arguments

2. required non-fixed non-named variables:

(define str-ref
  (alambda* ("required cat"
	     (str (string? str))
	     (n (and (integer? n) (<= 0 n) (< n (string-length str)))))
    (string-ref str n)))
(str-ref "abc" 1)   => #\b
(str-ref 1 "abc")   => #\b
(str-ref 1 2)	    => bad arguments (1 2) str (string? str)
(str-ref "abc")	    => wrong number of arguments

3. required non-fixed named variables:

(define lis-ref
  (alambda* ("required key"
	     (lis (list? lis))
	     (num (and (integer? num) (<= 0 num) (< num (length lis)))))
    (list-ref lis num)))
(lis-ref 'num 1 'lis '(1 2 3)) => 2
(lis-ref 'lis '(1 2 3) 'num 1) => 2
(lis-ref 'lis '(1 2 3) 'nu 3)  => no corresponding value to key num (nu 3)
(lis-ref 'lis '(1 2 3) 'nu)    => wrong number of arguments

The second mode of operation reduces the clutter of procedures more precisely
than CASE-LAMBDA of SRFI-16 by adding <test> to its formal argument list to
check each of actual arguments.  The following are examples to show the
differences.

(define list-ref/set!
  (case-lambda 
   ((a b) (list-ref a b))
   ((a b c) (set-car! (list-tail a b) c))
   (a (error "bad arguments" a))))

(define ref/set!
  (alambda (cond
	    (((a (list? a)) b) (list-ref a b))
	    (((a (string? a)) b) (string-ref a b))
	    (((a (vector? a)) b) (vector-ref a b))
	    (((a (list? a)) b c) (set-car! (list-tail a b) c))
	    (((a (string? a)) b c) (string-set! a b c))
	    (((a (vector? a)) b c) (vector-set! a b c))
	    (a (error "bad arguments" a)))))	   
	  
Specification

The syntax is defined in the extended BNF of R5RS.
(alambda  <sentence>)
(alambda* <sentence>)
syntax-rules identifier: cond
<sentence> -->  <extended formals> <body> | (cond <clause>+)
<extended formals> -->
	  | (<required spec> <optional spec> <key option>)
	  | (<required spec> <key option>)
	  | (<opiontal spec> <key option>)
	  | (<required spec> <optional spec> <key option> . <variable>)
	  | (<required spec> <key option> . <variable>)
	  | (<optional spec> <key option> . <variable>)
	  | <variable>
	  | ()
<required spec> --> <required fixed variable spec>+
		  | <required fixed variable spec>* <required non-fixed spec>
<required fixed variable spec> --> <variable> | (<variable> <test spec>)
<test spec> --> <test>
	      | <test> <true substitute>
	      | <test> <true substitute> <false substitute>
<required non-fixed spec> --> <required cat spec>
			    | <required key spec>
			    | <required cat spec> <required key spec>
			    | <required key spec> <required cat spec>
<required cat spec> --> "required cat" <required fixed variable spec>+
<required key spec> --> "required key" <required key variable spec>+
<required key variable spec> --> <required fixed variable spec>
			       | ((<variable> <keyword>))
			       | ((<variable> <keyword>) <test spec>)
<optional spec> --> <opt spec>
		  | <cat spec>
		  | <key spec>
		  | <opt spec> <cat spec>
		  | <opt spec> <key spec>
		  | <cat spec> <key spec>
		  | <key spec> <cat spec>
		  | <opt spec> <cat spec> <key spec>
		  | <opt spec> <key spec> <cat spec>
<opt spec> --> "opt" <opt variable spec>+
<opt variable spec> --> <variable>
		      | (<variable> <default>)
		      | (<variable> <default> <test spec>)
<cat spec> --> "cat" <opt variable spec>+
<key spec> --> "key" <key variable spec>+
<key variable spec> --> <opt variable spec>
		      | ((<variable> <keyword>))
		      | ((<variable> <keyword>) <default>)
		      | ((<variable> <keyword>) <default> <test spec>)
<key option> --> #f | #t | <empty>
<test> --> <expression>
<true substitute> --> <expression>
<false substitute> --> <expression>
<default> --> <expression>
<keyword> --> <any scheme object>

<clause> --> (<cond formals> <body>)
<cond formals> --> (<cond variable spec>*)
		 | <variable>
		 | (<cond variable spec>+ . <variable>)
<cond variable spec> --> <variable>
	               | (<variable> <test>)

The ALAMBDA* is to the ALAMBDA what the LET* is to the LET.  The <default>s,
<test>s, <true substitute>s, and <false substitute>s of ALAMBDA* are evaluated
in an environment that all the bindings of previous <variable>s are visible.

1. the first mode of operation:

There are three kinds of required variables, namely, required fixed variable,
required non-fixed non-named variable, and required non-fixed named variable.
They determine the number of required actual arguments, that is, the minimum
arity of the resulting procedure.

The required fixed variables are placed before any string marker in <extended
formals>.  They are bound to successive actual arguments starting with the
first actual argument.  If there is a <test>, it is evaluated.  If it returns
a false value and there is no <false substitute>, an error is signaled.  If it
returns a false value and there is a <false substitute>, the variable is
rebound to the result of evaluating <false substitute> instead of signaling an
error.  If it returns a true value and there is a <true substitute>, the
variable is rebound to the result of evaluating <true substitute>.

The required non-fixed non-named variables follow a "required cat" marker in
<extended formals>.  The variable is temporarily bound to each of remaining
required actual arguments sequentially, until <test> returns a true value,
then the variable is finally bound to the passed argument.  If there is no
<test>, the first one of the remaining required actual arguments is regarded
as passing.  If any actual argument does not pass <test>, an error is
signaled.  If there is a <false substitute> and <test> returns a false value,
the variable is finally bound to the result of evaluating <false substitute>
instead of the above process.  If there is a <true substitute> and <test>
returns a true value, the variable is rebound to the result of evaluating
<true substitute>.

The required non-fixed named variables follow a "required key" marker in
<extended formals>.  Unlike SRFI-89, the keywords are not self-evaluating
symbols, but any scheme objects.  The keyword used at a call site for the
corresponding variable is a symbol of the same name as the variable.  But the
keyword can be any scheme object when the required parameter is specified as a
double parenthesized variable and a keyword.  The remaining required actual
arguments must be an even number.  They are sequentially interpreted as a
series of pairs, where the first member of each pair is a keyword
corresponding to the variable, and the second is the corresponding value.  If
there is no element for a particular keyword, an error is signaled.  When
there is a <test>, it is evaluated.  If it returns a false value and there is
no <false substitute>, an error is signaled.  If it returns a false value and
there is a <false substitute>, the variable is rebound to the result of
evaluating <false substitute> instead of signaling an error.  If it returns a
true value and there is a <true substitute>, the variable is rebound to the
result of evaluating <true substitute>.

The optional fixed variables follow an "opt" marker in <extended formals>.
The binding method is the same as that of the required fixed variables except
that the variable is bound to the result of evaluating <default> instead of
signaling an error if there are no remaining actual arguments.  If <default>
is not specified, #f is the default.

The optional non-fixed non-named variables follow a "cat" marker in <extended
formals>.  The binding method is the same as that of the required non-fixed
non-named variables except that the variable is bound to the result of
evaluating <default> instead of signaling an error if any actual argument does
not pass <test>.  If <default> is not specified, #f is the default.

The optional non-fixed named variables follow a "key" marker in <extended
formals>.  The binding method is the same as that of the required non-fixed
named variables except that the variable is bound to the result of evaluating
<default> instead of signaling an error if there is no corresponding value to
a particular keyword.  If <default> is not specified, #f is the default.

The following key options can be used to control binding behavior in case that
the keyword of keyword-value pair at the call site is different from any
keywords specified in <extended formals>.
1. default -- The remaining actual arguments are continually interpreted as a
	      series of pairs.
2. #f -- An error is signaled in case of required non-fixed named variables. 
	 In case of optional non-fixed named variables, the variable is bound
	 to the corresponding <default>.
3. #t -- The remaining actual arguments are continually interpreted as a
	 single element until the element is a particular keyword.

When there are remaining actual arguments, an error is signaled if dotted rest
variable is not given.  If dotted rest variable is given, it is bound to the
remaining actual arguments.

2. the second mode of operation:

This is an extended form of CASE-LAMBDA of SRFI-16.  Like CASE-LAMBDA, it
returns a procedure of the first <clause>, the <cond formals> of which is
matched with the number of actual arguments.  But if there is a <test> and the
result of evaluation returns a false value, the subsequent <clause> is
processed in spite of the match.  If no <clause> matches, an error is
signaled.

Examples

((alambda (a
	   (b (number? b))
	   "opt" (c 10)
	   "key" ((d 'dd) 30 (number? d)) e ((f "ff") 40) (g 50)
	   . h)
   (list a b c d e f g h))
 0 1 2 'dd 3 44 55 'g 6 'dd 4 'f 66 77 "ff" 5)
=> (0 1 2 3 #f 40 6 (44 55 dd 4 f 66 77 "ff" 5))

((alambda (a
	   (b (number? b))
	   "opt" (c 10)
	   "key" ((d 'dd) 30 (number? d)) e ((f "ff") 40) (g 50)
	   #f
	   . h)
   (list a b c d e f g h))
 0 1 2 'dd 3 44 55 'g 6 'dd 4 'f 66 77 "ff" 5)
=> (0 1 2 3 #f 40 50 (44 55 g 6 dd 4 f 66 77 "ff" 5))

((alambda (a
	   (b (number? b))
	   "opt" (c 10)
	   "key" ((d 'dd) 30 (number? d)) e ((f "ff") 40) (g 50)
	   #t
	   . h)
   (list a b c d e f g h))
 0 1 2 'dd 3 44 55 'g 6 'dd 4 'f 66 77 "ff" 5)
=> (0 1 2 3 #f 5 6 (44 55 dd 4 f 66 77))

(define ref/set!
  (alambda* (cond
	     (((a (list? a))
	       (b (and (integer? b) (<= 0 b) (< b (length a)))))
	      (list-ref a b))
	     (((a (string? a))
	       (b (and (integer? b) (<= 0 b) (< b (string-length a)))))
	      (string-ref a b))
	     (((a (vector? a))
	       (b (and (integer? b) (<= 0 b) (< b (vector-length a)))))
	      (vector-ref a b))
	     (((a (list? a))
	       (b (and (integer? b) (<= 0 b) (< b (length a))))
	       c)
	      (set-car! (list-tail a b) c))
	     (((a (string? a))
	       (b (and (integer? b) (<= 0 b) (< b (string-length a))))
	       (c (char? c)))
	      (string-set! a b c))
	     (((a (vector? a))
	       (b (and (integer? b) (<= 0 b) (< b (vector-length a))))
	       c)
	      (vector-set! a b c))
	     (a (error "bad arguments" a)))))

(let ((str (string #\a #\b #\c))
      (lis (list 1 2 3))
      (vec (vector 4 5 6)))
  (display (ref/set! str 1)) (display " ")
  (display (ref/set! lis 1)) (display " ")
  (display (ref/set! vec 1)) (newline)
  (display str) (display " ")
  (display lis) (display " ")
  (display vec) (newline)
  (ref/set! str 1 #\z) (ref/set! lis 1 8) (ref/set! vec 1 9)
  (display str) (display " ")
  (display lis) (display " ")
  (display vec) (newline))
=> b 2 5
   abc (1 2 3) #(4 5 6)
   azc (1 8 3) #(4 9 6)
 
Implementation

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

(define-syntax alambda
  (syntax-rules (cond)
    ((alambda (g . e) b d ...)
     (%alambda "chk" () (() () () ()) () () () (() ()) () (g . e) b d ...))
    ((alambda (cond clause cl ...))
     (lambda z
       (let ((len (length z)))
	 (check-cond z len () () clause cl ...))))
    ((alambda e b d ...)
     (lambda e b d ...))))
(define-syntax %alambda
  (syntax-rules ()
    ;; "chk"
    ((%alambda "chk" () ((h ...) () () ()) (r ...) ()
	       () (() ()) () ("required cat" . e) bd ...)
     (%alambda "rat" () ((h ...) () () ()) (r ...) () () (() ()) () e bd ...))
    ((%alambda "chk" () ((h ...) () () ()) (r ...) ()
	       () (() ()) () ("required key" . e) bd ...)
     (%alambda "rey" () ((h ...) () () ()) (r ...) () () (() ()) () e bd ...))
    ((%alambda "chk" () ((h ...) () () ()) (r ...) ()
	       () (() ()) () ("opt" . e) bd ...)
     (%alambda "opt" () ((h ...) () () ()) (r ...) () () (() ()) () e bd ...))
    ((%alambda "chk" () ((h ...) () () ()) (r ...) ()
	       () (() ()) () ("cat" . e) bd ...)
     (%alambda "cat" () ((h ...) () () ()) (r ...) () () (() ()) () e bd ...))
    ((%alambda "chk" () ((h ...) () () ()) (r ...) ()
	       () (() ()) () ("key" . e) bd ...)
     (%alambda "key" () ((h ...) () () ()) (r ...) () () (() ()) () e bd ...))
    ;; "rat"
    ((%alambda "rat" () ((h ...) (i in ...) () ()) (r ...) (rk ...)
	       () (() ()) () ("required key" . e) bd ...)
     (%alambda "rey" () ((h ...) (i in ...) () ()) (r ...) (rk ...)
	       () (() ()) () e bd ...))
    ((%alambda "rat" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () ("opt" . e) bd ...)
     (%alambda "opt" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () e bd ...))
    ((%alambda "rat" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () ("cat" . e) bd ...)
     (%alambda "cat" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () e bd ...))
    ((%alambda "rat" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () ("key" . e) bd ...)
     (%alambda "key" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () e bd ...))
    ;; "rey"
    ((%alambda "rey" () ((h ...) () (j jn ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () ("required cat" . e) bd ...)
     (%alambda "rat" () ((h ...) () (j jn ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () e bd ...))
    ((%alambda "rey" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () ("opt" . e) bd ...)
     (%alambda "opt" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () e bd ...))
    ((%alambda "rey" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () ("cat" . e) bd ...)
     (%alambda "cat" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () e bd ...))
    ((%alambda "rey" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () ("key" . e) bd ...)
     (%alambda "key" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
	       () (() ()) () e bd ...))
    ;; "opt"
    ((%alambda "opt" () hijk (r ...) (rk ...)
	       (o on ...) (() ()) () ("cat" . e) bd ...)
     (%alambda "cat" () hijk (r ...) (rk ...)
	       (o on ...) (() ()) () e bd ...))
    ((%alambda "opt" () hijk (r ...) (rk ...)
	       (o on ...) (() ()) () ("key" . e) bd ...)
     (%alambda "key" () hijk (r ...) (rk ...)
	       (o on ...) (() ()) () e bd ...))
    ;; "cat"
    ((%alambda "cat" () hijk (r ...) (rk ...)
	       (o ...) ((c cn ...) ()) (ok ...) ("key" . e) bd ...)
     (%alambda "key" () hijk (r ...) (rk ...)
	       (o ...) ((c cn ...) ()) (ok ...) e bd ...))
    ;; "key"
    ((%alambda "key" () hijk (r ...) (rk ...)
	       (o ...) (() (k kn ...)) (ok ...) ("cat" . e) bd ...)
     (%alambda "cat" () hijk (r ...) (rk ...)
	       (o ...) (() (k kn ...)) (ok ...) e bd ...))
    ;; key option
    ((%alambda check () ((h ...) (i ...) (j ...) (jk jkn ...)) (r ...)
	       (rk ...) (o ...) ((c ...) (k ...)) (ok ...) (#t . e) bd ...)
     (%alambda check (#t) ((h ...) (i ...) (j ...) (jk jkn ...)) (r ...)
	       (rk ...) (o ...) ((c ...) (k ...)) (ok ...) e bd ...))
    ((%alambda check () ((h ...) (i ...) (j ...) (jk jkn ...)) (r ...)
	       (rk ...) (o ...) ((c ...) (k ...)) (ok ...) (#f . e) bd ...)
     (%alambda check (#f) ((h ...) (i ...) (j ...) (jk jkn ...)) (r ...)
	       (rk ...) (o ...) ((c ...) (k ...)) (ok ...) e bd ...))
    ((%alambda check () hijk (r ...) (rk ...)
	       (o ...) ((c ...) (k kn ...)) (ok ...) (#t . e) bd ...)
     (%alambda check (#t) hijk (r ...) (rk ...)
	       (o ...) ((c ...) (k kn ...)) (ok ...) e bd ...))
    ((%alambda check () hijk (r ...) (rk ...)
	       (o ...) ((c ...) (k kn ...)) (ok ...) (#f . e) bd ...)
     (%alambda check (#f) hijk (r ...) (rk ...)
	       (o ...) ((c ...) (k kn ...)) (ok ...) e bd ...))
    ;; required fix arguments
    ((%alambda "chk" () ((h ...) () () ())
	       (r ...) () () (() ()) () ((n t s ...) . e) bd ...)
     (%alambda "chk" () ((h ... hn) () () ())
	       (r ... (n t s ...)) () () (() ()) () e bd ...))
    ((%alambda "chk" () ((h ...) () () ())
	       (r ...) () () (() ()) () (n . e) bd ...)
     (%alambda "chk" () ((h ... hn) () () ())
	       (r ... (n)) () () (() ()) () e bd ...))
    ;; required cat arguments
    ((%alambda "rat" () ((h ...) (i ...) (j ...) (jk ...))
	       (r ...) (rk ...) () (() ()) () ((n t s ...) . e) bd ...)
     (%alambda "rat" () ((h ...) (i ... in) (j ...) (jk ...))
	       (r ...) (rk ... ((n) t s ...)) () (() ()) () e bd ...))
    ((%alambda "rat" () ((h ...) (i ...) (j ...) (jk ...))
	       (r ...) (rk ...) () (() ()) () (n . e) bd ...)
     (%alambda "rat" () ((h ...) (i ... in) (j ...) (jk ...))
	       (r ...) (rk ... ((n))) () (() ()) () e bd ...))
    ;; required key arguments
    ((%alambda "rey" () ((h ...) (i ...) (j ...) (jk ...))
	       (r ...) (rk ...) () (() ()) () (((n key) t ...) . e) bd ...)
     (%alambda "rey" () ((h ...) (i ...) (j ... jm jn) (jk ... key))
	       (r ...) (rk ... ((n key) t ...)) () (() ()) () e bd ...))
    ((%alambda "rey" () ((h ...) (i ...) (j ...) (jk ...))
	       (r ...) (rk ...) () (() ()) () ((n t s ...) . e) bd ...)
     (%alambda "rey" () ((h ...) (i ...) (j ... jm jn) (jk ... 'n))
	       (r ...) (rk ... ((n 'n) t s ...)) () (() ()) () e bd ...))
    ((%alambda "rey" () ((h ...) (i ...) (j ...) (jk ...))
	       (r ...) (rk ...) () (() ()) () (n . e) bd ...)
     (%alambda "rey" () ((h ...) (i ...) (j ... jm jn) (jk ... 'n))
	       (r ...) (rk ... ((n 'n))) () (() ()) () e bd ...))
    ;; optional fix arguments
    ((%alambda "opt" () hijk (r ...) (rk ...)
	       (o ...) (() ()) () ((n d t ...) . e) bd ...)
     (%alambda "opt" () hijk (r ...) (rk ...)
	       (o ... (n d t ...)) (() ()) () e bd ...))
    ((%alambda "opt" () hijk (r ...) (rk ...)
	       (o ...) (() ()) () (n . e) bd ...)
     (%alambda "opt" () hijk (r ...) (rk ...)
	       (o ... (n #f)) (() ()) () e bd ...))
    ;; optional cat arguments
    ((%alambda "cat" () hijk (r ...) (rk ...) (o ...)
	       ((c ...) (k ...)) (ok ...) ((n d t ...) . e) bd ...)
     (%alambda "cat" () hijk (r ...) (rk ...) (o ...)
	       ((c ... n) (k ...)) (ok ... ((n) d t ...)) e bd ...))
    ((%alambda "cat" () hijk (r ...) (rk ...) (o ...)
	       ((c ...) (k ...)) (ok ...) (n . e) bd ...)
     (%alambda "cat" () hijk (r ...) (rk ...) (o ...)
	       ((c ... n) (k ...)) (ok ... ((n) #f)) e bd ...))
    ;; optional key arguments
    ((%alambda "key" () hijk (r ...) (rk ...) (o ...)
	       ((c ...) (k ...)) (ok ...) (((n key) d t ...) . e) bd ...)
     (%alambda "key" () hijk (r ...) (rk ...) (o ...)
	       ((c ...) (k ... key)) (ok ... ((n key) d t ...)) e bd ...))
    ((%alambda "key" () hijk (r ...) (rk ...) (o ...)
	       ((c ...) (k ...)) (ok ...) (((n key)) . e) bd ...)
     (%alambda "key" () hijk (r ...) (rk ...) (o ...)
	       ((c ...) (k ... key)) (ok ... ((n key) #f)) e bd ...))
    ((%alambda "key" () hijk (r ...) (rk ...) (o ...)
	       ((c ...) (k ...)) (ok ...) ((n d t ...) . e) bd ...)
     (%alambda "key" () hijk (r ...) (rk ...) (o ...)
	       ((c ...) (k ... 'n)) (ok ... ((n 'n) d t ...)) e bd ...))
    ((%alambda "key" () hijk (r ...) (rk ...) (o ...)
	       ((c ...) (k ...)) (ok ...) (n . e) bd ...)
     (%alambda "key" () hijk (r ...) (rk ...) (o ...)
	       ((c ...) (k ... 'n)) (ok ... ((n 'n) #f)) e bd ...))
    ;; main 
    ((%alambda check () hijk ((n) ...) () () (() ()) () e bd ...)
     (lambda (n ... . e) bd ...))
    ((%alambda check dft ((h ...) (i ...) (j ...) jk)
	       ((n t ...) ...) (((rn rk ...) rt ...) ...)
	       () (() ()) () () bd ...)
     (lambda (h ... i ... j ...)
       (let ((zz (list i ... j ...)))
	 (let ((n (wow-opt n h t ...)) ...
	       (rn (wow-req! zz dft jk (rn rk ...) rt ...)) ...)
	   bd ...))))
    ((%alambda check dft ((h ...) (i ...) (j ...) jk)
	       ((n t ...) ...) (((rn rk ...) rt ...) ...)
	       () (() ()) () e bd ...)
     (lambda (h ... i ... j ... . te)
       (let ((zz (list i ... j ...)))
	 (let ((n (wow-opt n h t ...)) ...
	       (rn (wow-req! zz dft jk (rn rk ...) rt ...)) ...
	       (e te))
	   bd ...))))
    ((%alambda check dft ((h ...) () () ()) ((n) ...) ()
	       (o ...) ((c ...) (k ...)) (ondt ...) e bd ...)
     (lambda (h ... . te)
       (check-opt te dft ((n h) ...) (o ...) (ondt ...)
		  e (k ...) bd ...)))
    ((%alambda check dft ((h ...) (i ...) (j ...) jk)
	       ((n t ...) ...) (((rn rk ...) rt ...) ...)
	       (o ...) ((c ...) (k ...)) (ondt ...) e bd ...)
     (lambda (h ... i ... j ... . te)
       (let ((zz (list i ... j ...)))
	 (check-opt te dft
		    ((n (wow-opt n h t ...)) ...
		     (rn (wow-req! zz dft jk (rn rk ...) rt ...))
		     ...)
		    (o ...) (ondt ...) e (k ...) bd ...))))))

(define-syntax alambda*
  (syntax-rules (cond)
    ((alambda* (g . e) b d ...)
     (%alambda* "chk" () (() () () ()) () () () (() ()) () (g . e) b d ...))
    ((alambda* (cond clause cl ...))
     (lambda z
       (let ((len (length z)))
	 (check-cond* z len () () clause cl ...))))
    ((alambda* e b d ...)
     (lambda e b d ...))))
(define-syntax %alambda*
  (syntax-rules ()
    ;; "chk"
    ((%alambda* "chk" () ((h ...) () () ()) (r ...) ()
		() (() ()) () ("required cat" . e) bd ...)
     (%alambda* "rat" () ((h ...) () () ()) (r ...) () () (() ()) () e bd ...))
    ((%alambda* "chk" () ((h ...) () () ()) (r ...) ()
		() (() ()) () ("required key" . e) bd ...)
     (%alambda* "rey" () ((h ...) () () ()) (r ...) () () (() ()) () e bd ...))
    ((%alambda* "chk" () ((h ...) () () ()) (r ...) ()
		() (() ()) () ("opt" . e) bd ...)
     (%alambda* "opt" () ((h ...) () () ()) (r ...) () () (() ()) () e bd ...))
    ((%alambda* "chk" () ((h ...) () () ()) (r ...) ()
		() (() ()) () ("cat" . e) bd ...)
     (%alambda* "cat" () ((h ...) () () ()) (r ...) () () (() ()) () e bd ...))
    ((%alambda* "chk" () ((h ...) () () ()) (r ...) ()
		() (() ()) () ("key" . e) bd ...)
     (%alambda* "key" () ((h ...) () () ()) (r ...) () () (() ()) () e bd ...))
    ;; "rat"
    ((%alambda* "rat" () ((h ...) (i in ...) () ()) (r ...) (rk ...)
		() (() ()) () ("required key" . e) bd ...)
     (%alambda* "rey" () ((h ...) (i in ...) () ()) (r ...) (rk ...)
		() (() ()) () e bd ...))
    ((%alambda* "rat" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () ("opt" . e) bd ...)
     (%alambda* "opt" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () e bd ...))
    ((%alambda* "rat" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () ("cat" . e) bd ...)
     (%alambda* "cat" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () e bd ...))
    ((%alambda* "rat" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () ("key" . e) bd ...)
     (%alambda* "key" () ((h ...) (i in ...) (j ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () e bd ...))
    ;; "rey"
    ((%alambda* "rey" () ((h ...) () (j jn ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () ("required cat" . e) bd ...)
     (%alambda* "rat" () ((h ...) () (j jn ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () e bd ...))
    ((%alambda* "rey" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () ("opt" . e) bd ...)
     (%alambda* "opt" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () e bd ...))
    ((%alambda* "rey" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () ("cat" . e) bd ...)
     (%alambda* "cat" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () e bd ...))
    ((%alambda* "rey" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () ("key" . e) bd ...)
     (%alambda* "key" () ((h ...) (i ...) (j jn ...) (jk ...)) (r ...) (rk ...)
		() (() ()) () e bd ...))
    ;; "opt"
    ((%alambda* "opt" () hijk (r ...) (rk ...)
		(o on ...) (() ()) () ("cat" . e) bd ...)
     (%alambda* "cat" () hijk (r ...) (rk ...)
		(o on ...) (() ()) () e bd ...))
    ((%alambda* "opt" () hijk (r ...) (rk ...)
		(o on ...) (() ()) () ("key" . e) bd ...)
     (%alambda* "key" () hijk (r ...) (rk ...)
		(o on ...) (() ()) () e bd ...))
    ;; "cat"
    ((%alambda* "cat" () hijk (r ...) (rk ...)
		(o ...) ((c cn ...) ()) (ok ...) ("key" . e) bd ...)
     (%alambda* "key" () hijk (r ...) (rk ...)
		(o ...) ((c cn ...) ()) (ok ...) e bd ...))
    ;; "key"
    ((%alambda* "key" () hijk (r ...) (rk ...)
		(o ...) (() (k kn ...)) (ok ...) ("cat" . e) bd ...)
     (%alambda* "cat" () hijk (r ...) (rk ...)
		(o ...) (() (k kn ...)) (ok ...) e bd ...))
    ;; key option
    ((%alambda* check () ((h ...) (i ...) (j ...) (jk jkn ...)) (r ...)
		(rk ...) (o ...) ((c ...) (k ...)) (ok ...) (#t . e) bd ...)
     (%alambda* check (#t) ((h ...) (i ...) (j ...) (jk jkn ...)) (r ...)
		(rk ...) (o ...) ((c ...) (k ...)) (ok ...) e bd ...))
    ((%alambda* check () ((h ...) (i ...) (j ...) (jk jkn ...)) (r ...)
		(rk ...) (o ...) ((c ...) (k ...)) (ok ...) (#f . e) bd ...)
     (%alambda* check (#f) ((h ...) (i ...) (j ...) (jk jkn ...)) (r ...)
		(rk ...) (o ...) ((c ...) (k ...)) (ok ...) e bd ...))
    ((%alambda* check () hijk (r ...) (rk ...)
		(o ...) ((c ...) (k kn ...)) (ok ...) (#t . e) bd ...)
     (%alambda* check (#t) hijk (r ...) (rk ...)
		(o ...) ((c ...) (k kn ...)) (ok ...) e bd ...))
    ((%alambda* check () hijk (r ...) (rk ...)
		(o ...) ((c ...) (k kn ...)) (ok ...) (#f . e) bd ...)
     (%alambda* check (#f) hijk (r ...) (rk ...)
		(o ...) ((c ...) (k kn ...)) (ok ...) e bd ...))
    ;; required fix arguments
    ((%alambda* "chk" () ((h ...) () () ())
		(r ...) () () (() ()) () ((n t s ...) . e) bd ...)
     (%alambda* "chk" () ((h ... hn) () () ())
		(r ... (n t s ...)) () () (() ()) () e bd ...))
    ((%alambda* "chk" () ((h ...) () () ())
		(r ...) () () (() ()) () (n . e) bd ...)
     (%alambda* "chk" () ((h ... hn) () () ())
		(r ... (n)) () () (() ()) () e bd ...))
    ;; required cat arguments
    ((%alambda* "rat" () ((h ...) (i ...) (j ...) (jk ...))
		(r ...) (rk ...) () (() ()) () ((n t s ...) . e) bd ...)
     (%alambda* "rat" () ((h ...) (i ... in) (j ...) (jk ...))
		(r ...) (rk ... ((n) t s ...)) () (() ()) () e bd ...))
    ((%alambda* "rat" () ((h ...) (i ...) (j ...) (jk ...))
		(r ...) (rk ...) () (() ()) () (n . e) bd ...)
     (%alambda* "rat" () ((h ...) (i ... in) (j ...) (jk ...))
		(r ...) (rk ... ((n))) () (() ()) () e bd ...))
    ;; required key arguments
    ((%alambda* "rey" () ((h ...) (i ...) (j ...) (jk ...))
		(r ...) (rk ...) () (() ()) () (((n key) t ...) . e) bd ...)
     (%alambda* "rey" () ((h ...) (i ...) (j ... jm jn) (jk ... key))
		(r ...) (rk ... ((n key) t ...)) () (() ()) () e bd ...))
    ((%alambda* "rey" () ((h ...) (i ...) (j ...) (jk ...))
		(r ...) (rk ...) () (() ()) () ((n t s ...) . e) bd ...)
     (%alambda* "rey" () ((h ...) (i ...) (j ... jm jn) (jk ... 'n))
		(r ...) (rk ... ((n 'n) t s ...)) () (() ()) () e bd ...))
    ((%alambda* "rey" () ((h ...) (i ...) (j ...) (jk ...))
		(r ...) (rk ...) () (() ()) () (n . e) bd ...)
     (%alambda* "rey" () ((h ...) (i ...) (j ... jm jn) (jk ... 'n))
		(r ...) (rk ... ((n 'n))) () (() ()) () e bd ...))
    ;; optional fix arguments
    ((%alambda* "opt" () hijk (r ...) (rk ...)
		(o ...) (() ()) () ((n d t ...) . e) bd ...)
     (%alambda* "opt" () hijk (r ...) (rk ...)
		(o ... (n d t ...)) (() ()) () e bd ...))
    ((%alambda* "opt" () hijk (r ...) (rk ...)
		(o ...) (() ()) () (n . e) bd ...)
     (%alambda* "opt" () hijk (r ...) (rk ...)
		(o ... (n #f)) (() ()) () e bd ...))
    ;; optional cat arguments
    ((%alambda* "cat" () hijk (r ...) (rk ...) (o ...)
		((c ...) (k ...)) (ok ...) ((n d t ...) . e) bd ...)
     (%alambda* "cat" () hijk (r ...) (rk ...) (o ...)
		((c ... n) (k ...)) (ok ... ((n) d t ...)) e bd ...))
    ((%alambda* "cat" () hijk (r ...) (rk ...) (o ...)
		((c ...) (k ...)) (ok ...) (n . e) bd ...)
     (%alambda* "cat" () hijk (r ...) (rk ...) (o ...)
		((c ... n) (k ...)) (ok ... ((n) #f)) e bd ...))
    ;; optional key arguments
    ((%alambda* "key" () hijk (r ...) (rk ...) (o ...)
		((c ...) (k ...)) (ok ...) (((n key) d t ...) . e) bd ...)
     (%alambda* "key" () hijk (r ...) (rk ...) (o ...)
		((c ...) (k ... key)) (ok ... ((n key) d t ...)) e bd ...))
    ((%alambda* "key" () hijk (r ...) (rk ...) (o ...)
		((c ...) (k ...)) (ok ...) (((n key)) . e) bd ...)
     (%alambda* "key" () hijk (r ...) (rk ...) (o ...)
		((c ...) (k ... key)) (ok ... ((n key) #f)) e bd ...))
    ((%alambda* "key" () hijk (r ...) (rk ...) (o ...)
		((c ...) (k ...)) (ok ...) ((n d t ...) . e) bd ...)
     (%alambda* "key" () hijk (r ...) (rk ...) (o ...)
		((c ...) (k ... 'n)) (ok ... ((n 'n) d t ...)) e bd ...))
    ((%alambda* "key" () hijk (r ...) (rk ...) (o ...)
		((c ...) (k ...)) (ok ...) (n . e) bd ...)
     (%alambda* "key" () hijk (r ...) (rk ...) (o ...)
		((c ...) (k ... 'n)) (ok ... ((n 'n) #f)) e bd ...))
    ;; main 
    ((%alambda* check () ((h ...) () () ()) ((n) ...) () () (()()) () () bd ...)
     (lambda (h ...) (let* ((n h) ...) bd ...)))
    ((%alambda* check () ((h ...) () () ()) ((n) ...) () () (()()) () e bd ...)
     (lambda (h ... . te) (let* ((n h) ... (e te)) bd ...)))
    ((%alambda* check dft ((h ...) (i ...) (j ...) jk)
		((n t ...) ...) (((rn rk ...) rt ...) ...)
		() (() ()) () () bd ...)
     (lambda (h ... i ... j ...)
       (let ((zz (list i ... j ...)))
	 (let* ((n (wow-opt n h t ...)) ...
		(rn (wow-req! zz dft jk (rn rk ...) rt ...)) ...)
	   bd ...))))
    ((%alambda* check dft ((h ...) (i ...) (j ...) jk)
		((n t ...) ...) (((rn rk ...) rt ...) ...)
		() (() ()) () e bd ...)
     (lambda (h ... i ... j ... . te)
       (let ((zz (list i ... j ...)))
	 (let* ((n (wow-opt n h t ...)) ...
		(rn (wow-req! zz dft jk (rn rk ...) rt ...)) ...
		(e te))
	   bd ...))))
    ((%alambda* check dft ((h ...) () () ()) ((n) ...) ()
		(o ...) ((c ...) (k ...)) (ondt ...) e bd ...)
     (lambda (h ... . te)
       (let* ((n h) ...)
	 (check-opt* te dft (o ...) (ondt ...) e (k ...) bd ...))))
    ((%alambda* check dft ((h ...) (i ...) (j ...) jk)
		((n t ...) ...) (((rn rk ...) rt ...) ...)
		(o ...) ((c ...) (k ...)) (ondt ...) e bd ...)
     (lambda (h ... i ... j ... . te)
       (let ((zz (list i ... j ...)))
	 (let* ((n (wow-opt n h t ...)) ...
		(rn (wow-req! zz dft jk (rn rk ...) rt ...)) ...)
	   (check-opt* te dft (o ...) (ondt ...) e (k ...) bd ...)))))))

(define-syntax check-cond
  (syntax-rules ()
    ((check-cond z len (tt ...) (nt ...) (((n t) . e) bd ...) cl ...)
     (check-cond z len (tt ... tn) (nt ... (n t)) (e bd ...) cl ...))
    ((check-cond z len (tt ...) (nt ...) ((n . e) bd ...) cl ...)
     (check-cond z len (tt ... tn) (nt ... (n)) (e bd ...) cl ...))
    ((check-cond z len () () (() bd ...) cl ...)
     (if (= len 0)
         ((lambda () bd ...))
         (check-cond z len () () cl ...)))
    ((check-cond z len () () (e bd ...) cl ...)
     (let ((e z)) bd ...))
    ((check-cond z len (tt ...) ((n) ...) (() bd ...) cl ...)
     (if (= len (length '(tt ...)))
         (apply (lambda (n ...) bd ...) z)
         (check-cond z len () () cl ...)))
    ((check-cond z len (tt ...) ((n t ...) ...) (() bd ...) cl ...)
     (if (and (= len (length '(tt ...)))
	      (apply (lambda (tt ...) (cond-and ((n tt t ...) ...))) z))
	 (apply (lambda (n ...) bd ...) z)
         (check-cond z len () () cl ...)))
    ((check-cond z len (tt ...) ((n) ...) (e bd ...) cl ...)
     (if (>= len (length '(tt ...)))
         (apply (lambda (n ... . e) bd ...) z)
         (check-cond z len () () cl ...)))
    ((check-cond z len (tt ...) ((n t ...) ...) (e bd ...) cl ...)
     (if (and (>= len (length '(tt ...)))
	      (apply (lambda (tt ...) (cond-and ((n tt t ...) ...))) z))
         (apply (lambda (n ... . e) bd ...) z)
         (check-cond z len () () cl ...)))
    ((check-cond z len (tt ...) (nt ...))
     (error "actual arguments are not matched to any clause of alambda" z))))

(define-syntax check-cond*
  (syntax-rules ()
    ((check-cond* z len (tt ...) (nt ...) (((n t) . e) bd ...) cl ...)
     (check-cond* z len (tt ... tn) (nt ... (n t)) (e bd ...) cl ...))
    ((check-cond* z len (tt ...) (nt ...) ((n . e) bd ...) cl ...)
     (check-cond* z len (tt ... tn) (nt ... (n)) (e bd ...) cl ...))
    ((check-cond* z len () () (() bd ...) cl ...)
     (if (= len 0)
         ((lambda () bd ...))
         (check-cond* z len () () cl ...)))
    ((check-cond* z len () () (e bd ...) cl ...)
     (let ((e z)) bd ...))
    ((check-cond* z len (tt ...) ((n) ...) (() bd ...) cl ...)
     (if (= len (length '(tt ...)))
	 (apply (lambda (tt ...) (let* ((n tt) ...) bd ...)) z)
         (check-cond* z len () () cl ...)))
    ((check-cond* z len (tt ...) ((n t ...) ...) (() bd ...) cl ...)
     (if (and (= len (length '(tt ...)))
	      (apply (lambda (tt ...) (cond-and* ((n tt t ...) ...))) z))
	 (apply (lambda (tt ...) (let* ((n tt) ...) bd ...)) z)
         (check-cond* z len () () cl ...)))
    ((check-cond* z len (tt ...) ((n) ...) (e bd ...) cl ...)
     (if (>= len (length '(tt ...)))
	 (apply (lambda (tt ... . te) (let* ((n tt) ... (e te)) bd ...)) z)
         (check-cond* z len () () cl ...)))
    ((check-cond* z len (tt ...) ((n t ...) ...) (e bd ...) cl ...)
     (if (and (>= len (length '(tt ...)))
	      (apply (lambda (tt ...) (cond-and* ((n tt t ...) ...))) z))
	 (apply (lambda (tt ... . te) (let* ((n tt) ... (e te)) bd ...)) z)
         (check-cond* z len () () cl ...)))
    ((check-cond* z len (tt ...) (nt ...))
     (error "actual arguments are not matched to any clause of alambda*" z))))

(define-syntax cond-and
  (syntax-rules ()
    ((cond-and ((n v) nvt ...))
     (cond-and (nvt ...)))
    ((cond-and ((n v t) nvt ...))
     (and (let ((n v)) t) (cond-and (nvt ...))))
    ((cond-and ())
     #t)))

(define-syntax cond-and*
  (syntax-rules ()
    ((cond-and* ((n v) nvt ...))
     (let ((n v))
       (cond-and* (nvt ...))))
    ((cond-and* ((n v t) nvt ...))
     (let ((n v))
       (and t (cond-and* (nvt ...)))))
    ((cond-and* ())
     #t)))

(define-syntax check-opt
  (syntax-rules ()
    ((check-opt z dft (nd ...) ((n d t ...) ndt ...) (nodt ...)
		e (kk ...) bd ...)
     (let ((y (if (null? z) z (cdr z)))
	   (x (if (null? z)
		  d
		  (wow-opt n (car z) t ...))))
       (check-opt y dft (nd ... (n x)) (ndt ...) (nodt ...)
		  e (kk ...) bd ...)))
    ((check-opt z dft (nd ...) () (((n k) d t ...) nodt ...)
		e (kk ...) bd ...)
     (let ((x (if (null? z)
		  d
		  (wow-key! z dft (kk ...) (n k) d t ...))))
       (check-opt z dft (nd ... (n x)) () (nodt ...) e (kk ...) bd ...)))
    ((check-opt z dft (nd ...) () (((n) d t ...) nodt ...) e (kk ...) bd ...)
     (let ((x (if (null? z)
		  d
		  (wow-cat! z n d t ...))))
       (check-opt z dft (nd ... (n x)) () (nodt ...) e (kk ...) bd ...)))
    ((check-opt z dft (nd ...) () () () (kk ...) bd ...)
     (if (null? z)
	 (let (nd ...) bd ...)
	 (error "alambda: too many arguments" z)))
    ((check-opt z dft (nd ...) () () e (kk ...) bd ...)
     (let (nd ... (e z)) bd ...))))

(define-syntax check-opt*
  (syntax-rules ()
    ((check-opt* z dft ((n d t ...) ndt ...) (nodt ...) e (kk ...) bd ...)
     (let ((y (if (null? z) z (cdr z)))
	   (n (if (null? z)
		  d
		  (wow-opt n (car z) t ...))))
       (check-opt* y dft (ndt ...) (nodt ...) e (kk ...) bd ...)))
    ((check-opt* z dft () (((n k) d t ...) nodt ...) e (kk ...) bd ...)
     (let ((n (if (null? z)
		  d
		  (wow-key! z dft (kk ...) (n k) d t ...))))
       (check-opt* z dft () (nodt ...) e (kk ...) bd ...)))
    ((check-opt* z dft () (((n) d t ...) nodt ...) e (kk ...) bd ...)
     (let ((n (if (null? z)
		  d
		  (wow-cat! z n d t ...))))
       (check-opt* z dft () (nodt ...) e (kk ...) bd ...)))
    ((check-opt* z dft () () () (kk ...) bd ...)
     (if (null? z)
	 (let () bd ...)
	 (error "alambda*: too many arguments" z)))
    ((check-opt* z dft () () e (kk ...) bd ...)
     (let ((e z)) bd ...))))

(define-syntax wow-opt
  (syntax-rules ()
    ((wow-opt n v)
     v)
    ((wow-opt n v t)
     (let ((n v))
       (if t n (error "alambda[*]: bad argument" n 'n 't))))
    ((wow-opt n v t ts)
     (let ((n v))
       (if t ts (error "alambda[*]: bad argument" n 'n 't))))
    ((wow-opt n v t ts fs)
     (let ((n v))
       (if t ts fs)))))

(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 "alambda[*]: 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 "alambda[*]: 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 "alambda[*]: 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 "alambda[*]: 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 "alambda[*]: 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 "alambda[*]: 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 "alambda[*]: 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 "alambda[*]: 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 "alambda[*]: 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 "alambda[*]: 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 "alambda[*]: 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 "alambda[*]: 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 wow-req!
  (syntax-rules ()
    ((wow-req! z (ft ...) (kk ...) (n))
     (let ((n (car z)))
       (set! z (cdr z)) n))
    ((wow-req! z () (kk ...) (n key))
     (let ((x (car z))
	   (y (cdr z)))
       (if (equal? key x)
	   (begin (set! z (cdr y)) (car y))
	   (let lp ((head (list (car y) x)) (tail (cdr y)))
	     (if (null? tail)
		 (error "alambda[*]: no corresponding value to key" 
			key (reverse head))
		 (let ((x (car tail))
		       (y (cdr tail)))
		   (if (null? y)
		       (error "alambda[*]: no corresponding value to key" 
			      key (append (reverse head) tail))
		       (if (equal? key x)
			   (begin (set! z (append (reverse head) (cdr y)))
				  (car y))
			   (lp (cons (car y) (cons x head)) (cdr y))))))))))
    ((wow-req! z (#f) (kk ...) (n key))
     (let ((x (car z))
	   (y (cdr z)))
       (if (equal? key x)
	   (begin (set! z (cdr y)) (car y))
	   (let ((lk (list kk ...)))
	     (if (not (member x lk))
		 (error "alambda[*]: no keyword" x lk)
		 (let lp ((head (list (car y) x)) (tail (cdr y)))
		   (if (null? tail)
		       (error "alambda[*]: no corresponding value to key" 
			      key (reverse head))
		       (let ((x (car tail))
			     (y (cdr tail)))
			 (if (null? y)
			     (error "alambda[*]: no corresponding value to key"
				    key (append (reverse head) tail))
			     (if (equal? key x)
				 (begin
				   (set! z (append (reverse head) (cdr y)))
				   (car y))
				 (if (not (member x lk))
				     (error "alambda[*]: no keyword" x lk)
				     (lp (cons (car y) (cons x head))
					 (cdr y)))))))))))))
    ((wow-req! z (#t) (kk ...) (n key))
     (let ((x (car z))
	   (y (cdr z)))
       (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)
		   (error "alambda[*]: no corresponding value to key" 
			  key (reverse head))
		   (let ((x (car tail))
			 (y (cdr tail)))
		     (if (null? y)
			 (error "alambda[*]: no corresponding value to key" 
				key (append (reverse head) tail))
			 (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-req! z (ft ...) (kk ...) (n) t)
     (let ((n (car z)))
       (if t
	   (begin (set! z (cdr z)) n)
	   (let lp ((head (list n)) (tail (cdr z)))
	     (if (null? tail)
		 (error "alambda[*]: bad arguments" (reverse head) 'n 't)
		 (let ((n (car tail)))
		   (if t
		       (begin (set! z (append (reverse head) (cdr tail))) n)
		       (lp (cons n head) (cdr tail)))))))))
    ((wow-req! z () (kk ...) (n key) t)
     (let ((x (car z))
	   (y (cdr z)))
       (if (equal? key x)
	   (let ((n (car y)))
	     (if t
		 (begin (set! z (cdr y)) n)
		 (error "alambda[*]: bad argument" n 'n 't)))
	   (let lp ((head (list (car y) x)) (tail (cdr y)))
	     (if (null? tail)
		 (error "alambda[*]: no corresponding value to key" 
			key (reverse head))
		 (let ((x (car tail))
		       (y (cdr tail)))
		   (if (null? y)
		       (error "alambda[*]: no corresponding value to key" 
			      key (append (reverse head) tail))
		       (if (equal? key x)
			   (let ((n (car y)))
			     (if t
				 (begin (set! z (append (reverse head)
							(cdr y)))
					n)
				 (error "alambda[*]: bad argument" n 'n 't)))
			   (lp (cons (car y) (cons x head)) (cdr y))))))))))
    ((wow-req! z (#f) (kk ...) (n key) t)
     (let ((x (car z))
	   (y (cdr z)))
       (if (equal? key x)
	   (let ((n (car y)))
	     (if t
		 (begin (set! z (cdr y)) n)
		 (error "alambda[*]: bad argument" n 'n 't)))
	   (let ((lk (list kk ...)))
	     (if (not (member x lk))
		 (error "alambda[*]: no keyword" x lk)
		 (let lp ((head (list (car y) x)) (tail (cdr y)))
		   (if (null? tail)
		       (error "alambda[*]: no corresponding value to key" 
			      key (reverse head))
		       (let ((x (car tail))
			     (y (cdr tail)))
			 (if (null? y)
			     (error "alambda[*]: no corresponding value to key"
				    key (append (reverse head) tail))
			     (if (equal? key x)
				 (let ((n (car y)))
				   (if t
				       (begin (set! z (append (reverse head)
							      (cdr y)))
					      n)
				       (error "alambda[*]: bad argument"
					      n 'n 't)))
				 (if (not (member x lk))
				     (error "alambda[*]: no keyword" x lk)
				     (lp (cons (car y) (cons x head))
					 (cdr y)))))))))))))
    ((wow-req! z (#t) (kk ...) (n key) t)
     (let ((x (car z))
	   (y (cdr z)))
       (if (equal? key x)
	   (let ((n (car y)))
	     (if t
		 (begin (set! z (cdr y)) n)
		 (error "alambda[*]: 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)
		   (error "alambda[*]: no corresponding value to key" 
			  key (reverse head))
		   (let ((x (car tail))
			 (y (cdr tail)))
		     (if (null? y)
			 (error "alambda[*]: no corresponding value to key" 
				key (append (reverse head) tail))
			 (if (equal? key x)
			     (let ((n (car y)))
			       (if t
				   (begin (set! z (append (reverse head)
							  (cdr y)))
					  n)
				   (error "alambda[*]: 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-req! z (ft ...) (kk ...) (n) 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)
		 (error "alambda[*]: bad arguments" (reverse head) 'n 't)
		 (let ((n (car tail)))
		   (if t
		       (begin (set! z (append (reverse head) (cdr tail))) ts)
		       (lp (cons n head) (cdr tail)))))))))
    ((wow-req! z () (kk ...) (n key) t ts)
     (let ((x (car z))
	   (y (cdr z)))
       (if (equal? key x)
	   (let ((n (car y)))
	     (if t
		 (begin (set! z (cdr y)) ts)
		 (error "alambda[*]: bad argument" n 'n 't)))
	   (let lp ((head (list (car y) x)) (tail (cdr y)))
	     (if (null? tail)
		 (error "alambda[*]: no corresponding value to key" 
			key (reverse head))
		 (let ((x (car tail))
		       (y (cdr tail)))
		   (if (null? y)
		       (error "alambda[*]: no corresponding value to key" 
			      key (append (reverse head) tail))
		       (if (equal? key x)
			   (let ((n (car y)))
			     (if t
				 (begin (set! z (append (reverse head)
							(cdr y)))
					ts)
				 (error "alambda[*]: bad argument" n 'n 't)))
			   (lp (cons (car y) (cons x head)) (cdr y))))))))))
    ((wow-req! z (#f) (kk ...) (n key) t ts)
     (let ((x (car z))
	   (y (cdr z)))
       (if (equal? key x)
	   (let ((n (car y)))
	     (if t
		 (begin (set! z (cdr y)) ts)
		 (error "alambda[*]: bad argument" n 'n 't)))
	   (let ((lk (list kk ...)))
	     (if (not (member x lk))
		 (error "alambda[*]: no keyword" x lk)
		 (let lp ((head (list (car y) x)) (tail (cdr y)))
		   (if (null? tail)
		       (error "alambda[*]: no corresponding value to key" 
			      key (reverse head))
		       (let ((x (car tail))
			     (y (cdr tail)))
			 (if (null? y)
			     (error "alambda[*]: no corresponding value to key"
				    key (append (reverse head) tail))
			     (if (equal? key x)
				 (let ((n (car y)))
				   (if t
				       (begin (set! z (append (reverse head)
							      (cdr y)))
					      ts)
				       (error "alambda[*]: bad argument"
					      n 'n 't)))
				 (if (not (member x lk))
				     (error "alambda[*]: no keyword" x lk)
				     (lp (cons (car y) (cons x head))
					 (cdr y)))))))))))))
    ((wow-req! z (#t) (kk ...) (n key) t ts)
     (let ((x (car z))
	   (y (cdr z)))
       (if (equal? key x)
	   (let ((n (car y)))
	     (if t
		 (begin (set! z (cdr y)) ts)
		 (error "alambda[*]: 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)
		   (error "alambda[*]: no corresponding value to key" 
			  key (reverse head))
		   (let ((x (car tail))
			 (y (cdr tail)))
		     (if (null? y)
			 (error "alambda[*]: no corresponding value to key" 
				key (append (reverse head) tail))
			 (if (equal? key x)
			     (let ((n (car y)))
			       (if t
				   (begin (set! z (append (reverse head)
							  (cdr y)))
					  ts)
				   (error "alambda[*]: 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-req! z (ft ...) (kk ...) (n) t ts fs)
     (let ((n (car z)))
       (if t
	   (begin (set! z (cdr z)) ts)
	   (begin (set! z (cdr z)) fs))))
    ((wow-req! z () (kk ...) (n key) t ts fs)
     (let ((x (car z))
	   (y (cdr z)))
       (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)
		 (error "alambda[*]: no corresponding value to key" 
			key (reverse head))
		 (let ((x (car tail))
		       (y (cdr tail)))
		   (if (null? y)
		       (error "alambda[*]: no corresponding value to key" 
			      key (append (reverse head) tail))
		       (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-req! z (#f) (kk ...) (n key) t ts fs)
     (let ((x (car z))
	   (y (cdr z)))
       (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))
		 (error "alambda[*]: no keyword" x lk)
		 (let lp ((head (list (car y) x)) (tail (cdr y)))
		   (if (null? tail)
		       (error "alambda[*]: no corresponding value to key" 
			      key (reverse head))
		       (let ((x (car tail))
			     (y (cdr tail)))
			 (if (null? y)
			     (error "alambda[*]: no corresponding value to key"
				    key (append (reverse head) tail))
			     (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))
				     (error "alambda[*]: no keyword" x lk)
				     (lp (cons (car y) (cons x head))
					 (cdr y)))))))))))))
    ((wow-req! z (#t) (kk ...) (n key) t ts fs)
     (let ((x (car z))
	   (y (cdr z)))
       (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)
		   (error "alambda[*]: no corresponding value to key" 
			  key (reverse head))
		   (let ((x (car tail))
			 (y (cdr tail)))
		     (if (null? y)
			 (error "alambda[*]: no corresponding value to key" 
				key (append (reverse head) tail))
			 (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))))))))))))))

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 16]   Lars T Hansen: Syntax for procedures of variable arity.
	    http://srfi.schemers.org/srfi-16/
[SRFI 86]   Joo ChurlSoo: MU and NU simulating VALUES & CALL-WITH-VALUES,
	    and their related LET-syntax.
	    http://srfi.schemers.org/srfi-86/
[SRFI 89]   Marc Feeley: Optional and named parameters.
	    http://srfi.schemers.org/srfi-89/

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.

