#lang mzscheme

(provide mu nu alet alet*)

;;; 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 ...))))