#|[
 Author: Juergen Lorenz
 ju (at) jugilo (dot) de

 Copyright (c) 2011-2013, 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 disclaimer.
 
 Redistributions in binary form must reproduce the above copyright
 notice, this list of conditions and the following disclaimer 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.

Binding pattern variables to subsequences
=========================================

In this module, you'll find macros, which all operate on patterns, that
is, nested lambda-lists. To be more precise, here is a formal
definition, which is motivated by the definition of a lambda-list,
which is the type of the arguments of a lambda expression: A
lambda-list is either a symbol, the empty list or a pair consisting of
a symbol and a lambda-list, or - more formally -

lambda-list? :=
  symbol? | null? | (cons symbol? lambda-list?)

The arguments of macros on the other hand can be more general, namely
they can be nested. Let's call the appropriate type a pattern or
anested-lambda-list, whose formal definition is

nested-lambda-list? :=
  symbol? | null? | (cons (and (not null?) nested-lambda-list?)
                          nested-lambda-list?)

We'll define a list of operators, most of them binding constructs and
hence macros, which bind pattern variables, i.e. the symbols of a
pattern, to corresponding subexpressions of an expression and execute
some body in this scope. The most fundamental of this operators is
bind, which is roughly the same as destructuring-bind in Common Lisp.
For example

  (bind (u (v (w . x) y) . z) '(1 (2 (3) 4) 5 6) (list u v w x y z))

will return (1 2 3 () 4 (5 6)).

In this example the expression to be destructured is a nested list,
'(1 (2 (3) 4) 5 6), and this is the most important case. But as Paul
Graham in his classic "On Lisp" notes, there is no need to restrict
oneself to nested lists, arbitrary nested sequences should do as well.
Unfortunately, standard Scheme doesn't have a sequence datatype but
Chicken has a corresponding egg. This could be used, but this would be
sort of overkill.

Internally, we'll use three generic functions instead, gcar,
gcdr and gnull? which are able to handle not only lists,
but vectors and strings as well. So our binding macros work on
arbitrary mixtures of (pseudo-) lists, strings and vectors as given.
But since they operate by searching a local table, we can add other
type-operator-pairs to these tables, thus enhancing the binding
operators to other sequence types, say tuples, lazy-lists or what have
you, without touching the macros itself! To be more precise, we need to
export only one function, generic-null-car-cdr!, which maintains the
table for the other three generics, and which can be used by clients to
add other relevant operator triples.

I've added one additional twist. The bodies of bind and some other
macros can start with an optional where-clause, (where . fenders),
which means, that a match is only considered successfull, if all
fenders evaluate to true.

Below, I'll freely use not only ellipses, i.e. three dots, meaning
"repeat the pattern to the left zero or more times", but also two dots
and four dots to repeat the pattern(s) to the left "zero or one
times" or "one or many times" respectively.
]|#


(module bindings
(export bindings
        (bind gcar gcdr gnull? gpair?)
        bindable?  bind-case bind-let bind-let* bind-letrec
        bindrec bind-lambda bind-lambda* bind* bind-set!
        bind-define bind-case-lambda bind-case-lambda*
        ;gcar gcar-table gnull? gnull?-table gcdr gcdr-table ;;;
        ;search-and-call assp;;;
        ;; the generics updater must be exported for bind to be extensible
        generic-null-car-cdr!)

(import scheme
        (only data-structures ->string list-of?)
        (only chicken
              condition-case case-lambda define-values
              print error gensym
              current-exception-handler
              make-property-condition
              condition-predicate
              get-condition-property
              signal abort))

#|[
Let's start with a new exception-handler, which is able to cope with
bind exceptions
]|#

(current-exception-handler
  (let ((old-handler (current-exception-handler)))
    (lambda (exn)
      (if ((condition-predicate 'bind-exn) exn)
        (begin
          (display "Error: ")
          (print (get-condition-property exn 'bind-exn 'location))
          (print (get-condition-property exn 'bind-exn 'message))
          (for-each print (get-condition-property exn 'bind-exn 'arguments))
          (abort (make-property-condition 'exn
                   'message "exception-handler returned")))
        (old-handler exn)))))


#|[
We begin with the fundamental macro, bind, which is an enhanced version
of Common Lisp's destructuring-bind. First, it destructures arbitrary
mixtures of list-, vector- and string-expressions with other sequence
types to be addable by the client as needed. And second it allows for an
optional where clause, which can be used to restrict the admissible
binds.
]|#

;;; (bind pat seq (where . fenders) .. xpr . xprs)
;;; ----------------------------------------------
;;; binds pattern variables of pat to corresponding subexpressions of
;;; seq and executes tthe body xpr . xprs in this context. If a where
;;; expression is supplied, all fenders must return #t for seq to be
;;; successfully bound.
(define-syntax bind
  (syntax-rules (where)
    ((_ pat seq (where . fenders) xpr . xprs)
     (bind pat seq
       (if (and . fenders)
         (begin xpr . xprs)
         (signal (make-property-condition 'bind-exn
                                          'message "no match" 
                                          'location '(bind)
                                          'arguments (cons 'pat
                                                           (cons seq
                                                                 'fenders))
                                          )))))
    ((_(a . b) seq xpr . xprs)
     (let ((seq1 seq))
       (if (gpair? seq1)
         (bind a (gcar seq1)
           (bind b (gcdr seq1) xpr . xprs))
         (signal (make-property-condition 'bind-exn
                                          'message "no match" 
                                          'location '(bind)
                                          'arguments (list '(a . b) seq1)
                                          )))))
    ((_ () seq xpr . xprs)
     (let ((seq1 seq))
       (if (gnull? seq1)
         (let () xpr . xprs)
         (signal (make-property-condition 'bind-exn
                                          'message "no match" 
                                          'location '(bind)
                                          'arguments (list '() seq1)
                                          )))))
    ((_ a seq xpr . xprs)
     (let ((seq1 seq))
       (let ((a seq1)) xpr . xprs)))))

#|[
The macro bind* is to bind what named let is to let. 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 subexpressins
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 (where . fenders) .. xpr . xprs)
;;; ----------------------------------------------------
;;; named version of bind
(define-syntax bind*
  (syntax-rules (where)
    ((_ loop pat seq (where . fenders) xpr . xprs)
     ((letrec 
        ((loop (lambda (x)
                (bind pat x (where . fenders) xpr . xprs))))
        loop)
      seq))
    ((_ loop pat seq xpr . xprs)
     ((letrec ((loop (lambda (x) (bind pat x xpr . xprs))))
        loop)
      seq))))

#|[
The next macro, bindable?, can be used to check, if a
sequence-expression matches a pattern and passes all fenders. It's used
in bind-case below.
The implementation relies on bind, which must be protected against exceptions.
]|#

;;; (bindable? pat . fenders)
;;; -------------------------
;;; returns a unary predicate which checks, if its argument matches pat
;;; and fulfills the predicates in the list fenders
(define-syntax bindable?
  (syntax-rules ()
    ((_ pat . fenders)
     (lambda (seq)
       (condition-case
         (bind pat seq (and . fenders))
         ((bind-exn) #f))))))

#|[
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 (list? 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 . fenders) .. xpr . xprs) ....)
;;; ----------------------------------------------------------
;;; Checks if seq matches pattern pat [satisfying fenders] ....
;;; in sequence, binds the pattern variables of the first matching
;;; pattern to corresponding subexpressions of seq and executes
;;; corresponding body xpr . xprs
(define-syntax bind-case
  (syntax-rules (where)
    ((_ seq (pat (where . fenders) xpr . xprs) . clauses)
     (condition-case
       (bind pat seq (where . fenders) xpr . xprs)
       ((bind-exn) (bind-case seq . clauses))))
    ((_ seq (pat xpr . xprs) . clauses)
     (condition-case
       (bind pat seq xpr . xprs)
       ((bind-exn) (bind-case seq . clauses))))
    ((_ seq)
     (signal (make-property-condition 'bind-exn
                                      'message "no rule matches"
                                      'location '(bind-case)
                                      'arguments (list seq))))
    ))

#|[
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 . xprs)
;;; --------------------------------
;;; combination of lambda and bind, one pattern argument
(define-syntax bind-lambda
  (syntax-rules (where)
    ((_ pat (where . fenders) xpr . xprs)
     (lambda (x) (bind pat x (where . fenders) xpr . xprs)))
    ((_ pat xpr . xprs)
     (lambda (x) (bind pat x xpr . xprs)))))


;;; (bind-lambda* pat xpr . xprs)
;;; ---------------------------------
;;; combination of lambda and bind, multiple pattern arguments
(define-syntax bind-lambda*
  (syntax-rules (where)
    ((_ pat (where . fenders) xpr . xprs)
     (lambda x (bind pat x (where . fenders) xpr . xprs)))
    ((_ pat xpr . xprs)
     (lambda x (bind 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:

  ((bind-case-lambda
     ((a (b . c) . d) (list a b c d))
     ((e . f) (where (zero? e)) 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 . fenders) .. xpr . xprs) ....)
;;; -------------------------------------------------------------
;;; combination of lambda and bind-case, one pattern argument
(define-syntax bind-case-lambda
  (syntax-rules (where)
    ((_ (pat (where . fenders) xpr . xprs))
     (lambda (x) (bind pat x (where . fenders) xpr . xprs)))
    ((_ (pat xpr . xprs))
     (lambda (x) (bind pat x xpr . xprs)))
    ((_ clause . clauses)
     (lambda (x)
       (bind-case x clause . clauses)))))

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

#|[
Now the implementation of a nested version of let, named and unnamed,
is easy: Simply combine bind and bind*. For example

  (bind-let (
     (((x y) z) '((1 2) 3))
     (u (+ 2 2))
     ((v w) '(5 6))
     )
     (list x y z u v w))
  -> '(1 2 3 4 5 6)

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

;;; (bind-let loop .. ((pat seq) ...) xpr . xprs)
;;; ---------------------------------------------
;;; nested version of let, named and unnamed
(define-syntax bind-let
  (syntax-rules ()
    ((_ () xpr . xprs)
     (begin xpr . xprs))
    ((_ ((pat0 seq0) (pat1 seq1) ...) xpr . xprs)
     (bind (pat0 pat1 ...) (list seq0 seq1 ...) xpr . xprs))
    ((_ loop () xpr . xprs)
     (let loop () xpr . xprs))
    ((_ loop ((pat0 seq0) ...) xpr . xprs)
     (bind* loop (pat0 ...) (list seq0 ...) xpr . xprs))))

#|[
The sequential version of bind-let should work as follows

  (bind-let* (
     (((x y) z) '((1 2) 3))
     (u (+ 1 2 x))
     ((v w) (list (+ z 2) 6))
     )
     (list x y z u v w))
  -> '(1 2 3 4 5 6)
]|#

;;; (bind-let* ((pat seq) ...) xpr . xprs)
;;; --------------------------------------
;;; sequential version of bind-let
(define-syntax bind-let*
  (syntax-rules ()
    ((_ () xpr . xprs)
     (let () xpr . xprs))
    ((_ ((pat seq) decl ...) xpr . xprs)
     (bind pat seq (bind-let* (decl ...) xpr . xprs)))))

#|[
The recursive version of bind-let works as follows
  
  (bind-letrec (
    ((o? (e?))
     (list (lambda (m) (if (zero? m) #f (e? (- m 1))))
           (vector (lambda (n) (if (zero? n) #t (o? (- n 1)))))))
    )
    (list (o? 95) (e? 95)))
  -> '(#t #f)
]|#

;;; (bind-letrec ((pat seq) ...) xpr . xprs)
;;; ----------------------------------------
;;; recursive version of bind-let
(define-syntax bind-letrec
  (syntax-rules ()
    ((_ ((pat seq) ...) xpr . xprs)
     (bindrec (pat ...) (list seq ...) xpr . xprs))))

#|[
And here is the recursive version of bind, on which bind-letrec is
based.

  (bindrec ((o?) e?)
    (list (list (lambda (m) (if (zero? m) #f (e? (- m 1)))))
          (lambda (n) (if (zero? n) #t (o? (- n 1)))))
    (list (o? 95) (e? 95)))
  -> '(#t #f)

A simplified implementation could look like this

  (define-syntax bindrec
    (syntax-rules ()
      ((_ pat seq . body)
       ;; bind pattern variables temporarily to its names ...
       (bind pat 'pat
         ;; ... and  set! them
         (bind-set! pat seq) . body))))

but in fact we use some additional indirection like in the definition
of letrec. This indirection is supplied in the let line, where we
define an auxiliary pattern aux, which is a gensymed version of pat
]|#

;;; (bindrec pat seq xpr . xprs)
;;; ----------------------------
;;; recursive version of bind
(define-syntax bindrec
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let ((pat (cadr form)) (seq (caddr form)) (body (cdddr form)))
        (letrec (
          (gensymed
            (lambda (pat)
              (let loop ((pat pat))
                (cond
                  ((null? pat) '())
                  ((symbol? pat) (gensym pat))
                  (else
                    (cons (loop (car pat))
                          (loop (cdr pat))))))))
          )
          `(let ((aux ',(gensymed pat)))
             (bind ,pat ',pat
                (bind aux ,seq
                  (bind-set! ,pat aux)
                  ,@body))))))))

#|[ 
The next two macros are nested versions of set! and define. They allow
the simultaneous definition of procedures which have access to common
state. In fact, it suffices to implement bind-set! since Chicken
reduces define to set! anyway: try (expand '(define a 1)) to convince
yourself.  So we could implement bind-define as an alias to bind-set!
But according to the standard, set! changes existing variables, while
define defines new ones. So our definition will reflect this.

bind-set! replaces the values of symbols in a nested lambda-list in one
go with the corresponding subeseqessions of its second argument. So,
after (bind-set! (a (b (c . d))) '(1 (2 (3 4 5)))) d should have the
value (4 5), b the value 2 etc.
bind-define does the same, but defines the pattern variables before
setting them. The real advantage of this is, that we can define several
functions which rely on the same encapsulated state. Consider

  (bind-define (push top pop)
    (let ((state '()))
      (list
        (lambda (arg) (set! lst (cons arg state)))
        (lambda () (car state))
        (lambda () (set! lst (cdr state))))))

Now we have three procedures, which all operate on the encapsulated
list.

The implementation uses the bind macro, but needs some further
indirection, so that the required encapsulation of state works.
The idea is simply to map the pattern to a new pattern with gensyms as
pattern variables, then bind these new pattern variables to
subexpressions of seq via bind and then export a series of
  (set! var new-var)
expressions in bind's body.
Here we can use the same code as in the lists-only case in
list-bindings: Our bind does the appropriate destructuring of arbitrary
sequences, while list-binding's bind destructures only pseudolists.
]|#

;;; (bind-set! pat seq)
;;; -------------------
;;; destructures seq according to pat and defines pattern variables
;;; with values corresponding to subexpressions of seq
(define-syntax bind-set!
  (er-macro-transformer
    (lambda (form rename compare?)
      (let ((pat (cadr form)) (seq (caddr form)))
        (let ((aux (let recur ((pat pat))
                     (cond
                       ((null? pat) '())
                       ((symbol? pat) (gensym))
              ; rename would potentially clash with the %x below
                       ((pair? pat)
                        (cons (recur (car pat)) (recur (cdr pat)))))))
              (%bind (rename 'bind))
              (%set! (rename 'set!))
              (%let (rename 'let))
              (%x (rename 'x)))
          `(,%let ((,%x ,seq))
             (,%bind ,aux ,%x
               ,@(let recur ((pat pat) (aux aux))
                   (cond
                     ((null? pat) '())
                     ((symbol? pat) `((set! ,pat ,aux)))
                     ((pair? pat)
                      (append (recur (car pat) (car aux))
                              (recur (cdr pat) (cdr aux)))))))))))))

;;; (bind-define pat seq)
;;; ---------------------
;;; destructures seq according to pat and sets pattern variables
;;; with values corresponding to subexpressions of seq
(define-syntax bind-define
  (er-macro-transformer
    (lambda (form rename compare?)
      (let ((pat (cadr form)) (seq (caddr form)))
        (let ((aux (let recur ((pat pat))
                     (cond
                       ((null? pat) '())
                       ((symbol? pat) (gensym))
                       ((pair? pat)
                        (cons (recur (car pat)) (recur (cdr pat)))))))
              (%bind-set! (rename 'bind-set!))
              (%define (rename 'define))
              (%begin (rename 'begin)))
          `(,%begin
             (,%bind-set! ,aux ,seq)
             ,@(let recur ((pat pat) (aux aux))
                 (cond
                   ((null? pat) '())
                   ((symbol? pat) `((set! ,pat ,aux)))
                   ((pair? pat)
                    (append (recur (car pat) (car aux))
                            (recur (cdr pat) (cdr aux))))))))))))

#|[ 
Now to the generic functions.
We start with a helper, which does the search, a variant of assoc, which
might be of interest in other contexts as well.
]|#

(define (assp ok? tbl)
  (let loop ((tbl tbl))
    (cond
      ((null? tbl) #f)
      ((ok? (caar tbl)) (car tbl))
      (else (loop (cdr tbl))))))

#|[
The following two macros help to avoid repetition of code.
]|#

(define-syntax search-and-call
  (syntax-rules ()
    ((_ tbl)
     (lambda (lst)
       (let ((pair (assp (lambda (x) (x lst))
                         tbl))) ; choose method
         (if pair
           ((cdr pair) lst) ; apply it
           (error 'search-and-call "type error" lst)))))))

(define-syntax add-to-table
  (syntax-rules ()
    ((_ tbl)
     (lambda (pair)
       (set! tbl (append tbl (list pair)))))))

#|[

Generic functions are in fact closures, which search a table for a
matching operation and apply that operation in case of a match.
To be able to add new operations to that table, we must get a handle on
it. In other words, there must be other routines which operate on the
same table. define-values will come to the rescue ...
]|#

(define-values (gnull? gnull?-table gnull?-table!)
  (let ((table
          (list
            (cons list? null?)
            (cons pair? (lambda (seq) #f))
            (cons vector?  (lambda (seq) (zero? (vector-length seq))))
            (cons string? (lambda (seq) (zero? (string-length seq))))
            )))
    (values
      (search-and-call table)
      (lambda () table) ; for debugging purposes
      (add-to-table table))))

(define-values (gcar gcar-table gcar-table!)
  (let ((table
          (list
            (cons list? car)
            (cons pair? car)
            (cons vector?  (lambda (seq) (vector-ref seq 0)))
            (cons string? (lambda (seq) (string-ref seq 0)))
            )))
    (values
      (search-and-call table)
      (lambda () table) ; for debugging purposes
      (add-to-table table))))
      ;  (set! table (append table (list pair)))))))

(define-values (gcdr gcdr-table gcdr-table!)
  (let ((table
          (list
            (cons list? cdr)
            (cons pair? cdr)
            (cons vector?
                  (lambda (seq)
                    ; (subvector seq 1))) ; buggy implemetation
                    (let ((len (vector-length seq)))
                      (if (zero? (vector-length seq))
                        (error 'subvector "out of range")
                        (let* ((new-len (- len 1))
                               (result (make-vector new-len #f)))
                          (do ((k 0 (+ k 1)))
                            ((= k new-len) result)
                            (vector-set! result k
                                         (vector-ref seq (+ k 1)))))))))
            (cons string? (lambda (seq) (substring seq 1)))
            )))
    (values
      (search-and-call table)
      (lambda () table) ; for debugging purposes
      (add-to-table table))))

(define (gpair? x)
  (let ((result (gensym 'result)))
    (if (memq result
              (list
                (condition-case (gcar x)
                  ((exn) result))
                (condition-case (gcdr x)
                  ((exn) result))))
      #f
      #t)))

#|[ 
All of the generic functions above need not be exported. We will only
export the following routine, which updates the three tables in one go.
This way it's impossible to forget updating one of the three tables.
]|#

;;; (generic-null-car-cdr! type? type-null? type-car type-cdr)
;;; ----------------------------------------------------------
;;; updates the tables with tree functions in this order and index it
;;; with the type predicate type?.
(define (generic-null-car-cdr! type? type-null? type-car type-cdr)
  (gnull?-table! (cons type? type-null?))
  (gcar-table! (cons type? type-car))
  (gcdr-table! (cons type? type-cdr)))

(define bindings
  (let (
    (alist '(
      (bind
        "a variant of Common Lisp's destructuring-bind macro"
        (bind pat seq (where . fenders) .. xpr . xprs))
      (bind-set!
        "sets multiple variables by destructuring its sequence argument"
        (bind-set! pat seq))
      (bind-define
        "defines multiple variables by destructuring its sequence argument"
        (bind-define pat seq))
      (bindable?
        "returns a unary predicate, which checks if its sequence argument matches the pattern argument of bindable? and passes all optional fenders"
        (bindable? pat . fenders))
      (bind-case
        "a variant of matchable's match macro."
        (bind-case seq (pat (where . fenders) .. xpr . xprs) ....))
      (bind-lambda
        "combination of lambda and bind, one pattern argument"
        (bind-lambda pat (where . fenders) .. xpr . xprs))
      (bind-lambda*
        "combination of lambda and bind, multiple pattern arguments"
        (bind-lambda* pat (where . fenders) .. xpr . xprs))
      (bind-case-lambda
        "combination of lambda and bind-case with one pattern argument"
        (bind-case-lambda (pat (where . fenders) .. xpr . xprs) ....))
      (bind-case-lambda*
        "combination of lambda and bind-case with multiple pattern arguments"
        (bind-case-lambda* (pat (where . fenders) .. xpr . xprs) ....))
      (bind*
        "named version of bind"
        (bind* loop pat seq xpr . xprs))
      (bind-let
        "nested version of let, named and unnamed"
        (bind-let loop .. ((pat seq) ...) xpr . xprs))
      (bind-let*
        "nested version of let*"
        (bind-let ((pat seq) ...) xpr . xprs))
      (bind-letrec
        "recursive version of bind-let"
        (bind-letrec ((pat seq) ...) xpr . xprs))
      (bindrec
        "recursive version of bind"
        (bindrec pat seq . body))
      (generic-null-car-cdr!
        "command updating the table of the following generic functions"
        (generic-null-car-cdr! type? type-null? type-car type-cdr))))
      )
      (case-lambda
        (() (map car alist))
        ((sym)
         (let ((pair (assq sym alist)))
           (if pair
             (cdr pair)
             (print "Choose one of " (map car alist))))))))

) ; module bindings