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

Copyright (c) 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.

This module provides simplyfied versions of some of the bindings
macros, restricting destructuring to nested list expressions, as well
as macros making the writing of low-level-macros easy.
]|# 

(module list-bindings
  (export list-bindings bind-define bind-set! bind bindable? bind-lambda
          bind-case bind/cc bind-let bind-let* define-syntax-rule
          with-gensyms once-only define-macro let-macro letrec-macro
          (macro-rules strip))
  (import scheme
          (only chicken condition-case error)
          (only extras format))

#|[
Binding macros
==============
]|# 

;;; (bindable? pat)
;;; ---------------
;;; returns a procedure, which checks, if subexpressions of its only
;;; agument, tpl, are bindable to the pattern variables of pat.
(define-syntax bindable?
  (syntax-rules ()
    ((_ (a . b))
     (lambda (seq)
       (and (pair? seq)
            ((bindable? a) (car seq))
            ((bindable? b) (cdr seq)))))
    ((_ ())
     (lambda (seq) (null? seq)))
    ((_ a) (lambda (seq) #t))))

;;; (bind pat seq . body)
;;; --------------------------
;;; Common Lisp's destructuring-bind:
;;; binds pattern variables of pat to corresponding subexpression of
;;; seq and evalueates body in this context
(define-syntax bind
  (syntax-rules ()
    ((_(a . b) seq xpr . xprs)
     (if (pair? seq)
       (bind a (car seq) (bind b (cdr seq) xpr . xprs))
       (error 'bind
              (format #f "template ~s doesn't match pattern ~s"
                      seq '(a . b)))))
    ((_ () seq xpr . xprs)
     (if (null? seq)
       (let () xpr . xprs)
       (error 'bind
              (format #f "template ~s doesn't match pattern ~s"
                      seq '()))))
    ((_ a seq xpr . xprs)
     (let ((a seq)) xpr . xprs))))
;(define-syntax bind
;  (ir-macro-transformer
;    (lambda (form inject compare?)
;      (let ((pat (cadr form))
;            (seq (caddr form))
;            (xpr (cadddr form))
;            (xprs (cddddr form)))
;        `(if ((bindable? ,pat) ,seq)
;          (let
;             ,(map (lambda (ks)
;                     `(,(apply tree-ref pat ks)
;                        (tree-ref ,seq ,@(quote-last ks))))
;                   (pindex pat))
;             ,xpr ,@xprs)
;          (error 'bind
;                 (format #f "template ~s doesn't match pattern ~s"
;                         ,seq ',pat)))))))
;(define-syntax bind
;  (er-macro-transformer
;    (lambda (form rename compare?)
;      (let ((pat (cadr form))
;            (seq (caddr form))
;            (xpr (cadddr form))
;            (xprs (cddddr form))
;            (%if (rename 'if))
;            (%let (rename 'let))
;            (%error (rename 'error))
;            (%format (rename 'format))
;            (%bindable? (rename 'bindable?))
;            (%tree-ref (rename 'tree-ref)))
;        `(,%if ((,%bindable? ,pat) ,seq)
;          (,%let
;             ,(map (lambda (ks)
;                     `(,(apply tree-ref pat ks)
;                        (,%tree-ref ,seq ,@(quote-last ks))))
;                   (pindex pat))
;             ,xpr ,@xprs)
;          (,%error 'bind
;                   (,%format #f "template ~s doesn't match pattern ~s"
;                             ,seq ',pat)))))))

;;; (bind-lambda pat xpr . xprs)
;;; ------------------------------
;;; Combination of bind and lambda
(define-syntax bind-lambda
  (syntax-rules ()
    ((_ pat xpr . xprs)
     (lambda (x)
       (bind pat x xpr . xprs)))))

;;; (bind-case seq (pat xpr . xprs) ....)
;;; -------------------------------------
;;; Checks if seq matches pattern pat in sequence, binds the pattern
;;; variables of the first matching pattern to corresponding sublists of
;;; seq and executes corresponding body xpr . xprs
(define-syntax bind-case
  (syntax-rules ()
    ((_ seq (pat0  xpr0 . xprs0) (pat1 xpr1 . xprs1) ...)
     (cond
       (((bindable? pat0) seq)
        (bind pat0 seq  xpr0 . xprs0))
       (((bindable? pat1) seq)
        (bind pat1 seq  xpr1 . xprs1))
       ...
       (else
         (error 'bind-case (format #f "template ~s doesn't match any of the patterns ~s"
                                   seq '(pat0 pat1 ...))))))))

#|[ 
The next two macros provide simultaneous setting and defining of pattern
variables to subexpressions of a template. The following first try would
perfectly work, if seq is simply a list, but not if it is a list wrapped
by a let storing common state. But the latter is the most often used
case of bind-define.

(define-syntax bind-define
  (syntax-rules ()
    ((_ (a . b) seq)
     (begin
       (bind-define a (car seq))
       (bind-define b (cdr seq))))
    ((_ () seq)
     (if (null? seq) (void) (error 'bind-define "match error")))
    ((_ a seq)
     (define a seq))))

What we need is one further indirection provided in the following
versions, which first map the pattern, pat, to some auxiliary pattern,
aux, of the same form with gensym.
In bind-set! the template, seq, is then bound to some variable x which
in turn can be bound to aux in the macro expansion. Since we used gensym
instead of rename above, there will be no name-clash - rename is
referentially transparent!
We could have used implicit-renaming macros as well, but then the
gensyms would be automatically renamed again, which isn't necessary.
Note, that there is some code duplication in the two macros below, which
could have been avoided by defining two helpers, pmap and pflatten, in a
separate helper module which must be imported for syntax. I've done this
in a former version.
]|#

;;; (bind-set! pat seq)
;;; -------------------
;;; sets pattern variables of the pattern pat to corresponding
;;; subexpressions of the template 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))
                       ((pair? pat)
                        (cons (recur (car pat)) (recur (cdr pat)))))))
              ; rename would potentially clash with the %x below
              (%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)))))))))))))
;(define-syntax bind-set!
;  (ir-macro-transformer
;    (lambda (form inject compare?)
;      (let ((pat (cadr form)) (seq (caddr form)))
;        (let ((aux (pmap gensym pat)))
;          `(let ((x ,seq))
;             (bind ,aux x
;               ,@(map (lambda (p a) `(set! ,p ,a))
;                      (pflatten pat) (pflatten aux)))))))))

;;; (bind-define pat seq)
;;; ---------------------
;;; defines pattern variables of the pattern pat by setting them to
;;; corresponding subexpressions of the template 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))))))))))))
;(define-syntax bind-define
;  (ir-macro-transformer
;    (lambda (form inject compare?)
;      (let ((pat (cadr form)) (seq (caddr form)))
;        (let ((aux (pmap gensym pat)))
;          `(begin
;             (bind-set! ,aux ,seq)
;             ,@(map (lambda (p a) `(define ,p ,a))
;                    (pflatten pat) (pflatten aux))))))))

;;; (bind-let* ((pat seq) ...) xpr . xprs)
;;; --------------------------------------
(define-syntax bind-let*
  (syntax-rules ()
    ((_ () xpr . xprs)
     (let () xpr . xprs))
    ((_ ((pat0 seq0) (pat1 seq1) ...) xpr . xprs)
     (bind pat0 seq0
       (bind-let* ((pat1 seq1) ...) xpr . xprs)))))

;;; (bind-let ((pat seq) ...) xpr . xprs)
;;; -------------------------------------
(define-syntax bind-let
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let ((binds (cadr form))
            (xpr (caddr form))
            (xprs (cdddr form)))
        (let ((syms (map (lambda (x) (gensym)) binds)))
          `(bind ,syms ,(cons 'list (map cadr binds))
             (bind-let* ,(map (lambda (p s) `(,p ,s))
                              (map car binds)
                              syms)
               ,xpr ,@xprs)))))))

;;; (bind/cc k xpr . xprs)
;;; ----------------------
(define-syntax bind/cc
  (syntax-rules ()
    ((_ k xpr . xprs)
     (call-with-current-continuation
       (lambda (k) xpr . xprs)))))

#|[
Low-level-macros made easy
==========================
As an application of our binding macros, especially bind, we will now
provide macros define-macro, letrec-macro and let-macro to make
low-level macros easy.

The following two macros are internal. They are only used in
define-macro below
]|#

;;; (define-ir-macro (name . args)
;;;   (injecting (identifier ...)
;;;     (comparing ()|(suffix . suffixed-keywords)
;;;       . body)))
;;; -------------------------------------------------
(define-syntax define-ir-macro
  (ir-macro-transformer
    (lambda (f i c?)
      (let ((macro-code (cadr f))
            (inject-xpr (caddr f))
            (strip-suffix
              (lambda (suf id)
                (let ((sufstring (symbol->string suf))
                      (idstring (symbol->string id)))
                  (string->symbol
                    (substring idstring
                               0 
                               (- (string-length idstring)
                                  (string-length sufstring))))))))
        (let ((name (car macro-code))
              (args (cdr macro-code))
              (identifiers (cadr inject-xpr))
              (compare-xpr (caddr inject-xpr)))
          (let ((predicates (cadr compare-xpr))
                (body (caddr compare-xpr)))
            (cond
              ((and (null? identifiers) (null? predicates))
               `(define-syntax ,name
                  (ir-macro-transformer
                    (lambda (form inject compare?)
                      (bind ,args (cdr form)
                        ,body)))))
              ((null? predicates)
               `(define-syntax ,name
                  (ir-macro-transformer
                    (lambda (form inject compare?)
                      (bind ,args (cdr form)
                        (bind ,identifiers (map inject ',identifiers)
                          ,body))))))
              (else
                (let ((suffix (car predicates))
                      (suffixed-keywords (cdr predicates)))
                  (let ((syms (map (lambda (id) (strip-suffix suffix id))
                                   suffixed-keywords)))
                    (if (null? identifiers)
                      `(define-syntax ,name
                         (ir-macro-transformer
                           (lambda (form inject compare?)
                             (bind ,args (cdr form)
                               (bind ,suffixed-keywords
                                 (list ,@(map (lambda (s)
                                                `(lambda (n)
                                                   (compare? n ',(i s))))
                                              syms))
                                 ,body)))))
                      `(define-syntax ,name
                         (ir-macro-transformer
                           (lambda (form inject compare?)
                             (bind ,args (cdr form)
                               (bind ,identifiers (map inject ',identifiers)
                                 (bind ,suffixed-keywords
                                   (list ,@(map (lambda (s)
                                                  `(lambda (n)
                                                     (compare? n ',(i s))))
                                                syms))
                                   ,body)))))))))))))))))

;;; (define-er-macro (name . args)
;;;   (renaming (prefix . prefixed-identifiers)
;;;     (comparing ()|(suffix . suffixed-keywords)
;;;     . body)))
;;; -------------------------------------------------
(define-syntax define-er-macro
  (er-macro-transformer
    (lambda (f r c?)
      (let ((macro-code (cadr f))
            (rename-xpr (caddr f))
            (strip-prefix (lambda (pre id)
                            (string->symbol
                              (substring (symbol->string id)
                                         (string-length
                                           (symbol->string pre))))))
            (strip-suffix
              (lambda (suf id)
                (let ((sufstring (symbol->string suf))
                      (idstring (symbol->string id)))
                  (string->symbol
                    (substring idstring
                               0 
                               (- (string-length idstring)
                                  (string-length sufstring))))))))
        (let ((name (car macro-code))
              (args (cdr macro-code))
              (prefix (caadr rename-xpr))
              (prefixed-identifiers (cdadr rename-xpr))
              (compare-xpr (caddr rename-xpr)))
          (let ((identifiers (map (lambda (id) (strip-prefix prefix id))
                                  prefixed-identifiers))
                (predicates (cadr compare-xpr))
                (body (caddr compare-xpr))
                (%er-macro-transformer (r 'er-macro-transformer))
                (%define-syntax (r 'define-syntax))
                (%compare? (r 'compare?))
                (%rename (r 'rename))
                (%lambda (r 'lambda))
                (%bind (r 'bind))
                (%list (r 'list))
                (%form (r 'form))
                (%cdr (r 'cdr))
                (%map (r 'map)))
            (if (null? predicates)
              `(,%define-syntax ,name
                  (,%er-macro-transformer
                    (,%lambda (,%form ,%rename ,%compare?)
                      (,%bind ,args (,%cdr ,%form)
                              (,%bind ,prefixed-identifiers
                                      (,%map ,%rename ',identifiers)
                                ,body)))))
              (let ((suffix (car predicates))
                    (suffixed-keywords (cdr predicates)))
                (let ((syms (map (lambda (id) (strip-suffix suffix id))
                                 suffixed-keywords)))
                  `(,%define-syntax ,name
                      (,%er-macro-transformer
                        (,%lambda (,%form ,%rename ,%compare?)
                          (,%bind ,args (,%cdr ,%form)
                            (,%bind ,prefixed-identifiers
                                    (,%map ,%rename ',identifiers)
                              (,%bind ,suffixed-keywords
                                      (,%list ,@(map (lambda (s)
                                                       `(lambda (n)
                                                          (,%compare? n (,%rename ',s))))
                                                     syms))
                                      ,body)))))))))))))))

;;; (define-macro (name . args)
;;;   [(injecting (identifier ...) | (renaming (prefix . prefixed-identifiers))]
;;;     [(comaring (suffix . suffixed-keywords)]
;;;       . body)))
;;; ----------------------------------------------------------------------------
(define-syntax define-macro
  (ir-macro-transformer 
    (lambda (form inject compare?)
      (if (not (= (length form) 3))
        (error 'define-macro "macro-code doesn't match pattern"
               '(_ macro-code body))
        (let ((macro-code (cadr form)) (body (caddr form)))
          ;; create standard body
          (let ((body (if (and (list? body)
                               (= (length body) 3)
                               (list? (cadr body)))
                        (cond
                          ((compare? (car body) 'comparing)
                           `(injecting () ,body))
                          ((compare? (car body) 'injecting)
                           (let ((rest (caddr body)))
                             (if (and (list? rest)
                                      (= (length rest) 3)
                                      (list? (cadr rest))
                                      (compare? (car rest) 'comparing))
                               body
                               `(injecting ,(cadr body)
                                  (comparing () ,(caddr body))))))
                          ((compare? (car body) 'renaming)
                           (let ((rest (caddr body)))
                             (if (and (list? rest)
                                      (= (length rest) 3)
                                      (list? (cadr rest))
                                      (compare? (car rest) 'comparing))
                               body
                               `(renaming ,(cadr body)
                                 (comparing () ,(caddr body))))))
                          (else
                           `(injecting ()
                              (comparing () ,body))))
                            ;(error 'define-macro "not a macro body" body)))
                        `(injecting ()
                          (comparing () ,body)))))
            (if (compare? (car body) 'injecting)
              `(define-ir-macro ,macro-code ,body)
              `(define-er-macro ,macro-code ,body))))))))

;;; (letrec-macro ((macro-code tpl) ...) . body)
;;; --------------------------------------------
;;; defines local macros by binding recursively macro-codes to templates
;;; and evaluating body in this context.
(define-syntax letrec-macro
  (er-macro-transformer
    (lambda (f r c?)
      (let ((binds (cadr f))
            (body (cddr f))
            (%letrec-syntax (r 'letrec-syntax)))
        `(,%letrec-syntax
           ,(map (lambda (m)
                   `(,(cadr m) ,(caddr m)))
                 (map (lambda (b)
                        (expand `(define-macro ,@b)))
                      binds))
           ,@body)))))

;;; (let-macro ((macro-code tpl) ...) . body)
;;; -----------------------------------------
;;; defines local macros by binding in parallel macro-codes to templates
;;; and evaluating body in this context.
(define-syntax let-macro
  (er-macro-transformer
    (lambda (f r c?)
      (let ((binds (cadr f))
            (body (cddr f))
            (%let-syntax (r 'let-syntax)))
        `(,%let-syntax
           ,(map (lambda (m)
                   `(,(cadr m) ,(caddr m)))
                 (map (lambda (b)
                        (expand `(define-macro ,@b)))
                      binds))
           ,@body)))))

;;; (macro-rules sym ... (suffix suffixed-keyword ...)
;;;   (pat0 tpl0) (pat1 tpl1) ...)
;;; --------------------------------------------------
;;; where sym ... are injected non-hygienig symbols, the keyword-list is
;;; either empty or of the form (? sym? ...) with a predicates sym? ...
;;; checking for their own names with the suffix ? stripped, pat0 pat1
;;; ... are nested lambda-lists without spezial meaning of ellipses and
;;; tpl0 tpl1 ... evaluate to quasiquoted templates.
(define-syntax macro-rules
  (ir-macro-transformer
    (lambda (f i c?)
      ;; head is list of injected syms, tail starts with keyword-list
      (let (
        (tail-head
          (call-with-values
            (lambda ()
              (let loop ((tail (cdr f)) (head '()))
                (if (or (null? tail) (list? (car tail)))
                  (values tail head)
                  (loop (cdr tail) (cons (car tail) head)))))
            list))
        )
        (let ((tail (car tail-head)) (head (cadr tail-head)))
          (let ((keywords (car tail)) (rule (cadr tail)) (rules (cddr tail)))
            (let (
              (keyword-query (lambda (skey)
                               `(,skey (lambda (x)
                                         (compare? x
                                                   (strip ',(car keywords)
                                                          ',skey))))))
              (inject-it (lambda (h) `(,h (inject ',h))))
              )
              (cond
                ((and (null? head) (null? keywords))
                 ; no injected symbols, no additional keywords
                 `(ir-macro-transformer
                    (lambda (form inject compare?)
                      (bind-case form ,rule ,@rules))))
                ((null? head)
                 ; no injected symbols
                 `(ir-macro-transformer
                    (lambda (form inject compare?)
                      (let ,(map keyword-query
                                 (cdr keywords))
                        (bind-case form ,rule ,@rules)))))
                ((null? keywords)
                 ;; no additional keywords
                 `(ir-macro-transformer
                    (lambda (form inject compare?)
                      (let ,(map inject-it head)
                        (bind-case form ,rule ,@rules)))))
                (else
                  `(ir-macro-transformer
                     (lambda (form inject compare?)
                       (let ,(append
                               (map inject-it head)
                               (map keyword-query (cdr keywords)))
                         (bind-case form ,rule ,@rules)))))))))))))
  ;; unfortunately, this simpler implementation doesn't work because of
  ;; two ellipses at the same nesting level
  ;  (syntax-rules ()
  ;    ((_ injected-sym ... (suffix suffixed-keyword ...)
  ;        ((pat0 tpl0)
  ;        (pat1 tpl1)
  ;        ...)
  ;     (ir-macro-transformer
  ;         (lambda (form inject compare?)
  ;           (let ((injected-sym (inject 'injected-sym))
  ;                 ...
  ;                 (suffixed-keyword
  ;                   (lambda (x) (compare? x (strip suffix
  ;                                                  suffixed-keyword))))
  ;                 ...)
  ;             (bind-case form
  ;               (pat0 tpl0) (pat1 tpl1) ...)))))
  ;    ((_ sym ... () (pat0 tpl0) (pat1 tpl1) ...)
  ;     (ir-macro-transformer sym ... (suffix) (pat0 tpl0) (pat1 tpl1) ...))
  ;    ))

(define (strip s skey)
  (let ((s-str (symbol->string s))
        (skey-str (symbol->string skey)))
    (string->symbol
      (substring skey-str 0 (- (string-length skey-str)
                               (string-length s-str))))))

#|[
The following three macros are here for convenience. The first two are of great
help in writing low-level-macros, the last ony simplifies high-level
macros without additional keywords and only one rule.
]|#

;;; (once-only (x ...) . body)
;;; --------------------------
;;; macro-arguments x ... are only evaluated once and from left to right
(define-syntax once-only  ; ok
  (er-macro-transformer
    (lambda (form rename compare?)
      (let ((names (cadr form))
            (body (cddr form))
            (%let (rename 'let))
            (%list (rename 'list))
            (%gensym (rename 'gensym)))
        (let ((gensyms (map gensym names)))
          `(,%let ,(map (lambda (g) `(,g (,%gensym))) gensyms)
             (,%list ',%let ,(cons %list
                               (map (lambda (g n) `(,%list ,g ,n))
                                    gensyms names))
                (,%let ,(map (lambda (n g) `(,n ,g)) names gensyms)
                   ,@body))))))))
;(define-macro (once-only names xpr . xprs)
;  (let ((gensyms (map gensym names)))
;    `(let ,(map (lambda (g) `(,g (gensym))) gensyms)
;            (list 'let ,(cons list
;                                  (map (lambda (g n) `(list ,g ,n))
;                                       gensyms names))
;                    (let ,(map (lambda (n g) `(,n ,g)) names gensyms)
;                           ,xpr ,@xprs)))))

;;; (with-gensyms (name ...) . body)
;;; --------------------------------
;;; binds name ... to (gensym 'name) ... in body
(define-syntax with-gensyms
  (ir-macro-transformer
    (lambda (form inject compare?)
      `(let ,(map (lambda (n) `(,n (gensym ',n))) (cadr form))
         ,@(cddr form)))))

;;; (define-syntax-rule (macro-code) tpl)
;;; -------------------------------------
;;; simplyfies define-syntax in case there are no auxiliary keywords
;;; and only one syntax-rule.
(define-syntax define-syntax-rule
  (syntax-rules ()
    ((_ (name . args) tpl)
     (define-syntax name
       (syntax-rules ()
         ((_ . args) tpl))))))

(define (list-bindings)
  '(bind-define bind-set! bind bind-lambda bind-let* bind-let bind-case bindable? bind/cc
    macro-rules define-macro let-macro letrec-macro define-syntax-rule
    once-only with-gensyms))

) ; module list-bindings