; 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.
It's based on the bind macro, which is a variant of Common Lisp's
destructuring bind.

It not only destructures nested pseudolists but nested sequences as
well, which can be vectors, strings, biglists or what have you, provided
you have added support for those datatypes. But that's as simple as
adding a triple seq? seq-car and seq-cdr to the generic transformer
procedure bind-listify*. As this name suggests, every sequence is
transformed to an ordinary list at each nesting level. Moreover, this
routine handles literals and dotted ends as well.

The bind macro itself uses bind-list*, a nested version of bind-list,
after having processed all literals and the wildcard, an underscore. The
rule is, the wildcard matches everything but doesn't bind anything,
whereas the literals match only itself, and, of course, don't bind
anything.

All other macros, in particular bind-case, a variant of match in the
matchable egg, are based on bind and are implemented as declarative
macros.

One difference to former versions of bind is, that it can be called
without a body which results in setting the pattern variables to
correspondig values in the nested sequence argument. In other words,
this is what was called bind! before. Hence bind! and
bind-define are expendable and code duplication is avoided. But for
convenience of use, this version is aliased bind!
]|#

(module bindings (
  bind-listify*
  bind-list
  bind-list!
  bind-list*
  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
  vector-car
  vector-cdr
  string-car
  string-cdr
  )

(import scheme
        (only (chicken condition) condition-case)
        (only (chicken base) cut subvector gensym void receive identity print case-lambda error)
        (only (chicken keyword) keyword?)
        (only (chicken format) format)
        )

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

(define vector-car (cut vector-ref <> 0))
(define vector-cdr (cut subvector <> 1))
(define string-car (cut string-ref <> 0))
(define string-cdr (cut substring <> 1))

;;; (bind-listify*)
;;; (bind-listify* seq)
;;; (bind-listify* pat seq)
;;; (bind-listify* seq? seq-car seq-cdr)
;;; ------------------------------------
;;; the first version resets the internal database,
;;; the second returns the car-cdr-pair corresponding to seq,
;;; the third does the actual work transforming seq to a nested list
;;; and the last adds support for a new sequence type.
(define bind-listify*
  (let ((db (list (cons (lambda (x) #t)
                        (cons car cdr)))))
    (case-lambda
      (() (set! db ; reset
            (list (cons (lambda (x) #t)
                        (cons car cdr)))))
      ((seq)
       (let loop ((db db))
         (if ((caar db) seq)
           (cdar db)
           (loop (cdr db)))))
      ((pat seq)
       (let ((gstop (gensym 'stop))
             (seq-car (car (bind-listify* seq)))
             (seq-cdr (cdr (bind-listify* seq)))
             (literal? (lambda (x)
                         (or (boolean? x)
                             (string? x)
                             (char? x)
                             (number? x)
                             (keyword? x))))
             )
         (let ((seq-null?
                 (lambda (seq)
                   (eq? (condition-case (seq-car seq)
                          ((exn) gstop)) gstop))))
           (let loop ((pat pat) (seq seq) (result '()))
             (cond
               ((null? pat)
                (if (seq-null? seq)
                  (reverse result)
                  (error 'bind-listify* "length mismatch" pat seq)))
               ;(reverse (cons seq result))))
               ((pair? pat)
                (let ((pfirst (car pat))
                      (prest (cdr pat))
                      (sfirst (seq-car seq))
                      (srest (seq-cdr seq)))
                  (cond
                    ((and (symbol? pfirst) (eq? pfirst '_))
                     (loop prest srest result))
                    ((symbol? pfirst)
                     (loop prest srest (cons sfirst result)))
                    ((null? pfirst) ;;;
                     (if (seq-null? sfirst)
                       (loop prest
                             srest
                             (cons (bind-listify* pfirst sfirst) result))
                       (error 'bind-listify* "length mismatch"
                              pfirst sfirst)))
                    ((pair? pfirst)
                     (loop prest
                           srest
                           (cons (bind-listify* pfirst sfirst) result)))
                    ((literal? pfirst)
                     (if (equal? pfirst sfirst)
                       (loop prest srest result)
                       (error 'bind-listify*
                              (format #f "literals ~s and ~s not equal?~%"
                                      pfirst sfirst))))
                    (else (error 'bind-listify*
                                 (format #f "~s is not a valid literal~%")
                                 pfirst))
                    )))
               (else
                 (cond
                   ((and (symbol? pat) (eq? pat '_))
                    (reverse result))
                   ((symbol? pat)
                    (reverse (cons seq result)))
                   ((literal? pat)
                    (if (equal? pat seq)
                      (reverse result)
                      (error 'bind-listify*
                              (format #f "literals ~s and ~s not equal?~%"
                                      pat seq))))
                   (else (error 'bind-listify*
                                (format #f "~s is not a valid literal~%")
                                pat))
                   )))))))
      ((seq? seq-car seq-cdr)
       (set! db (cons (cons seq?
                            (cons seq-car seq-cdr)) db)))
      )))
       

;;; (bind-list pat lst . body)
;;; --------------------------
;;; flat versions of bind (symbol-lists only)
(define-syntax bind-list
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let ((pat (cadr form)))
        (if (null? (cddr form))
          `(begin ,@(map (lambda (var)
                           `(set! ,var ',var))
                         pat))
          (let ((lst (caddr form))); (seq (gensym)))
            (if (null? (cdddr form))
              ;`(begin ,@(map (lambda (var val)
              ;                 `(set! ,var ,val))
              ;               pat (eval lst)))
              `(if (= ,(length pat) (length ,lst))
                (begin
                   ,@(let loop ((pat pat) (lst lst))
                       (if (null? pat)
                         '()
                         (cons `(set! ,(car pat) (car ,lst))
                               (loop (cdr pat) `(cdr ,lst))))))
                (error 'bind-list "length mismatch" ',pat ,lst))
              `(apply (lambda ,pat ,@(cdddr form))
                      ,lst))))))))
;(define-syntax bind-list
;  (syntax-rules ()
;    ((_ () ls)
;     (if (null? ls)
;       (if #f #f)
;       (error 'bind-list "length mismatch" '() ls)))
;    ((_ (a . as) ls)
;     (begin (set! a (car ls)) (bind-list as (cdr ls))))
;    ((_ pat)
;     (bind-list pat 'pat))
;    ((_ xs ls . body)
;     (apply (lambda xs . body) ls))
;    ))

;;; (bind-list! pat lst)
;;; (bind-list! pat)
;;; --------------------
;;; list version of bind!
(define-syntax bind-list!
  (syntax-rules ()
    ((_ pat lst)
     (bind-list pat lst))
    ((_ pat)
     (bind-list pat 'pat))
    ))

;;; (bind-list* pat seq . body)
;;; ---------------------------
;;; nested versions of bind (symbol-lists only)
(define-syntax bind-list*
  (er-macro-transformer
    (lambda (form rename compare?)
      (let ((pat (cadr form))
            (seq (caddr form))
            (body (cdddr form))
            (%_ (rename '_))
            (%let (rename 'let))
            (%set! (rename 'set!))
            (%bind (rename 'bind))
            (%apply (rename 'apply))
            (%begin (rename 'begin))
            (%lambda (rename 'lambda))
            (%bind-list (rename 'bind-list))
            (%bind-list* (rename 'bind-list*))
            )
          (let* ((pat* (map (lambda (s)
                          (if (symbol? s)
                            s
                            (cons (gensym) s)))
                        pat))
                 (flat-pat* (map (lambda (s)
                                   (if (symbol? s)
                                     s
                                     (car s)))
                                 pat*)))
            (receive (pairs syms)
              (let loop ((lst pat*) (yes '()) (no '()))
                (cond
                  ((null? lst)
                   (values (reverse yes) (reverse no)))
                  ((pair? (car lst))
                   (loop (cdr lst) (cons (car lst) yes) no))
                  ((symbol? (car lst))
                   (loop (cdr lst) yes (cons (car lst) no)))
                  (else (error 'bind "can't happen"))))
              (if (null? body)
                ;; without body
                (if (null? pairs) ; flat list
                  `(,%bind-list ,syms ,seq)
                  ;; (bind-list* (a (b c)) '(1 (2 3)))
                  ;; ->
                  ;; (begin (bind-list (a g) seq)
                  ;;        (bind-list* (b c) g))
                  `(,%begin (,%bind-list ,flat-pat* ,seq)
                            ,@(map (lambda (pair)
                                     `(,%bind ,(cdr pair) ,(car pair)))
                                   pairs)))
                ;; with body
                (let ((xpr (car body)) (xprs (cdr body)))
                  (if (null? pairs) ; flat list
                    ;`(,%apply (,%lambda ,syms ,xpr ,@xprs) ,seq) 
                    `(,%bind-list ,syms ,seq ,xpr ,@xprs)
                    ;; (bind-list* (a (b c)) '(1 (2 3)) body)
                    ;; ->
                    ;; (apply (lambda (a g) (bind-list* (b c) g body))
                    ;; seq)
                    `(,%apply
                       (,%lambda ,flat-pat*
                                 ,(let loop ((pairs pairs))
                                     (if (null? pairs)
                                       `(,%begin ,xpr ,@xprs)
                                       `(,%bind-list* ,(cdar pairs)
                                                      ,(caar pairs)
                                                      ,(loop (cdr pairs))))))
                       ,seq)
                     )))))))))

;;; (bind pat seq . body)
;;; ---------------------
(define-syntax bind
  (er-macro-transformer
    (lambda (form rename compare?)
      (let (
        (pat (cadr form))
        (seq (caddr form))
        (body (cdddr form))
        (%_ (rename '_))
        (%bind-list* (rename 'bind-list*))
        (%bind-listify* (rename 'bind-listify*))
        (literal? (lambda (x)
                    (or (boolean? x)
                        (string? x)
                        (char? x)
                        (number? x)
                        (keyword? x))))
        )
        (letrec (
          (listify*
            (lambda (pat)
              (let loop ((pat pat) (result '()))
                (cond
                  ((null? pat)
                   (reverse result))
                  ((and (symbol? pat) (compare? pat %_))
                   (reverse result))
                  ((symbol? pat)
                   (reverse (cons pat result)))
                  ((literal? pat)
                   (reverse result))
                  ((pair? pat)
                   (let ((first (car pat))
                         (rest (cdr pat)))
                     (cond
                       ((and (symbol? first)
                             (compare? first %_))
                        (loop rest result))
                       ((symbol? first)
                        (loop rest (cons first result)))
                       ((null? first) ;;;
                        (loop rest (cons first result)))
                       ((pair? first)
                        (loop rest (cons (listify* first) result)))
                       ((literal? first)
                        (loop rest result))
                       )))))))
          )
          (if (null? body)
            ;; without body
            `(,%bind-list* ,(listify* pat)
                           (,%bind-listify* ',pat ,seq))
            ;; with body
            (let ((xpr (car body)) (xprs (cdr body)))
              `(,%bind-list* ,(listify* pat)
                             (,%bind-listify* ',pat ,seq)
                             ,xpr ,@xprs)))
          )))))

;;; (bind! pat seq)
;;; (bind! pat)
;;; ---------------
;;; alias to bind without body
(define-syntax bind!
  (syntax-rules ()
    ((_ pat seq)
     (bind pat seq))
    ((_ pat)
     (bind 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 (bind pat seq (and fender ...))
       ((exn) #f)))
    ((_ pat seq)
     (condition-case (bind pat seq #t)
       ((exn) #f)))
    ;; curried versions
    ((_ pat (where fender ...))
     (lambda (seq)
       (bindable? pat (where fender ...) seq)))
    ((_ pat)
     (lambda (seq)
       (bindable? pat seq)))
    ))

#|[
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) (>> y list?) (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)
       (bind 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)
       (bind 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)
       (bind pat seq xpr . xprs)
       (bind-case seq . clauses)))
    ((_ seq (pat xpr . xprs) . clauses)
     (if (bindable? pat seq)
       (bind 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) (bind 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 (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 (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)
     (bind pat seq xpr . xprs))
    ((_ ((pat seq) (pat1 seq1) ...) xpr . xprs)
     (bind 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)
     (bind (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)
     (bind 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 '(
    (bindings
      procedure:
      (bindings sym ..)
      "documentation procedure")
    (bind-listify*
      generic procedure:
      (bind-listify*)
      "resets the internal database for lists only"
      (bind-listify* seq)
      "returns the car-cdr-pair corresponding to seq"
      (bind-listify* pat seq)
      "transforms the nested pseudolist seq to a nested list"
      (bind-listify* seq? seq-car seq-cdr)
      "adds support for a new sequence type to the"
      "internal database")
    (bind-list
      macro:
      (bind-list pat lst . body)
      "flat version of bind: destructure symbol-lists only")
    (bind-list!
      macro:
      (bind-list! pat lst)
      "alias to bind-list wtihout body"
      (bind-list! pat)
      "alias to (bind-list! pat 'pat)")
    (bind-list*
      macro:
      (bind-list* pat seq . body)
      "nested version of bind: destructure symbol-lists only"
      "multiple set!s without")
    (bind
      macro:
      (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")
    (vector-car
      procedure:
      (vector-car vec)
      "vector-analog of car")
    (vector-cdr
      procedure:
      (vector-cdr vec)
      "vector-analog of cdr")
    (string-car
      procedure:
      (string-car vec)
      "string-analog of car")
    (string-cdr
      procedure:
      (string-cdr vec)
      "string-analog of cdr")
    )))

) ; module