;;; SRFI 86: MU and NU simulating VALUES & CALL-WITH-VALUES,
;;; and their related LET-syntax
;;;
;;; $Id$
;;;
;;; 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.

;;; 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 key rec and values)
    ((%alet () ((n v) ...) () bd ...)
     ((lambda (n ...) bd ...) v ...))
    ((%alet (var) ((n v) ...) () bd ...)
     ((letrec ((var (lambda (n ...) bd ...)))
	var) v ...))
    ((%alet (var (p ...) (nv ...) (bn ...)) ((n v) ...) () bd ...)
     ((letrec ((t (lambda (v ...)
		    (%alet (p ...) (nv ... (n v) ... (var t))
			   (bn ...) bd ...))))
	t) v ...))
    ((%alet (p ...) (nv ...) ((() a b ...) bn ...) bd ...)
     ((lambda () a b ... (%alet (p ...) (nv ...) (bn ...) bd ...))))
    ((%alet (p ...) (nv ...) (((a) c) bn ...) bd ...)
     ((lambda (t) (%alet (p ...) (nv ... (a t)) (bn ...) bd ...)) c))

    ((%alet (p ...) (nv ...) (((values a) c) bn ...) bd ...)
     ((lambda (t) (%alet (p ...) (nv ... (a t)) (bn ...) bd ...)) c))
    ((%alet (p ...) (nv ...) (((values . b) c d ...) bn ...) bd ...)
     (%alet "dot" (p ...) (nv ...) (values) (b c d ...) (bn ...) bd ...))
    ((%alet "dot" (p ...) (nv ...) (values t ...) ((a . b) c ...)
	    (bn ...) bd ...)
     (%alet "dot" (p ...) (nv ... (a tn)) (values t ... tn) (b c ...)
	    (bn ...) bd ...))
    ((%alet "dot" (p ...) (nv ...) (values t ...) (() c) (bn ...) bd ...)
     (call-with-values (lambda () c)
       (lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))
    ((%alet "dot" (p ...) (nv ...) (values t ...) (() c ...) (bn ...) bd ...)
     ((lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...)) c ...))
    ((%alet "dot" (p ...) (nv ...) (values t ...) (b c) (bn ...) bd ...)
     (call-with-values (lambda () c)
       (lambda (t ... . tn)
	 (%alet (p ...) (nv ... (b tn)) (bn ...) bd ...))))
    ((%alet "dot" (p ...) (nv ...) (values t ...) (b c ...) (bn ...) bd ...)
     ((lambda (t ... . tn)
	(%alet (p ...) (nv ... (b tn)) (bn ...) bd ...)) c ...))

    ((%alet (p ...) (nv ...) (((a . b) c d ...) bn ...) bd ...)
     (%alet "dot" (p ...) (nv ... (a t)) (t) (b c d ...) (bn ...) bd ...))
    ((%alet "dot" (p ...) (nv ...) (t ...) ((a . b) c ...) (bn ...) bd ...)
     (%alet "dot" (p ...) (nv ... (a tn)) (t ... tn) (b c ...) (bn ...)
	    bd ...))
    ((%alet "dot" (p ...) (nv ...) (t ...) (() c) (bn ...) bd ...)
     (c (lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))
    ((%alet "dot" (p ...) (nv ...) (t ...) (() c ...) (bn ...) bd ...)
     ((lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...)) c ...))
    ((%alet "dot" (p ...) (nv ...) (t ...) (b c) (bn ...) bd ...)
     (c (lambda (t ... . tn) (%alet (p ...) (nv ... (b tn)) (bn ...) bd ...))))
    ((%alet "dot" (p ...) (nv ...) (t ...) (b c ...) (bn ...) bd ...)
     ((lambda (t ... . tn)
	(%alet (p ...) (nv ... (b tn)) (bn ...) bd ...)) c ...))

    ((%alet (p ...) (nv ...) ((and (n1 v1 t1 ...) (n2 v2 t2 ...) ...) bn ...)
	    bd ...)
     (%alet "and" (p ...) (nv ...) ((n1 v1 t1 ...) (n2 v2 t2 ...) ...) (bn ...)
	    bd ...))
    ((%alet "and" (p ...) (nv ...) ((n v) nvt ...) (bn ...) bd ...)
     (let ((t v))
       (and t (%alet "and" (p ...) (nv ... (n t)) (nvt ...) (bn ...) bd ...))))
    ((%alet "and" (p ...) (nv ...) ((n v t) nvt ...) (bn ...) bd ...)
     (let ((tt v))
       (and (let ((n tt)) t)
	    (%alet "and" (p ...) (nv ... (n tt)) (nvt ...) (bn ...) bd ...)))) 
    ((%alet "and" (p ...) (nv ...) () (bn ...) bd ...)
     (%alet (p ...) (nv ...) (bn ...) bd ...))
    ((%alet (p ...) (nv ...) ((opt z a . e) bn ...) bd ...)
     (%alet "opt" (p ...) (nv ...) z (a . e) (bn ...) bd ...))
    ((%alet "opt" (p ...) (nv ...) z ((n d t ...)) (bn ...) bd ...)
     (let ((x (if (null? z)
		  d
		  (if (null? (cdr z))
		      (wow-opt n (car z) t ...)
		      (error "alet: too many arguments" (cdr z))))))
       (%alet (p ...) (nv ... (n x)) (bn ...) bd ...)))
    ((%alet "opt" (p ...) (nv ...) z ((n d t ...) . e) (bn ...) bd ...)
     (let ((y (if (null? z) z (cdr z)))
	   (x (if (null? z)
		  d
		  (wow-opt n (car z) t ...))))
       (%alet "opt" (p ...) (nv ... (n x)) y e (bn ...) bd ...)))
    ((%alet "opt" (p ...) (nv ...) z e (bn ...) bd ...)
     (let ((te z))
       (%alet (p ...) (nv ... (e te)) (bn ...) bd ...)))
    ((%alet (p ...) (nv ...) ((cat z a . e) bn ...) bd ...)
     (let ((y z))
       (%alet "cat" (p ...) (nv ...) y (a . e) (bn ...) bd ...)))
    ((%alet "cat" (p ...) (nv ...) z ((n d t ...)) (bn ...) bd ...)
     (let ((x (if (null? z)
		  d
		  (if (null? (cdr z))
		      (wow-cat-end z n t ...)
		      (error "alet: too many arguments" (cdr z))))))
       (%alet (p ...) (nv ... (n x)) (bn ...) bd ...)))
    ((%alet "cat" (p ...) (nv ...) z ((n d t ...) . e) (bn ...) bd ...)
     (let ((x (if (null? z)
		  d
		  (wow-cat! z n d t ...))))
       (%alet "cat" (p ...) (nv ... (n x)) z e (bn ...) bd ...)))
    ((%alet "cat" (p ...) (nv ...) z e (bn ...) bd ...)
     (let ((te z))
       (%alet (p ...) (nv ... (e te)) (bn ...) bd ...)))
    ((%alet (p ...) (nv ...) ((key z a . e) bn ...) bd ...)
     (let ((y z))
       (%alet "key" (p ...) (nv ...) y () () (a . e) () (bn ...) bd ...)))
    ((%alet "key" (p ...) (nv ...) z ()
	    (ndt ...) (((n k) d t ...) . e) (kk ...) (bn ...) bd ...)
     (%alet "key" (p ...) (nv ...) z ()
	    (ndt ... ((n k) d t ...)) e (kk ... k) (bn ...) bd ...))
    ((%alet "key" (p ...) (nv ...) z ()
	    (ndt ...) ((n d t ...) . e) (kk ...) (bn ...) bd ...)
     (%alet "key" (p ...) (nv ...) z ()
	    (ndt ... ((n 'n) d t ...)) e (kk ... 'n) (bn ...) bd ...))
    ((%alet "key" (p ...) (nv ...) z ()
	    (ndt nd ...) (#t . e) (kk k ...) (bn ...) bd ...)
     (%alet "key" (p ...) (nv ...) z (#t)
	    (ndt nd ...) e (kk k ...) (bn ...) bd ...))
    ((%alet "key" (p ...) (nv ...) z ()
	    (ndt nd ...) (#f . e) (kk k ...) (bn ...) bd ...)
     (%alet "key" (p ...) (nv ...) z (#f)
	    (ndt nd ...) e (kk k ...) (bn ...) bd ...))
    ((%alet "key" (p ...) (nv ...) z (o ...)
	    (((n k) d t ...) ndt ...) e (kk ...) (bn ...) bd ...)
     (let ((x (if (null? z)
		  d
		  (wow-key! z (o ...) (kk ...) (n k) d t ...))))
       (%alet "key" (p ...) (nv ... (n x)) z (o ...)
	      (ndt ...) e (kk ...) (bn ...) bd ...)))
    ((%alet "key" (p ...) (nv ...) z (o ...) () () (kk ...) (bn ...) bd ...)
     (if (null? z)
	 (%alet (p ...) (nv ...) (bn ...) bd ...)
	 (error "alet: too many arguments" z)))
    ((%alet "key" (p ...) (nv ...) z (o ...) () e (kk ...) (bn ...) bd ...)
     (let ((te z)) (%alet (p ...) (nv ... (e te)) (bn ...) bd ...)))
    ((%alet (p ...) (nv ...) ((rec (n v) (nn vv) ...) bn ...) bd ...)
     (%alet "rec" (p ...) (nv ... (n t)) ((n v t))
	    ((nn vv) ...) (bn ...) bd ...))
    ((%alet "rec" (p ...) (nv ...) (nvt ...) ((n v) (nn vv) ...)
	    (bn ...) bd ...)
     (%alet "rec" (p ...) (nv ... (n t)) (nvt ... (n v t)) ((nn vv) ...)
	    (bn ...) bd ...))
    ((%alet "rec" (p ...) (nv ...) ((n v t) ...) () (bn ...) bd ...)
     ((let ((n '<undefined>) ...)
	(let ((t v) ...)
	  (set! n t) ...
	  (mu n ...)))
      (lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))

    ((%alet (p ...) (nv ...) ((a b) bn ...) bd ...)
     ((lambda (t) (%alet (p ...) (nv ... (a t)) (bn ...) bd ...)) b))

    ((%alet (p ...) (nv ...) ((values a c) bn ...) bd ...)
     ((lambda (t) (%alet (p ...) (nv ... (a t)) (bn ...) bd ...)) c))
    ((%alet (p ...) (nv ...) ((values a b c ...) bn ...) bd ...)
     (%alet "not" (p ...) (nv ... (a t)) (values t) (b c ...) (bn ...) bd ...))
    ((%alet "not" (p ...) (nv ...) (values t ...) (a b c ...) (bn ...) bd ...)
     (%alet "not" (p ...) (nv ... (a tn)) (values t ... tn) (b c ...)
	    (bn ...) bd ...))
    ((%alet "not" (p ...) (nv ...) (values t ...) (z) (bn ...) bd ...)
     (call-with-values (lambda () z)
       (lambda (t ...) (%alet (p ...) (nv ...) (bn ...) bd ...))))

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

;;; alet*
(define-syntax alet*
  (syntax-rules (opt cat key rec and values)
    ((alet* () bd ...)
     ((lambda () bd ...)))
    ((alet* ((() a b ...) bn ...) bd ...)
     ((lambda () a b ... (alet* (bn ...) bd ...))))
    ((alet* (((a) c) bn ...) bd ...)
     ((lambda (a) (alet* (bn ...) bd ...)) c))

    ((alet* (((values a) c) bn ...)  bd ...)
     ((lambda (a) (alet* (bn ...) bd ...)) c))

    ((alet* (((values . b) c) bn ...)  bd ...)
     (call-with-values (lambda () c)
       (lambda* b (alet* (bn ...) bd ...))))
    ((alet* (((values . b) c d ...) bn ...) bd ...)
     (alet* "dot" (b c d ...) (bn ...) bd ...))
    ((alet* "dot" ((a . b) c d ...) (bn ...) bd ...)
     ((lambda (a) (alet* "dot" (b d ...) (bn ...) bd ...)) c))
    ((alet* "dot" (()) (bn ...) bd ...)
     (alet* (bn ...) bd ...))
    ((alet* "dot" (b c ...) (bn ...) bd ...)
     ((lambda b (alet* (bn ...) bd ...)) c ...))
    
    ((alet* (((a . b) c) bn ...)  bd ...)
     (c (lambda* (a . b) (alet* (bn ...) bd ...))))
    ((alet* (((a . b) c d ...) bn ...) bd ...)
     ((lambda (a) (alet* "dot" (b d ...) (bn ...) bd ...)) c))

    ((alet* ((and (n1 v1 t1 ...) (n2 v2 t2 ...) ...) bn ...) bd ...)
     (alet-and* ((n1 v1 t1 ...) (n2 v2 t2 ...) ...) (alet* (bn ...) bd ...)))
    ((alet* ((opt z a . e) bn ...) bd ...)
     (%alet-opt* z (a . e) (alet* (bn ...) bd ...)))
    ((alet* ((cat z a . e) bn ...)  bd ...)
     (let ((y z))
       (%alet-cat* y (a . e) (alet* (bn ...) bd ...))))
    ((alet* ((key z a . e) bn ...)  bd ...)
     (let ((y z))
       (%alet-key* y () () (a . e) () (alet* (bn ...) bd ...))))
    ((alet* ((rec (n1 v1) (n2 v2) ...) bn ...) bd ...)
     (alet-rec* ((n1 v1) (n2 v2) ...) (alet* (bn ...) bd ...)))

    ((alet* ((a b) bn ...) bd ...)
     ((lambda (a) (alet* (bn ...) bd ...)) b))

    ((alet* ((values a c) bn ...) bd ...)
     ((lambda (a) (alet* (bn ...) bd ...)) c))
    ((alet* ((values a b c ...) bn ...) bd ...)
     (alet* "not" (values a) (b c ...) (bn ...) bd ...))
    ((alet* "not" (values r ...) (a b c ...) (bn ...) bd ...)
     (alet* "not" (values r ... a) (b c ...) (bn ...) bd ...))
    ((alet* "not" (values r ...) (z) (bn ...) bd ...)
     (call-with-values (lambda () z)
       (lambda* (r ...) (alet* (bn ...) bd ...))))

    ((alet* ((a b c ...) bn ...) bd ...)
     (alet* "not" (a) (b c ...) (bn ...) bd ...))
    ((alet* "not" (r ...) (a b c ...) (bn ...) bd ...)
     (alet* "not" (r ... a) (b c ...) (bn ...) bd ...))
    ((alet* "not" (r ...) (z) (bn ...) bd ...)
     (z (lambda* (r ...) (alet* (bn ...) bd ...))))
    ((alet* ((a) bn ...) bd ...)
     (call-with-current-continuation (lambda (a) (alet* (bn ...)  bd ...))))
    ((alet* ((a . b) bn ...) bd ...)
     (%alet* () () ((a . b) bn ...) bd ...))
    ((alet* (a b bn ...) bd ...)
     (b (lambda a (alet* (bn ...) bd ...))))
    ((alet* var (bn ...) bd ...)
     (%alet* (var) () (bn ...) bd ...))))

(define-syntax %alet*
  (syntax-rules (opt cat key rec and values)
    ((%alet* (var) (n ...) () bd ...)
     ((letrec ((var (lambda* (n ...) bd ...)))
	var) n ...))
    ((%alet* (var (bn ...)) (n ...) ()  bd ...)
     ((letrec ((var (lambda* (n ...) (alet* (bn ...) bd ...))))
	var) n ...))
    ((%alet* (var (p ...) (nn ...) (bn ...)) (n ...) ()  bd ...)
     ((letrec ((var (lambda* (n ...)
			     (%alet* (p ...) (nn ... n ... var) (bn ...)
				     bd ...))))
	var) n ...))
    ((%alet* (p ...) (n ...) ((() a b ...) bn ...) bd ...)
     ((lambda () a b ... (%alet* (p ...) (n ...) (bn ...) bd ...))))
    ((%alet* (p ...) (n ...) (((a) c) bn ...) bd ...)
     ((lambda (a) (%alet* (p ...) (n ... a) (bn ...) bd ...)) c))

    ((%alet* (p ...) (n ...) (((values a) c) bn ...) bd ...)
     ((lambda (a) (%alet* (p ...) (n ... a) (bn ...) bd ...)) c))

    ((%alet* (p ...) (n ...) (((values . b) c) bn ...) bd ...)
     (%alet* "one" (p ...) (n ...) (values) (b c) (bn ...) bd ...))
    ((%alet* "one" (p ...) (n ...) (values r ...) ((a . b) c) (bn ...) bd ...)
     (%alet* "one" (p ...) (n ... a) (values r ... a) (b c) (bn ...) bd ...))
    ((%alet* "one" (p ...) (n ...) (values r ...) (() c) (bn ...) bd ...)
     (call-with-values (lambda () c)
       (lambda* (r ...) (%alet* (p ...) (n ...) (bn ...) bd ...))))
    ((%alet* "one" (p ...) (n ...) (values r ...) (b c) (bn ...) bd ...)
     (call-with-values (lambda () c)
       (lambda* (r ... . b) (%alet* (p ...) (n ... b) (bn ...) bd ...))))

    ((%alet* (p ...) (n ...) (((values . b) c d ...) bn ...) bd ...)
     (%alet* "dot" (p ...) (n ...) (b c d ...) (bn ...) bd ...))

    ((%alet* (p ...) (n ...) (((a . b) c) bn ...) bd ...)
     (%alet* "one" (p ...) (n ... a) (a) (b c) (bn ...) bd ...))
    ((%alet* "one" (p ...) (n ...) (r ...) ((a . b) c) (bn ...) bd ...)
     (%alet* "one" (p ...) (n ... a) (r ... a) (b c) (bn ...) bd ...))
    ((%alet* "one" (p ...) (n ...) (r ...) (() c) (bn ...) bd ...)
     (c (lambda* (r ...) (%alet* (p ...) (n ...) (bn ...) bd ...))))
    ((%alet* "one" (p ...) (n ...) (r ...) (b c) (bn ...) bd ...)
     (c (lambda* (r ... . b) (%alet* (p ...) (n ... b) (bn ...) bd ...))))

    ((%alet* (p ...) (n ...) (((a . b) c d ...) bn ...) bd ...)
     ((lambda (a)
	(%alet* "dot" (p ...) (n ... a) (b d ...) (bn ...) bd ...)) c))
    ((%alet* "dot" (p ...) (n ...) ((a . b) c d ...) (bn ...) bd ...)
     ((lambda (a)
	(%alet* "dot" (p ...) (n ... a) (b d ...) (bn ...) bd ...)) c))
    ((%alet* "dot" (p ...) (n ...) (()) (bn ...) bd ...)
     (%alet* (p ...) (n ...) (bn ...) bd ...))
    ((%alet* "dot" (p ...) (n ...) (b c ...) (bn ...) bd ...)
     ((lambda b (%alet* (p ...) (n ... b) (bn ...) bd ...)) c ...))

    ((%alet* (p ...) (n ...) ((and (n1 v1 t1 ...) (n2 v2 t2 ...) ...) bn ...)
	     bd ...)
     (alet-and* ((n1 v1 t1 ...) (n2 v2 t2 ...) ...)
		(%alet* (p ...) (n ... n1 n2 ...) (bn ...) bd ...)))
    ((%alet* (p ...) (n ...) ((opt z a . e) bn ...) bd ...)
     (%alet* "opt" (p ...) (n ...) z (a . e) (bn ...) bd ...))
    ((%alet* "opt" (p ...) (nn ...) z ((n d t ...)) (bn ...) bd ...)
     (let ((n (if (null? z)
		  d
		  (if (null? (cdr z))
		      (wow-opt n (car z) t ...)
		      (error "alet*: too many arguments" (cdr z))))))
       (%alet* (p ...) (nn ... n) (bn ...) bd ...)))
    ((%alet* "opt" (p ...) (nn ...) z ((n d t ...) . e) (bn ...) bd ...)
     (let ((y (if (null? z) z (cdr z)))
	   (n (if (null? z)
		  d
		  (wow-opt n (car z) t ...))))
       (%alet* "opt" (p ...) (nn ... n) y e (bn ...) bd ...)))
    ((%alet* "opt" (p ...) (nn ...) z e (bn ...) bd ...)
     (let ((e z))
       (%alet* (p ...) (nn ... e) (bn ...) bd ...)))
    ((%alet* (p ...) (nn ...) ((cat z a . e) bn ...) bd ...)
     (let ((y z))
       (%alet* "cat" (p ...) (nn ...) y (a . e) (bn ...) bd ...)))
    ((%alet* "cat" (p ...) (nn ...) z ((n d t ...)) (bn ...) bd ...)
     (let ((n (if (null? z)
		  d
		  (if (null? (cdr z))
		      (wow-cat-end z n t ...)
		      (error "alet*: too many arguments" (cdr z))))))
       (%alet* (p ...) (nn ... n) (bn ...) bd ...)))
    ((%alet* "cat" (p ...) (nn ...) z ((n d t ...) . e) (bn ...) bd ...)
     (let ((n (if (null? z)
		  d
		  (wow-cat! z n d t ...))))
       (%alet* "cat" (p ...) (nn ... n) z e (bn ...) bd ...)))
    ((%alet* "cat" (p ...) (nn ...) z e (bn ...) bd ...)
     (let ((e z))
       (%alet* (p ...) (nn ... e) (bn ...) bd ...)))
    ((%alet* (p ...) (m ...) ((key z a . e) bn ...) bd ...)
     (let ((y z))
       (%alet* "key" (p ...) (m ...) y () () (a . e) () (bn ...) bd ...)))
    ((%alet* "key" (p ...) (m ...) z ()
	     (ndt ...) (((n k) d t ...) . e) (kk ...) (bn ...) bd ...)
     (%alet* "key" (p ...) (m ...) z ()
	     (ndt ... ((n k) d t ...)) e (kk ... k) (bn ...) bd ...))
    ((%alet* "key" (p ...) (m ...) z ()
	     (ndt ...) ((n d t ...) . e) (kk ...) (bn ...) bd ...)
     (%alet* "key" (p ...) (m ...) z ()
	     (ndt ... ((n 'n) d t ...)) e (kk ... 'n) (bn ...) bd ...))
    ((%alet* "key" (p ...) (m ...) z ()
	     (ndt nd ...) (#t . e) (kk k ...) (bn ...) bd ...)
     (%alet* "key" (p ...) (m ...) z (#t)
	     (ndt nd ...) e (kk k ...) (bn ...) bd ...))
    ((%alet* "key" (p ...) (m ...) z ()
	     (ndt nd ...) (#f . e) (kk k ...) (bn ...) bd ...)
     (%alet* "key" (p ...) (m ...) z (#f)
	     (ndt nd ...) e (kk k ...) (bn ...) bd ...))
    ((%alet* "key" (p ...) (m ...) z (o ...)
	     (((n k) d t ...) ndt ...) e (kk ...) (bn ...) bd ...)
     (let ((n (if (null? z)
		  d
		  (wow-key! z (o ...) (kk ...) (n k) d t ...))))
       (%alet* "key" (p ...) (m ... n) z (o ...)
	       (ndt ...) e (kk ...) (bn ...) bd ...)))
    ((%alet* "key" (p ...) (m ...) z (o ...) () () (kk ...) (bn ...) bd ...)
     (if (null? z)
	 (%alet* (p ...) (m ...) (bn ...) bd ...)
	 (error "alet*: too many arguments" z)))
    ((%alet* "key" (p ...) (m ...) z (o ...) () e (kk ...) (bn ...) bd ...)
     (let ((e z)) (%alet* (p ...) (m ... e) (bn ...) bd ...)))
    ((%alet* (p ...) (n ...) ((rec (n1 v1) (n2 v2) ...) bn ...) bd ...)
     (alet-rec* ((n1 v1) (n2 v2) ...)
		(%alet* (p ...) (n ... n1 n2 ...) (bn ...) bd ...)))

    ((%alet* (p ...) (n ...) ((a b) bn ...) bd ...)
     ((lambda (a) (%alet* (p ...) (n ... a) (bn ...) bd ...)) b))

    ((%alet* (p ...) (n ...) ((values a c) bn ...) bd ...)
     ((lambda (a) (%alet* (p ...) (n ... a) (bn ...) bd ...)) c))
    ((%alet* (p ...) (n ...) ((values a b c ...) bn ...) bd ...)
     (%alet* "not" (p ...) (n ... a) (values a) (b c ...) (bn ...) bd ...))
    ((%alet* "not" (p ...) (n ...) (values r ...) (a b c ...) (bn ...) bd ...)
     (%alet* "not" (p ...) (n ... a) (values r ... a) (b c ...) (bn ...)
	     bd ...))
    ((%alet* "not" (p ...) (n ...) (values r ...) (z) (bn ...) bd ...)
     (call-with-values (lambda () z)
       (lambda* (r ...) (%alet* (p ...) (n ...) (bn ...) bd ...))))

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

;;; auxiliaries
(define-syntax lambda*
  (syntax-rules ()
    ((lambda* (a . e) bd ...)
     (lambda* "star" (ta) (a) e bd ...))
    ((lambda* "star" (t ...) (n ...) (a . e) bd ...)
     (lambda* "star" (t ... ta) (n ... a) e bd ...))
    ((lambda* "star" (t ...) (n ...) () bd ...)
     (lambda (t ...)
       (let* ((n t) ...) bd ...)))
    ((lambda* "star" (t ...) (n ...) e bd ...)
     (lambda (t ... . te)
       (let* ((n t) ... (e te)) bd ...)))
    ((lambda* e bd ...)
     (lambda e bd ...))))

(define-syntax alet-and
  (syntax-rules ()
    ((alet-and ((n v t ...) ...) bd ...)
     (alet-and "and" () ((n v t ...) ...) bd ...))
    ((alet-and "and" (nt ...) ((n v) nvt ...) bd ...)
     (let ((t v))
       (and t (alet-and "and" (nt ... (n t)) (nvt ...) bd ...))))
    ((alet-and "and" (nt ...) ((n v t) nvt ...) bd ...)
     (let ((tt v))
       (and (let ((n tt)) t)
	    (alet-and "and" (nt ... (n tt)) (nvt ...) bd ...))))
    ((alet-and "and" ((n t) ...) () bd ...)
     ((lambda (n ...) bd ...) t ...))))

(define-syntax alet-and*
  (syntax-rules ()
    ((alet-and* () bd ...)
     ((lambda () bd ...)))
    ((alet-and* ((n v) nvt ...) bd ...)
     (let ((n v))
       (and n (alet-and* (nvt ...) bd ...))))
    ((alet-and* ((n v t) nvt ...) bd ...)
     (let ((n v))
       (and t (alet-and* (nvt ...) bd ...))))))

(define-syntax alet-rec
  (syntax-rules ()
    ((alet-rec ((n v) ...) bd ...)
     (alet-rec "rec" () ((n v) ...) bd ...))
    ((alet-rec "rec" (nvt ...) ((n v) nv ...) bd ...)
     (alet-rec "rec" (nvt ... (n v t)) (nv ...) bd ...))
    ((alet-rec "rec" ((n v t) ...) () bd ...)
     (let ((n '<undefined>) ...)
       (let ((t v) ...)
	 (set! n t) ...
	 ;;(let ()
	 ;;  bd ...))))))
	 bd ...)))))

(define-syntax alet-rec*
  (syntax-rules ()
    ((alet-rec* ((n v) ...) bd ...)
     (let* ((n '<undefined>) ...)
       (set! n v) ...
       ;;(let ()
       ;; bd ...)))))
       bd ...))))

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

(define-syntax wow-opt!
  (syntax-rules ()
    ((wow-opt! z n)
     (let ((n (car z)))
       (set! z (cdr z))
       n))
    ((wow-opt! z n t)
     (let ((n (car z)))
       (if t
	   (begin (set! z (cdr z)) n)
	   (error "alet[*]: bad argument" n 'n 't))))
    ((wow-opt! z n t ts)
     (let ((n (car z)))
       (if t
	   (begin (set! z (cdr z)) ts)
	   (error "alet[*]: bad argument" n 'n 't))))
    ((wow-opt! z n t ts fs)
     (let ((n (car z)))
       (if t
	   (begin (set! z (cdr z)) ts)
	   (begin (set! z (cdr z)) fs))))))

(define-syntax wow-cat-end
  (syntax-rules ()
    ((wow-cat-end z n)
     (car z))
    ((wow-cat-end z n t)
     (let ((n (car z)))
       (if t n (error "alet[*]: too many argument" z))))
    ((wow-cat-end z n t ts)
     (let ((n (car z)))
       (if t ts (error "alet[*]: too many argument" z))))
    ((wow-cat-end z n t ts fs)
     (let ((n (car z)))
       (if t ts fs)))))

(define-syntax wow-cat
  (syntax-rules ()
    ((wow-cat z n d)
     z)
    ((wow-cat z n d t)
     (let ((n (car z)))
       (if t
	   z
	   (let lp ((head (list n)) (tail (cdr z)))
	     (if (null? tail)
		 (cons d z)
		 (let ((n (car tail)))
		   (if t
		       (cons n (append (reverse head) (cdr tail)))
		       (lp (cons n head) (cdr tail)))))))))
    ((wow-cat z n d t ts)
     (let ((n (car z)))
       (if t
	   (cons ts (cdr z))
	   (let lp ((head (list n)) (tail (cdr z)))
	     (if (null? tail)
		 (cons d z)
		 (let ((n (car tail)))
		   (if t
		       (cons ts (append (reverse head) (cdr tail)))
		       (lp (cons n head) (cdr tail)))))))))
    ((wow-cat z n d t ts fs)
     (let ((n (car z)))
       (if t
	   (cons ts (cdr z))
	   (cons fs (cdr z)))))))

(define-syntax wow-cat!
  (syntax-rules ()
    ((wow-cat! z n d)
     (let ((n (car z)))
       (set! z (cdr z))
       n))
    ((wow-cat! z n d t)
     (let ((n (car z)))
       (if t
	   (begin (set! z (cdr z)) n)
	   (let lp ((head (list n)) (tail (cdr z)))
	     (if (null? tail)
		 d
		 (let ((n (car tail)))
		   (if t
		       (begin (set! z (append (reverse head) (cdr tail))) n)
		       (lp (cons n head) (cdr tail)))))))))
    ((wow-cat! z n d t ts)
     (let ((n (car z)))
       (if t
	   (begin (set! z (cdr z)) ts)
	   (let lp ((head (list n)) (tail (cdr z)))
	     (if (null? tail)
		 d
		 (let ((n (car tail)))
		   (if t
		       (begin (set! z (append (reverse head) (cdr tail))) ts)
		       (lp (cons n head) (cdr tail)))))))))
    ((wow-cat! z n d t ts fs)
     (let ((n (car z)))
       (if t
	   (begin (set! z (cdr z)) ts)
	   (begin (set! z (cdr z)) fs))))))

(define-syntax wow-key!
  (syntax-rules ()
    ((wow-key! z () (kk ...) (n key) d)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (begin (set! z (cdr y)) (car y))
	       (let lp ((head (list (car y) x)) (tail (cdr y)))
		 (if (null? tail)
		     d
		     (let ((x (car tail))
			   (y (cdr tail)))
		       (if (null? y)
			   d
			   (if (equal? key x)
			       (begin (set! z (append (reverse head) (cdr y)))
				      (car y))
			       (lp (cons (car y) (cons x head))
				   (cdr y)))))))))))
    ((wow-key! z (#f) (kk ...) (n key) d)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (begin (set! z (cdr y)) (car y))
	       (let ((lk (list kk ...)))
		 (if (not (member x lk))
		     d
		     (let lp ((head (list (car y) x)) (tail (cdr y)))
		       (if (null? tail)
			   d
			   (let ((x (car tail))
				 (y (cdr tail)))
			     (if (null? y)
				 d
				 (if (equal? key x)
				     (begin (set! z (append (reverse head)
							    (cdr y)))
					    (car y))
				     (if (not (member x lk))
					 d
					 (lp (cons (car y) (cons x head))
					     (cdr y))))))))))))))
    ((wow-key! z (#t) (kk ...) (n key) d)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (begin (set! z (cdr y)) (car y))
	       (let* ((lk (list kk ...))
		      (m (member x lk)))
		 (let lp ((head (if m (list (car y) x) (list x)))
			  (tail (if m (cdr y) y)))
		   (if (null? tail)
		       d
		       (let ((x (car tail))
			     (y (cdr tail)))
			 (if (null? y)
			     d
			     (if (equal? key x)
				 (begin (set! z (append (reverse head)
							(cdr y)))
					(car y))
				 (let ((m (member x lk)))
				   (lp (if m
					   (cons (car y) (cons x head))
					   (cons x head))
				       (if m (cdr y) y)))))))))))))
    ((wow-key! z () (kk ...) (n key) d t)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (let ((n (car y)))
		 (if t
		     (begin (set! z (cdr y)) n)
		     (error "alet[*]: bad argument" n 'n 't)))
	       (let lp ((head (list (car y) x)) (tail (cdr y)))
		 (if (null? tail)
		     d
		     (let ((x (car tail))
			   (y (cdr tail)))
		       (if (null? y)
			   d
			   (if (equal? key x)
			       (let ((n (car y)))
				 (if t
				     (begin (set! z (append (reverse head)
							    (cdr y)))
					    n)
				     (error "alet[*]: bad argument"
					    n 'n 't)))
			       (lp (cons (car y) (cons x head))
				   (cdr y)))))))))))
    ((wow-key! z (#f) (kk ...) (n key) d t)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (let ((n (car y)))
		 (if t
		     (begin (set! z (cdr y)) n)
		     (error "alet[*]: bad argument" n 'n 't)))
	       (let ((lk (list kk ...)))
		 (if (not (member x lk))
		     d
		     (let lp ((head (list (car y) x)) (tail (cdr y)))
		       (if (null? tail)
			   d
			   (let ((x (car tail))
				 (y (cdr tail)))
			     (if (null? y)
				 d
				 (if (equal? key x)
				     (let ((n (car y)))
				       (if t
					   (begin
					     (set! z (append (reverse head)
							     (cdr y)))
					     n)
					   (error "alet[*]: bad argument"
						  n 'n 't)))
				     (if (not (member x lk))
					 d
					 (lp (cons (car y) (cons x head))
					     (cdr y))))))))))))))
    ((wow-key! z (#t) (kk ...) (n key) d t)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (let ((n (car y)))
		 (if t
		     (begin (set! z (cdr y)) n)
		     (error "alet[*]: bad argument" n 'n 't)))
	       (let* ((lk (list kk ...))
		      (m (member x lk)))
		 (let lp ((head (if m (list (car y) x) (list x)))
			  (tail (if m (cdr y) y)))
		   (if (null? tail)
		       d
		       (let ((x (car tail))
			     (y (cdr tail)))
			 (if (null? y)
			     d
			     (if (equal? key x)
				 (let ((n (car y)))
				   (if t
				       (begin (set! z (append (reverse head)
							      (cdr y)))
					      n)
				       (error "alet[*]: bad argument"
					      n 'n 't)))
				 (let ((m (member x lk)))
				   (lp (if m
					   (cons (car y) (cons x head))
					   (cons x head))
				       (if m (cdr y) y)))))))))))))
    ((wow-key! z () (kk ...) (n key) d t ts)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (let ((n (car y)))
		 (if t
		     (begin (set! z (cdr y)) ts)
		     (error "alet[*]: bad argument" n 'n 't)))
	       (let lp ((head (list (car y) x)) (tail (cdr y)))
		 (if (null? tail)
		     d
		     (let ((x (car tail))
			   (y (cdr tail)))
		       (if (null? y)
			   d
			   (if (equal? key x)
			       (let ((n (car y)))
				 (if t
				     (begin (set! z (append (reverse head)
							    (cdr y)))
					    ts)
				     (error "alet[*]: bad argument"
					    n 'n 't)))
			       (lp (cons (car y) (cons x head))
				   (cdr y)))))))))))
    ((wow-key! z (#f) (kk ...) (n key) d t ts)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (let ((n (car y)))
		 (if t
		     (begin (set! z (cdr y)) ts)
		     (error "alet[*]: bad argument" n 'n 't)))
	       (let ((lk (list kk ...)))
		 (if (not (member x lk))
		     d
		     (let lp ((head (list (car y) x)) (tail (cdr y)))
		       (if (null? tail)
			   d
			   (let ((x (car tail))
				 (y (cdr tail)))
			     (if (null? y)
				 d
				 (if (equal? key x)
				     (let ((n (car y)))
				       (if t
					   (begin
					     (set! z (append (reverse head)
							     (cdr y)))
					     ts)
					   (error "alet[*]: bad argument"
						  n 'n 't)))
				     (if (not (member x lk))
					 d
					 (lp (cons (car y) (cons x head))
					     (cdr y))))))))))))))
    ((wow-key! z (#t) (kk ...) (n key) d t ts)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (let ((n (car y)))
		 (if t
		     (begin (set! z (cdr y)) ts)
		     (error "alet[*]: bad argument" n 'n 't)))
	       (let* ((lk (list kk ...))
		      (m (member x lk)))
		 (let lp ((head (if m (list (car y) x) (list x)))
			  (tail (if m (cdr y) y)))
		   (if (null? tail)
		       d
		       (let ((x (car tail))
			     (y (cdr tail)))
			 (if (null? y)
			     d
			     (if (equal? key x)
				 (let ((n (car y)))
				   (if t
				       (begin (set! z (append (reverse head)
							      (cdr y)))
					      ts)
				       (error "alet[*]: bad argument"
					      n 'n 't)))
				 (let ((m (member x lk)))
				   (lp (if m
					   (cons (car y) (cons x head))
					   (cons x head))
				       (if m (cdr y) y)))))))))))))
    ((wow-key! z () (kk ...) (n key) d t ts fs)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (let ((n (car y)))
		 (if t
		     (begin (set! z (cdr y)) ts)
		     (begin (set! z (cdr y)) fs)))
	       (let lp ((head (list (car y) x)) (tail (cdr y)))
		 (if (null? tail)
		     d
		     (let ((x (car tail))
			   (y (cdr tail)))
		       (if (null? y)
			   d
			   (if (equal? key x)
			       (let ((n (car y)))
				 (if t
				     (begin (set! z (append (reverse head)
							    (cdr y)))
					    ts)
				     (begin (set! z (append (reverse head)
							    (cdr y)))
					    fs)))
			       (lp (cons (car y) (cons x head))
				   (cdr y)))))))))))
    ((wow-key! z (#f) (kk ...) (n key) d t ts fs)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (let ((n (car y)))
		 (if t
		     (begin (set! z (cdr y)) ts)
		     (begin (set! z (cdr y)) fs)))
	       (let ((lk (list kk ...)))
		 (if (not (member x lk))
		     d
		     (let lp ((head (list (car y) x)) (tail (cdr y)))
		       (if (null? tail)
			   d
			   (let ((x (car tail))
				 (y (cdr tail)))
			     (if (null? y)
				 d
				 (if (equal? key x)
				     (let ((n (car y)))
				       (if t
					   (begin
					     (set! z (append (reverse head)
							     (cdr y)))
					     ts)
					   (begin
					     (set! z (append (reverse head)
							     (cdr y)))
					     fs)))
				     (if (not (member x lk))
					 d
					 (lp (cons (car y) (cons x head))
					     (cdr y))))))))))))))
    ((wow-key! z (#t) (kk ...) (n key) d t ts fs)
     (let ((x (car z))
	   (y (cdr z)))
       (if (null? y)
	   d
	   (if (equal? key x)
	       (let ((n (car y)))
		 (if t
		     (begin (set! z (cdr y)) ts)
		     (begin (set! z (cdr y)) fs)))
	       (let* ((lk (list kk ...))
		      (m (member x lk)))
		 (let lp ((head (if m (list (car y) x) (list x)))
			  (tail (if m (cdr y) y)))
		   (if (null? tail)
		       d
		       (let ((x (car tail))
			     (y (cdr tail)))
			 (if (null? y)
			     d
			     (if (equal? key x)
				 (let ((n (car y)))
				   (if t
				       (begin (set! z (append (reverse head)
							      (cdr y)))
					      ts)
				       (begin (set! z (append (reverse head)
							      (cdr y)))
					      fs)))
				 (let ((m (member x lk)))
				   (lp (if m
					   (cons (car y) (cons x head))
					   (cons x head))
				       (if m (cdr y) y)))))))))))))))

(define-syntax alet-opt*
  (syntax-rules ()
    ((alet-opt* z (a . e) bd ...)
     (let ((y z))
       (%alet-opt* y (a . e) bd ...)))))
(define-syntax %alet-opt*
  (syntax-rules ()
    ((%alet-opt* z ((n d t ...)) bd ...)
     (let ((n (if (null? z)
		  d
		  (if (null? (cdr z))
		      (wow-opt n (car z) t ...)
		      (error "alet*: too many arguments" (cdr z))))))
       bd ...))
    ((%alet-opt* z ((n d t ...) . e)  bd ...)
     (let ((y (if (null? z) z (cdr z)))
	   (n (if (null? z)
		  d
		  (wow-opt n (car z) t ...))))
       (%alet-opt* y e bd ...)))
    ((%alet-opt* z e bd ...)
     (let ((e z)) bd ...))))
;; (define-syntax %alet-opt*
;;   (syntax-rules ()
;;     ((%alet-opt* z ((n d t ...)) bd ...)
;;      (let ((n (if (null? z)
;; 		  d
;; 		  (if (null? (cdr z))
;; 		      (wow-opt n (car z) t ...)
;; 		      (error "alet*: too many arguments" (cdr z))))))
;;        bd ...))
;;     ((%alet-opt* z ((n d t ...) . e)  bd ...)
;;      (let ((n (if (null? z)
;; 		  d
;; 		  (wow-opt! z n t ...))))
;;        (%alet-opt* z e bd ...)))
;;     ((%alet-opt* z e bd ...)
;;      (let ((e z)) bd ...))))
;; (define-syntax %alet-opt*
;;   (syntax-rules ()
;;     ((%alet-opt* z (ndt ...) (a . e) bd ...)
;;      (%alet-opt* z (ndt ... a) e bd ...))
;;     ((%alet-opt* z ((n d t ...) (nn dd tt ...) ...) () bd ...)
;;      (if (null? z)
;; 	 (let* ((n d) (nn dd) ...) bd ...)
;; 	 (let ((y (cdr z))
;; 	       (n (wow-opt n (car z) t ...)))
;; 	   (%alet-opt* y ((nn dd tt ...) ...) () bd ...))))
;;     ((%alet-opt* z () () bd ...)
;;      (if (null? z)
;; 	 (let () bd ...)
;; 	 (error "alet*: too many arguments" z)))
;;     ((%alet-opt* z  ((n d t ...) (nn dd tt ...) ...) e bd ...)
;;      (if (null? z)
;; 	 (let* ((n d) (nn dd) ... (e z)) bd ...)
;; 	 (let ((y (cdr z))
;; 	       (n (wow-opt n (car z) t ...)))
;; 	   (%alet-opt* y ((nn dd tt ...) ...) e bd ...))))
;;     ((%alet-opt* z () e bd ...)
;;      (let ((e z)) bd ...))))

(define-syntax alet-cat*
  (syntax-rules ()
    ((alet-cat* z (a . e) bd ...)
     (let ((y z))
       (%alet-cat* y (a . e) bd ...)))))
;; (define-syntax %alet-cat*
;;   (syntax-rules ()
;;     ((%alet-cat* z ((n d t ...)) bd ...)
;;      (let ((n (if (null? z)
;; 		  d
;; 		  (if (null? (cdr z))
;; 		      (wow-cat-end z n t ...)
;; 		      (error "alet*: too many arguments" (cdr z))))))
;;        bd ...))
;;     ((%alet-cat* z ((n d t ...) . e) bd ...)
;;      (let* ((w (if (null? z)
;; 		   (cons d z)
;; 		   (wow-cat z n d t ...)))
;; 	    (n (car w))
;; 	    (y (cdr w)))
;;        (%alet-cat* y e bd ...)))
;;     ((%alet-cat* z e bd ...)
;;      (let ((e z)) bd ...))))
(define-syntax %alet-cat*
  (syntax-rules ()
    ((%alet-cat* z ((n d t ...)) bd ...)
     (let ((n (if (null? z)
		  d
		  (if (null? (cdr z))
		      (wow-cat-end z n t ...)
		      (error "alet*: too many arguments" (cdr z))))))
       bd ...))
    ((%alet-cat* z ((n d t ...) . e) bd ...)
     (let ((n (if (null? z)
		  d
		  (wow-cat! z n d t ...))))
       (%alet-cat* z e bd ...)))
    ((%alet-cat* z e bd ...)
     (let ((e z)) bd ...))))
;; (define-syntax %alet-cat*
;;   (syntax-rules ()
;;     ((%alet-cat* z (ndt ...) (a . e) bd ...)
;;      (%alet-cat* z (ndt ... a) e bd ...))
;;     ((%alet-cat* z ((n d t ...) (nn dd tt ...) ...) () bd ...)
;;      (if (null? z)
;; 	 (let* ((n d) (nn dd) ...) bd ...)
;; 	 (let* ((w (wow-cat z n d t ...))
;; 		(n (car w))
;; 		(y (cdr w)))
;; 	   (%alet-cat* y ((nn dd tt ...) ...) () bd ...))))
;;     ((%alet-cat* z () () bd ...)
;;      (if (null? z)
;; 	 (let () bd ...)
;; 	 (error "alet*: too many arguments" z)))
;;     ((%alet-cat* z  ((n d t ...) (nn dd tt ...) ...) e bd ...)
;;      (if (null? z)
;; 	 (let* ((n d) (nn dd) ... (e z)) bd ...)
;; 	 (let* ((w (wow-cat z n d t ...))
;; 		(n (car w))
;; 		(y (cdr w)))
;; 	   (%alet-cat* y ((nn dd tt ...) ...) e bd ...))))
;;     ((%alet-cat* z () e bd ...)
;;      (let ((e z)) bd ...))))

(define-syntax alet-key*
  (syntax-rules ()
    ((alet-key* z (a . e) bd ...)
     (let ((y z))
       (%alet-key* y () () (a . e) () bd ...)))))
(define-syntax %alet-key*
  (syntax-rules ()
    ((%alet-key* z () (ndt ...) (((n k) d t ...) . e) (kk ...) bd ...)
     (%alet-key* z () (ndt ... ((n k) d t ...)) e (kk ... k) bd ...))
    ((%alet-key* z () (ndt ...) ((n d t ...) . e) (kk ...) bd ...)
     (%alet-key* z () (ndt ... ((n 'n) d t ...)) e (kk ... 'n) bd ...))
    ((%alet-key* z () (ndt nd ...) (#f . e) (kk k ...) bd ...)
     (%alet-key* z (#f) (ndt nd ...) e (kk k ...) bd ...))
    ((%alet-key* z () (ndt nd ...) (#t . e) (kk k ...) bd ...)
     (%alet-key* z (#t) (ndt nd ...) e (kk k ...) bd ...))

    ((%alet-key* z (o ...) (((n k) d t ...) ndt ...) e (kk ...) bd ...)
     (let ((n (if (null? z)
		  d
		  (wow-key! z (o ...) (kk ...) (n k) d t ...))))
       (%alet-key* z (o ...) (ndt ...) e (kk ...) bd ...)))
    ((%alet-key* z (o ...) () () (kk ...) bd ...)
     (if (null? z)
	 (let () bd ...)
	 (error "alet*: too many arguments" z)))
    ((%alet-key* z (o ...) () e (kk ...) bd ...)
     (let ((e z)) bd ...))))

; eof
