#|[
 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, generic-car,
generic-cdr and generic-null? 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 generic-car generic-cdr generic-null? generic-pair?)
        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*
        ;; the generics updater must be exported for bind to be extensible
        generic-null-car-cdr!)

(import scheme
        (only data-structures list-of?)
        (only chicken condition-case case-lambda
              print error gensym))

#|[
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)
         (error 'bind
                (print seq 
                       " doesn't match pattern " 'pat
                       " with fenders " 'fenders)))))
    ((_(a . b) seq xpr . xprs)
     (let ((seq1 seq))
       (if (generic-pair? seq1)
         (bind a (generic-car seq1)
           (bind b (generic-cdr seq1) xpr . xprs))
         (error 'bind
                (print seq1 " doesn't match pattern " '(a . b))))))
    ((_ () seq xpr . xprs)
     (let ((seq1 seq))
       (if (generic-null? seq1)
         (let () xpr . xprs)
         (error 'bind
                (print seq1 " doesn't match pattern " '())))))
    ((_ 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))
         ((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)
       ((exn) (bind-case seq . clauses))))
    ((_ seq (pat (where . fenders) xpr . xprs))
     (bind pat seq (where . fenders) xpr . xprs))
    ((_ seq (pat xpr . xprs))
     (bind pat seq xpr . xprs))
    ((_ seq (pat xpr . xprs) . clauses)
     (condition-case
       (bind pat seq xpr . xprs)
       ((exn) (bind-case seq . clauses))))
    ((_ seq)
     (error 'bind-case
            (print seq " doesn't match any pattern")))
    ))

#|[
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.
In generic-null-car-cdr! we store an associative list of vectors which
store versions of null?, car and cdr for lists, pseudolists, vectors and
strings, indexed over type predicates. This list can be updated by
clients to allow other sequence types. In the tests we've done it for
tuples and records.
The generic-functions generic-null?, generic-car and generic-cdr are
defined by searching this table. They need not be exported.
]|#

;;; (generic-null-car-cdr type-predicate type-null? type-car type-cdr)
;;; ------------------------------------------------------------------
;;; updates the table with tree functions in this order and index it
;;; with the type predicate.
(define generic-null-car-cdr!
  (let (
    (table
      (list
        (cons list?
              (vector null? car cdr))
        (cons pair?
              (vector (lambda () #f) car cdr))
        (cons vector?
              (vector
                (lambda (seq) (zero? (vector-length seq)))
                (lambda (seq) (vector-ref seq 0))
                (lambda (seq) ;(subvector seq 1))))
                              ;subvector is still buggy
                  (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?
              (vector
                (lambda (seq) (zero? (string-length seq)))
                (lambda (seq) (string-ref seq 0))
                (lambda (seq) (substring seq 1))))
        ))
    )
    (lambda args
      (cond
        ;; add to table
        ((and ((list-of? procedure?) args)
              (= (length args) 4))
         (set! table
               (cons (cons (car args)
                           (apply vector (cdr args)))
                     table)))
        ;; search table
        ((= (length args) 1)
         (let loop ((tbl table))
           (cond
             ((null? tbl)
              (error 'generic-null-car-cdr!
                     (print "not in type list "
                            (map car table)
                            ": " (car args))))
             (((caar tbl) (car args))
              (cdar tbl))
             (else
               (loop (cdr tbl))))))
        (else
          (error 'generic-null-car-cdr!
                 "wrong arguments"))))))

(define (generic-null? seq)
  ((vector-ref (generic-null-car-cdr! seq) 0) seq))
(define (generic-car seq)
  ((vector-ref (generic-null-car-cdr! seq) 1) seq))
(define (generic-cdr seq)
  ((vector-ref (generic-null-car-cdr! seq) 2) seq))
(define (generic-pair? seq)
  (or (condition-case (and (generic-car seq)
                           (generic-cdr seq))
        ((exn) #f))
      #t))

(define bindings
  (let (
    (alist '(
      (bind
        "a variant of Common Lisp's destructuring-bind macro"
        (bind pat seq (where . fenders) .. xpr . xprs)
"Destructures the sequence expression seq according to the pattern pat, checking the optional fenders, binds pattern variables of pat to corresponding subexpressions of seq and executes xpr . xprs in this context")
      (bind-set!
        "sets multiple variables by destructuring its sequence argument"
        (bind-set! pat seq)
    "destructures seq according to pat and sets pattern variables with values corresponding to subexpressions of seq")
      (bind-define
        "defines multiple variables by destructuring its sequence argument"
        (bind-define pat seq)
    "destructures seq according to pat and defines pattern variables with values corresponding to subexpressions of 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) ....)
"Checks if seq matches patterns pat checking fenders in sequence, binds the pattern variables of the first matching pattern to corresponding subexpressions of seq and executes corresponding body in this context")
      (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 clause ....)
"where each clause is either of the form (pat xpr . xprs) or (pat (where . fenders) xpr . xprs) where fenders can be used to reject an otherwise matching pattern")
      (bind-case-lambda*
        "combination of lambda and bind-case with multiple pattern arguments"
        (bind-case-lambda* clause ....)
"where each clause is either of the form (pat xpr . xprs) or (pat (where . fenders) xpr . xprs) where fenders can be used to reject an otherwise matching pattern")
      (bind*
        "named version of bind"
        (bind* loop pat seq xpr . xprs)
"where loop evaluates to a one-parameter procedure to be used in xpr . xprs")
      (bind-let
        "nested version of let, named and unnamed"
        (bind-let loop .. ((pat seq) ...) xpr . xprs)
"binds pattern variables of pat ... to matching positions of seq ...  in parallel and executes xpr . xprs in this context. If loop is provided, it evaluates to a one-parameter procedure available in the body xpr . xprs")
      (bind-let*
        "sequential version of let"
        (bind-let ((pat seq) ...) xpr . xprs)
"binds pattern variables of pat ... to matching positions of seq ...  sequentially and executes xpr . xprs in this context")
      (bind-letrec
        "recursive version of bind-let"
        (bind-letrec ((pat seq) ...) xpr . xprs)
"binds pattern variables of pat ... to matching positions of seq ...  recursively and executes xpr . xprs in this context")
      (bindrec
        "recursive version of bind"
        (bindrec pat seq . body)
"like bind, but seq can contain references to pattern variables in pat")
      (generic-null-car-cdr!
        "command updating the table of the following generic functions"
        (generic-null-car-cdr! type-predicate null-proc car-proc cdr-proc))))
      )
      (case-lambda
        (() (map car alist))
        ((sym)
         (let ((pair (assq sym alist)))
           (if pair
             (cdr pair)
             (print "Choose one of " (map car alist))))))))

) ; module bindings