; Author: Juergen Lorenz, ju (at) jugilo (dot) de
;
; Copyright (c) 2013-2020, Juergen Lorenz
; All rights reserved.
; 
; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions are
; met:
; 
; Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following dispasser.
; 
; Redistributions in binary form must reproduce the above copyright
; notice, this list of conditions and the following dispasser in the
; documentation and/or other materials provided with the distribution.
; 
; Neither the name of the author nor the names of its contributors may be
; used to endorse or promote products derived from this software without
; specific prior written permission. 
; 
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
; HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

#|[
Yet another implementation of the bindings egg.
Sequence routines are outsourced to simple-sequences, so that an
enhanced version of Paul Graham's dbind (On Lisp, p. 232) can be used, a
variant of Common Lisp's destructuring bind.

But this version of dbind supports setters as well, using dbind without
body. The reason to put it all in one huge macro is, that both variants
use a common set of subroutines, which are implemented within the macro
body. I could have put it into a helper module to be imported by syntax,
but this subroutines are without interest outside of dbind.

Other enhancements include length checks of sequences, a wildcard, _,
which matches everything and binds nothing, literals, which match only
themselfs but can't of course be bound, and dots, which are extensions of
ellipses: two dots accept zero or one items of the same shape as the
nested list to its left, and four dots accept only non-empty nested
lists.

Note, that dbind is not exported, but bind and bind! are exported
instead.
]|#

(module bindings (
  bind
  bind!
  bindrec
  bind-case
  bindable?
  bind-lambda
  bind-lambda*
  bind-case-lambda
  bind-case-lambda*
  bind*
  bind-loop
  bind-let*
  bind-let
  bind-letrec
  bind/cc
  bindings
  )

(import scheme
        (only simple-sequences sequence-db seq-ref seq-ref* seq-tail seq-length)
        (only (chicken condition) condition-case)
        (only (chicken base) gensym receive print case-lambda error)
        (only (chicken keyword) keyword?)
        (only (chicken module) reexport)
        )

(reexport (only simple-sequences sequence-db))

(import-for-syntax (only (chicken keyword) keyword?))

;;; Graham's dbind for sequences with length checks, literals,
;;; wildcard and dots, as well as setters.
(define-syntax dbind
  (er-macro-transformer
    (lambda (form rename compare?)
      (let (
        (%x (rename 'x))
        (%_ (rename '_))
        (%.. (rename '..))
        (%... (rename '...))
        (%.... (rename '....))
        (%if (rename 'if))
        (%or (rename 'or))
        (%map (rename 'map))
        (%let (rename 'let))
        (%set! (rename 'set!))
        (%begin (rename 'begin))
        (%error (rename 'error))
        (%zero? (rename 'zero?))
        (%equal? (rename 'equal?))
        (%lambda (rename 'lambda))
        (%seq-ref (rename 'seq-ref))
        (%seq-ref* (rename 'seq-ref*))
        (%seq-tail (rename 'seq-tail))
        (%seq-length (rename 'seq-length))
        (%positive? (rename 'positive?))
        )
        (letrec (
          (literal?
            (lambda (p)
              (or (boolean? p)
                  (char? p)
                  (number? p)
                  (string?  p)
                  (keyword?  p))))
          (mappend
            (lambda (fn lists)
              (apply append (map fn lists))))
          (dots?
            (lambda (sym)
              (or (compare? sym %..)
                  (compare? sym %...)
                  (compare? sym %....))))
          (check-dots
            (lambda (sym seq)
              `(,(gensym)
                (,%if
                  ,(cond
                    ((compare? sym %..)
                     `(,%or (,%zero? (,%seq-length ,seq))
                            (,%zero? (,%seq-length (,%seq-tail ,seq 1)))))
                    ((compare? sym %...) #t)
                    ((compare? sym %....)
                     `(,%positive? (,%seq-length ,seq))))
                  (,%seq-length ,seq) 
                  (,%error 'check-dots "wrong size for this dots" ,seq ',sym)))))
          (indices
            ;;; (a b) -> ((a . 0) (b . 1))
            ;;; (a (b (c))) -> ((a . 0) (b 1 . 0) (c 1 1 . 0))
            (lambda (pat)
              (receive (flat ind)
                (let recur ((pat pat) (k 0))
                  (cond
                    ((null? pat)
                     (values '() '()))
                    ((pair? pat)
                     (let ((p (car pat)) (ps (cdr pat)))
                       (receive (p* i*) (recur p 0)
                         (receive (ps* is*) (recur ps (+ k 1))
                           (if (pair? p)
                             (values (append p* ps*)
                                     (append (map (lambda (x) (cons k x)) i*)
                                             is*))
                             (values (cons p ps*)
                                     (cons k is*)))))))
                    (else ;symbol
                     (values '() '()))))
                  (map cons flat ind))))
          (map-seq-ref*
            ;;; '(a (b c)) '((1 (2 3)) (10 (20 30)))
            ;;; ->
            ;;; '((a (1 10))) (b (2 30)) (c (3 30)))
            (lambda (pat seqs)
              (let recur ((pi (indices pat)))
                (if (null? pi)
                  '()
                  (let ((api (car pi)) (dpi (cdr pi)))
                    (cons (list (car api)
                                `(,%map (,%lambda (,%x)
                                          (,%seq-ref* ,%x ',(cdr api)))
                                        ,seqs))
                          (recur dpi)))))))
          (destruc
            ;; (destruc '(a (b . c) . d) 'seq)
            ;; ->
            ;; ((a (seq 0))
            ;;  ((#!g (seq 1)) (b (#!g 0)) (c (#!g 1 #f)))
            ;;  (d (seq 2 #f)))
            (lambda (pat seq)
              (let loop ((pat pat) (seq seq) (n 0))
                (if (pair? pat)
                  (let ((p (car pat))
                        (q (cdr pat))
                        (recu (loop (cdr pat) seq (+ n 1))))
                    (cond
                      ((symbol? p)
                       (cond
                         ((compare? p %_) ; wildcard
                          recu)
                         ((and (pair? q) (dots? (car q))) ;;;;
                          ;(print p " PQ " q)
                          (let ((seqs `(,%seq-tail ,seq ,n)))
                            ;(cons (list p seqs) '()))) ;ok, ohne checks
                            (cons (list (check-dots (car q) seqs)
                                        (list p seqs))
                                  '())))
                         (else
                           (cons `(,p (,%seq-ref ,seq ,n)) recu))))
                      ;; literals
                      ((literal? p)
                       (cons `(,(gensym)
                                (,%if (,%equal? (,%seq-ref ,seq ,n) ,p)
                                  #t
                                  (,%error 'dbind
                                           "literals don't match"
                                           (,%seq-ref ,seq ,n) ,p)))
                             recu))
                      ;; pair
                      (else
                        (cond
                          ((and (pair? q) (dots? (car q))) ;;;;;
                           (let ((seqs `(,%seq-tail ,seq ,n)))
                             (cons (cons (check-dots (car q) seqs)
                                         (map-seq-ref* p seqs))
                                   '())))
                          (else
                            (let ((g (gensym)))
                              (cons (cons `(,g (,%seq-ref ,seq ,n))
                                          (loop p g 0))
                                    recu)))))) )
                  (let ((tail `(,%seq-tail ,seq ,n)))
                    (cond
                      ((null? pat)
                        `((,(gensym)
                            (,%if (,%zero? (,%seq-length ,tail))
                              #t
                              (,%error 'dbind
                                     "tail not empty?"
                                     ,tail)))))
                      ((literal? pat)  ;;;;;;
                       `((,(gensym)
                          (,%if (,%equal? (,%seq-tail ,seq ,n) ,pat)
                            #t
                            (,%error 'dbind
                                     "literals don't match"
                                     (,%seq-tail ,seq ,n) ,pat)))))
                      (else `((,pat ,tail)))))))))
          (dbind-ex
            ;; ->
            ;; (let ((a (seq 0)) (#!g (seq 1)) (d (seq 2 #f)))
            ;;   (let ((b (#!g 0)) (c (#!g 1 #f)))
            ;;     (begin body)))
            (lambda (binds body)
              (if (null? binds)
                `(,%begin ,@body)
                `(,%let ,(map (lambda (b)
                                (if (pair? (car b)) (car b) b))
                              binds)
                   ,(dbind-ex (mappend (lambda (b)
                                         (if (pair? (car b))
                                             (cdr b)
                                             '()))
                                       binds)
                              body)))))
          (dbind-set
            ;; ->
            ;; (begin
            ;;   (set! a (seq 0)) (set! #!g (seq 1)) (set! d (seq 2 #f))
            ;;   (set! b (#!g 0)) (set! c (#!g 1 #f)))
            (lambda (binds)
              (mappend (lambda (b)
                         (if (pair? (car b))
                             (cons `(,%set! ,(caar b) ,(cadar b))
                                   (dbind-set (cdr b)))
                             (list `(,%set! ,(car b) ,(cadr b)))))
                       binds)))
          )
          (let ((pat (cadr form))
                (seq (caddr form))
                (body (cdddr form))
                (gseq (gensym 'seq)))
            `(,%let ((,gseq ,seq))
               ,(if (null? body)
                  ;; setters
                  (cond
                    ((null? pat)
                     `(,%if (,%zero? (,%seq-length ,gseq))
                        (,%if #f #f)
                        (,%error 'dbind "seq too long" ,gseq ',pat)))
                    ((compare? pat %_)
                     `(,%if #f #f))
                    ((literal? pat)
                     `(,%if (,%equal? ,pat ,gseq)
                        (,%if #f #f)
                        (,%error 'dbind "literals don't match"
                                 ,pat ,gseq)))
                    ((symbol? pat)
                     `(,%set! ,pat ,gseq))
                    ((pair? pat)
                     `(,%begin ,@(dbind-set (destruc pat gseq)))))
                  ;; binders
                  (cond
                    ((null? pat)
                     `(,%if (,%zero? (,%seq-length ,gseq))
                        (,%begin ,@body)
                        (,%error 'dbind "seq too long" ,gseq ',pat)))
                    ((compare? pat %_)
                     `(,%begin ,@body))
                    ((literal? pat)
                     `(,%if (,%equal? ,pat ,gseq)
                        (,%begin ,@body)
                        (,%error 'dbind "literals don't match"
                                 ,pat ,gseq)))
                    ((symbol? pat)
                     `(,%let ((,pat ,gseq)) ,@body))
                    ((pair? pat)
                     (dbind-ex (destruc pat gseq) body)))
                  ))))))))

;;; (bind pat seq xpr . xprs)
;;; -------------------------
;;; binds pattern variables of pat to corresponding places in seq
;;; and executes body xpr . xprs in this context.
;;; Literals, wildcard, length checks and dots are supported. 
(define-syntax bind
  (syntax-rules ()
    ((_ pat seq xpr . xprs)
     (dbind pat seq xpr . xprs))))

;;; (bind! pat seq)
;;; (bind! pat)
;;; ---------------
;;; setters corresponding to bind
(define-syntax bind!
  (syntax-rules ()
    ((_ pat seq)
     (dbind pat seq))
    ((_ pat)
     (dbind pat 'pat))))

;;; (bindable? pat (where . fenders) seq)
;;; (bindable? pat (where . fenders))
;;; (bindable? pat seq)
;;; (bindable? pat)
;;; -------------------------------------
(define-syntax bindable?
  (syntax-rules (where)
    ((_ pat (where fender ...) seq)
     (condition-case (dbind pat seq (and fender ...))
       ((exn) #f)))
    ((_ pat seq)
     (condition-case (dbind pat seq #t)
       ((exn) #f)))
    ;; curried versions
    ((_ pat (where fender ...))
     (lambda (seq)
       (bindable? pat (where fender ...) seq)))
    ((_ pat)
     (lambda (seq)
       (bindable? pat seq)))
    ))

(define (all-bindable? pat lst)
  (let loop ((lst lst))
    (cond
      ((null? lst) #t)
      (((bindable? (eval pat)) (car lst)) (loop (cdr lst)))
      (else
        (error 'all-bindable? "fails in bind with " pat (car lst))))))

#|[
The following macro does more or less the same what the match macro from
the matchable package does, for example

  (bind-case '(1 (2 3))
    ((x y) (where (number? y)) (list x y))
    ((x (y . z)) (list x y z))
    ((x (y z)) (list x y z))) ;-> '(1 2 (3))

or, to give a more realistic example, mapping:

  (define (my-map fn lst)
    (bind-case lst
      (() '())
      ((x . xs) (cons (fn x) (my-map fn xs)))))
]|#

;;; (bind-case seq (pat (where fender ...) xpr ....) ....)
;;; (bind-case seq (pat xpr ....) ....)
;;; ------------------------------------------------------
;;; Checks if seq matches patterns pat  ....
;;; in sequence, binds the pattern variables of the first matching
;;; pattern to corresponding subexpressions of seq and executes
;;; body expressions xpr .... in this context
(define-syntax bind-case
  (syntax-rules (where)
    ((_ seq)
     (error 'bind-case "no pattern to match" seq))
    ((_ seq (pat (where fender ...) xpr . xprs))
     (if (bindable? pat (where fender ...) seq)
       (dbind pat seq xpr . xprs)
       (error 'bind-seq "sequence doesn't match pattern with fenders"
              seq 'pat 'fender ...)))
    ((_ seq (pat xpr . xprs))
     (if (bindable? pat seq)
       (dbind pat seq xpr . xprs)
       (error 'bind-seq "sequence doesn't match pattern" seq 'pat)))
    ((_ seq (pat (where fender ...) xpr . xprs) . clauses)
     (if (bindable? pat (where fender ...) seq)
       (dbind pat seq xpr . xprs)
       (bind-case seq . clauses)))
    ((_ seq (pat xpr . xprs) . clauses)
     (if (bindable? pat seq)
       (dbind pat seq xpr . xprs)
       (bind-case seq . clauses)))
    ))

#|[
Now we can define two macros, which simply combine lambda with
bind, the first destructures simply one argument, the second a
whole list. An example of a call and its result is

  ((bind-lambda (a (b . c) . d) (list a b c d))
   '(1 #(20 30 40) 2 3))
  -> '(1 20 #(30 40) (2 3)))))

  ((bind-lambda* ((a (b . c) . d) (e . f))
     (list a b c d e f))
   '(1 #(20 30 40) 2 3) '#(4 5 6))
  -> '(1 20 #(30 40) (2 3) 4 #(5 6)))
]|#

;;; (bind-lambda pat xpr ....)
;;; --------------------------
;;; combination of lambda and bind, one pattern argument
(define-syntax bind-lambda
  (syntax-rules ()
    ((_ pat xpr . xprs)
     (lambda (x) (dbind pat x xpr . xprs)))
    ))

;;; (bind-lambda* pat xpr ....)
;;; ---------------------------
;;; combination of lambda and bind, multiple pattern arguments
(define-syntax bind-lambda*
  (syntax-rules ()
    ((_ pat xpr . xprs)
     (lambda x (dbind pat x xpr . xprs)))
     ))

#|[ 
The next two macros combine lambda and bind-case and do more or less the
same as match-lambda and match-lambda* in the matchable package. The
first destructures one argument, the second a list of arguments.
Here is an example together with its result (note the >> fender):

  ((bind-case-lambda
     ((a (b . c) . d) (list a b c d))
     ((e . f) (>> e zero?) e)
     ((e . f) (list e f)))
   '(1 2 3 4 5))
  -> '(1 (2 3 4 5))

  ((bind-case-lambda*
     (((a (b . c) . d) (e . f))
      (list a b c d e f)))
   '(1 #(20 30 40) 2 3) '(4 5 6))
  -> '(1 20 (30 40) (2 3) 4 (5 6))
]|#

;;; (bind-case-lambda (pat (where fender ...) xpr ....) ....)
;;; (bind-case-lambda (pat xpr ....) ....)
;;; ---------------------------------------------------------
;;; combination of lambda and bind-case, one pattern argument
(define-syntax bind-case-lambda
  (syntax-rules (where)
    ((_ (pat (where fender ...) xpr . xprs))
     (lambda (x)
       (bind-case x (pat (where fender ...) xpr . xprs))))
    ((_ (pat xpr . xprs))
     (lambda (x)
       (bind-case x (pat xpr . xprs))))
    ((_ clause . clauses)
     (lambda (x)
       (bind-case x clause . clauses)))
    ))

;;; (bind-case-lambda* (pat (where fender ...) xpr ....) ....)
;;; (bind-case-lambda* (pat xpr ....) ....)
;;; ----------------------------------------------------------
;;; combination of lambda and bind-case, multiple pattern arguments
(define-syntax bind-case-lambda*
  (syntax-rules (where)
    ((_ (pat (where fender ...) xpr . xprs))
     (lambda x
       (bind-case x (pat (where fender ...) xpr . xprs))))
    ((_ (pat xpr . xprs))
     (lambda x
       (bind-case x (pat xpr . xprs))))
    ((_ clause . clauses)
     (lambda x
       (bind-case x clause . clauses)))
    ))

#|[
The following macro, bind-loop, is an anaphoric version of bind.
It introduces an unrenamed symbol, loop, behind the scene and binds it
to a procedure, which can be used in the body.
For example

  (bind-loop (x y) '(5 0)
    (if (zero? x)
      (list x y)
      (loop (list (sub1 x) (add1 y)))))
  -> '(0 5)
]|#

;;; (bind-loop pat seq xpr ....)
;;; ----------------------------
;;; anaphoric version of bind, introducing loop routine behind the scene
(define-syntax bind-loop
  (er-macro-transformer
    (lambda (form rename compare?)
      (let ((pat (cadr form))
            (seq (caddr form))
            (xpr (cadddr form))
            (xprs (cddddr form))
            (%letrec (rename 'letrec))
            (%bind-lambda (rename 'bind-lambda)))
        `((,%letrec ((loop (,%bind-lambda ,pat ,xpr ,@xprs)))
            loop)
          ,seq)))))

#|[
The following macro, bind*, is a named version of bind. It takes an
additional argument besides those of bind, which is bound to a
recursive procedure, which can be called in bind's body. The pattern
variables are initialised with the corresponding subexpressions in seq.
For example

  (bind* loop (x y) '(5 0)
    (if (zero? x)
      (list x y)
      (loop (list (sub1 x) (add1 y)))))
  -> '(0 5)
]|#

;;; (bind* name pat seq xpr ....)
;;; ---- ------------------------
;;; named version of bind
(define-syntax bind*
  (syntax-rules ()
    ((_ name pat seq xpr . xprs)
     ((letrec ((name (bind-lambda pat xpr . xprs)))
        name)
      seq))))

#|[
The following three macros are analoga of the standard base macros let,
let* and letrec, the first named or unnamed. For example

(bind-let loop (((a b) '(5 0)))
  (if (zero? a)
    (list a b)
    (loop (list (sub1 a) (add1 b)))))
-> '(0 5)

A recursive version of bind follows
]|#

;;; (bind-let* ((pat seq) ...) xpr . xprs)
;;; --------------------------------------
;;; sequentually binding patterns to sequences
(define-syntax bind-let*
  (syntax-rules ()
    ((_ () xpr . xprs)
     (let () xpr . xprs))
    ((_ ((pat seq)) xpr . xprs)
     (dbind pat seq xpr . xprs))
    ((_ ((pat seq) (pat1 seq1) ...) xpr . xprs)
     (dbind pat seq (bind-let* ((pat1 seq1) ...) xpr . xprs)))
     ))

;;; (bind-let name .. ((pat seq) ...) xpr . xprs)
;;; ---------------------------------------------
;;; binding patterns to sequences in parallel, whith or without a
;;; recursive name procedure
(define-syntax bind-let
  (syntax-rules ()
    ((_ ((pat seq) ...) xpr . xprs)
     (dbind (pat ...) (list seq ...) xpr . xprs))
    ((_ name ((pat seq) ...) xpr . xprs)
     ((letrec ((name (bind-lambda* (pat ...) xpr . xprs)))
        name)
      seq ...))
    ))

;;; (bind-letrec ((pat seq) ...) xpr . xprs)
;;; ----------------------------------------
;;; binding patterns to sequences recursively
(define-syntax bind-letrec
  (syntax-rules ()
    ((_ ((pat seq) ...) xpr . xprs)
     (bind-let ((pat 'pat) ...)
       (bind! (pat ...) (list seq ...))
       xpr . xprs))))
    
;;; (bindrec pat seq xpr . xprs)
;;; ----------------------------
;;; recursive version of bind
(define-syntax bindrec
  (syntax-rules ()
    ((_ pat seq xpr . xprs)
     (dbind pat 'pat
       (bind! pat seq)
       xpr . xprs))))

#|[
I don't like the let/cc syntax, because it differs from let syntax,
here is bind/cc, which does the same.
]|#

;;; (bind/cc cc xpr ....)
;;; ---------------------
;;; captures the current continuation, binds it to cc and executes
;;; xpr .... in this context
(define-syntax bind/cc
  (syntax-rules ()
    ((_ cc xpr . xprs)
     (call-with-current-continuation
       (lambda (cc) xpr . xprs)))))

(define (symbol-dispatcher alist) ; internal
  (case-lambda
    (()
     (map car alist))
    ((sym)
     (let ((pair (assq sym alist)))
       (if pair
         (for-each print (cdr pair))
         (error "Not in list"
                sym
                (map car alist)))))))

;;; (bindings sym ..)
;;; -----------------
;;; documentation procedure
(define bindings
  (symbol-dispatcher '(
    (sequence-db
      procedure:
      (sequence-db)
      (sequence-db seq)
      (sequence-db seq? seq-length seq-ref seq-tail seq-maker . pos?)
      "sequence database processing, reexported from simple-sequences:"
      "the first resets the database to the standard with"
      "lists, pairs, vectors and strings,"
      "the second returns the vector of handlers as well as the discriminator,"
      "the third adds a new database record either at the end or before the"
      "pos? discriminator."
      "A record cosists of a discriminator, seq?, and a vector with items"
      "seq-lenth, seq-ref, seq-tail and seq-maker patterned after vectors."
      "Note, that the last record can handle atoms, albeit it is not a"
      "sequence."
      )
    (bindings
      procedure:
      (bindings sym ..)
      "documentation procedure")
    (bind
      macro:
      (bind pat seq)
      (bind pat seq . body)
      "a variant of Common Lisp's destructuring-bind with body"
      "multiple set!s without")
    (bind-case
      macro:
      (bind-case seq (pat (where fender ...) xpr ....) ....)
      (bind-case seq (pat xpr ....) ....)
      "matches seq against pat with optional fenders in a case regime")
    (bindable?
      macro:
      (bindable? pat (where fender ...) seq)
      (bindable? pat seq)
      (bindable? pat (where fender ...))
      (bindable? pat)
      "The first two check if sequence seq matches pattern pat"
      "with optional fenders."
      "The second two are curried versions of the first two")
    (bind!
      macro:
      (bind! pat seq)
      "sets multiple variables by destructuring its sequence arguments")
    (bind-lambda
      macro:
      (bind-lambda pat xpr ....)
      "combination of lambda and bind, one pattern argument")
    (bind-lambda*
      macro:
      (bind-lambda* pat xpr ....)
      "combination of lambda and bind, multiple pattern arguments")
    (bind*
      macro:
      (bind* loop pat seq xpr ....)
      "named version of bind,"
      "deprecated, use bind-loop instead")
    (bind-loop
      macro:
      (bind-loop pat seq xpr ....)
      "anaphoric version of bind,"
      "introduces a routine named loop behind the scene,"
      "to be used in the body xpr ....")
    (bind-let
      macro:
      (bind-let loop .. ((pat seq) ...) xpr ....)
      "nested version of let, named and unnamed")
    (bind-let*
      macro:
      (bind-let* ((pat seq) ...) xpr ....)
      "nested version of let*")
    (bindrec
      macro:
      (bindrec pat seq xpr ....)
      "recursive version of bind")
    (bind-letrec
      macro:
      (bind-letrec ((pat seq) ...) xpr ....)
      "recursive version of bind-let")
    (bind-case-lambda
      macro:
      (bind-case-lambda (pat (where fender ...) xpr ....) ....)
      (bind-case-lambda (pat xpr ....) ....)
      "combination of lambda and bind-case with one pattern argument")
    (bind-case-lambda*
      macro:
      (bind-case-lambda* (pat (where fender ...) xpr ....) ....)
      (bind-case-lambda* (pat xpr ....) ....)
      "combination of lambda and bind-case with multiple pattern arguments")
    (bind/cc
      macro:
      (bind/cc cc xpr ....)
      "binds cc to the current contiunation"
      "and execute xpr ... in this context")
    )))

) ; module