; Copyright (c) 2020-2021 , Juergen Lorenz, ju (at) jugilo (dot) de
; 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 is a variant of Mario's callable-datastructures. But contrary to
that egg, I don't consider hash-tables, but only ordered sequences. So
it makes sense, to define slices. Moreover, I'll consider nested
sequences as well.

Central to this module is a generic procedure, sequence-constructors, which
stores a local database initially supporting lists, pseudolists, vectors
and strings. But this database can be enhanced, by adding generic
constructors, make-sas-callable or make-ras-callable for sequential or
random access sequences respectively, the former following the list
pattern, the latter the vector pattern.

Based on this, the most important procedure is make-callable, which
transforms an ordinary into a callable-sequence, i.e. a procedure of
zero, one or two arguments. With no argument, this returns i.a. the
encapsulated sequence, with one, an index, the value of that sequence at
the index and with two a slice between its two index arguments, in
either direction, the first included, the second excluded. For
convenience, the argument #f is allowed in slices, representing the
length.

So, for example, if vec is (make-callable #(0 1 2 3 4 5)), then
(vec 1 4) or (vec 4 1) are callable-sequences encapsulating #(1 2 3)
or #(4 3 2) respectively, and (vec 3 #f) or (vec #f 3) encapsulate
#(3 4 5) or #(5 4) respectively.

]|#

(module callable-sequences (
  make-sas-callable
  callable-sas?
  make-ras-callable
  callable-ras?
  sequence?
  sequence-constructors
  make-callable
  callable?
  callable-null?
  callable-flat?
  callable-length
  callable-nil
  callable-data
  callable-indices
  callable-copy
  callable-map
  callable-for-each
  callable-filter
  callable-reverse
  callable-append
  callable-collect
  callable-data*
  callable-map*
  make-callable*
  callable-sequences
  )

(import scheme
        (only (chicken base) atom? receive gensym print error case-lambda)
        (only (chicken format) format)
        (only (chicken condition) condition-case)
        )

(define (sas-nil seq seq-cons seq-car seq-cdr seq-null?)
  (let loop ((seq seq))
    (if (seq-null? seq)
      seq
      (loop (cdr seq)))))

(define (ras-nil seq make-seq seq-ref seq-set! seq-length)
  (make-seq 0))

(define (sas-reverse seq seq1 seq-cons seq-car seq-cdr seq-null?)
  (let loop ((seq seq)
             (result seq1));(sas-nil seq seq-cons seq-car seq-cdr seq-null?)))
    (if (seq-null? seq)
      result
      (loop (seq-cdr seq)
            (seq-cons (seq-car seq) result)))))

(define (ras-reverse seq seq1 make-seq seq-ref seq-set! seq-length)
  (let ((len0 (seq-length seq)) (len1 (seq-length seq1)))
    (let* ((len (+ len0 len1)) (result (make-seq len)))
      (do ((k 0 (+ k 1)))
        ((= k len) result)
        (if (< k len0)
          (seq-set! result (- len0 k 1) (seq-ref seq k))
          (seq-set! result k (seq-ref seq (- k len0))))))))

(define (sas-map fn seq seq-cons seq-car seq-cdr seq-null?)
  (let recur ((seq seq))
    (if (seq-null? seq)
      seq
      (seq-cons (fn (seq-car seq)) (recur (seq-cdr seq))))))

(define (ras-map fn seq make-seq seq-ref seq-set! seq-length)
  (let* ((len (seq-length seq)) (result (make-seq len))) 
    (do ((i 0 (+ i 1)))
      ((= i len) result)
      (seq-set! result i (fn (seq-ref seq i))))))

(define (sas-filter ok? seq seq-cons seq-car seq-cdr seq-null?)
  (let loop ((seq seq)
             (seq-yes (sas-nil seq seq-cons seq-car seq-cdr seq-null?))
             (seq-no (sas-nil seq seq-cons seq-car seq-cdr seq-null?)))
    (cond
      ((seq-null? seq)
       (values (sas-reverse seq-yes seq-yes seq-cons seq-car seq-cdr seq-null?)
               (sas-reverse seq-no seq-no seq-cons seq-car seq-cdr seq-null?)))
      ((ok? (seq-car seq))
       (loop (seq-cdr seq) (seq-cons (seq-car seq) seq-yes) seq-no))
      (else
       (loop (seq-cdr seq) seq-yes (seq-cons (seq-car seq) seq-no))))))

(define (ras-filter ok? seq make-seq seq-ref seq-set! seq-length)
  (let ((len (seq-length seq)))
    (receive (yes# no#)
      (let loop ((k 0) (yes 0) (no 0))
        (cond
          ((= k len)
           (values yes no))
          ((ok? (seq-ref seq k))
           (loop (+ k 1) (+ yes 1) no))
          (else
           (loop (+ k 1) yes (+ no 1)))
          ))
      (let ((seq-yes (make-seq yes#)) (seq-no (make-seq no#)))
        (do ((k 0 (+ k 1))
             (l 0)
             (m 0))
          ((= k len) (values seq-yes seq-no))
          (if (ok? (seq-ref seq k))
            (begin 
              (seq-set! seq-yes l (seq-ref seq k))
              (set! l (+ l 1)))
            (begin 
              (seq-set! seq-no m (seq-ref seq k))
              (set! m (+ m 1)))))))))

(define (sas-append seq seq1 seq-cons seq-car seq-cdr seq-null?)
  (let recur ((seq seq))
    (if (seq-null? seq)
      seq1
      (seq-cons (seq-car seq) (recur (seq-cdr seq))))))

;; seq and seq1 must be of same type
(define (ras-append seq seq1 make-seq seq-ref seq-set! seq-length)
  (let ((len (seq-length seq)) (len1 (seq-length seq1)))
    (let ((result (make-seq (+ len len1))))
      (do ((k 0 (+ k 1)))
        ((= k (+ len len1)) result)
        (seq-set! result k (if (< k len)
                             (seq-ref seq k)
                             (seq-ref seq1 (- k len))))
        ))))

#|[
(make-sas-callable seq seq-cons seq-car seq-cdr seq-null?)
--- procedure ---
sequential access constructor with arguments similar to lists
]|#
(define make-sas-callable 'make-sas-callable)

#|[
(callable-sas? xpr)
--- procedure ---
evaluates xpr to a sequential access callable-sequence?
]|#
(define callable-sas? 'callable-sas?)

#|[
(make-ras-callable seq make-seq seq-ref seq-set! seq-length)
--- procedure ---
random access constructor with arguments similar to vectors
]|#
(define make-ras-callable 'make-ras-callable)

#|[
(callable-ras? xpr)
--- procedure ---
evaluates xpr to a random access callable-sequence?
]|#
(define callable-ras? 'callable-ras?)

;; implementation of the four procedures above
(let ((in (gensym 'in)) (sas (gensym 'sas)) (ras (gensym 'ras)))
  (set! make-sas-callable
    (lambda (seq seq-cons seq-car seq-cdr seq-null?)
      (let maker ((seq seq))
        (receive (nil len)
          (let loop ((seq seq) (k 0))
            (if (seq-null? seq)
              (values seq k)
              (loop (seq-cdr seq) (+ k 1))))
          (case-lambda
            (()
             (values seq seq-cons seq-car seq-cdr seq-null?))
            ((k)
             (cond
               ((and (integer? k) (>= k 0) (< k len))
                (let loop ((seq seq) (n 0))
                  (if (= n k)
                    (seq-car seq)
                    (loop (seq-cdr seq) (+ n 1)))))
               ((and (symbol? k) (eq? k in))
                sas)
               (else
                 (error 'make-sas-callable
                        (format #f
                                "k=~A is out of range for length=~A~%"
                                k len)))))
            ((k l)
             (let ((revers
                     (lambda (seq)
                       (let loop ((seq seq) (result nil))
                         (if (seq-null? seq)
                           (make-callable result)
                           (loop (seq-cdr seq)
                                 (seq-cons (seq-car seq)
                                           result)))))))
               (cond
                 ((and (integer? k) (integer? l)
                       (>= k 0) (<= k l) (<= l len))
                  (maker
                    (let recur ((seq seq) (n 0))
                      (cond
                        ((= n l) nil)
                        ((and (>= n k) (< n l))
                         (seq-cons (seq-car seq) (recur (seq-cdr seq) (+ n 1))))
                        (else
                          (recur (seq-cdr seq) (+ n 1)))))
                    ))
                 ((and (integer? k) (not l) (>= k 0))
                  ((maker seq) k len))
                 ((and (integer? k) (integer? l)
                       (>= l -1) (< l k) (< k len))
                  (revers (((maker seq) (+ l 1) (+ k 1)))))
                 ((and (not k) (integer? l) (>= l -1))
                  (revers (((maker seq) (+ l 1) k))))
                 (else
                   (error 'make-sas-callable
                          (format #f
                                  "at least k=~A or l=~A is out of range for length=~A~%"
                                  k l len)))))
            ))))))
  (set! callable-sas?
    (lambda (xpr)
      (and (procedure? xpr)
           (eqv? (condition-case (xpr in)
                   ((exn) #f))
                 sas))))
  (set! make-ras-callable
    (lambda (seq make-seq seq-ref seq-set! seq-length)
      (let maker ((seq seq))
        (let ((len (seq-length seq)))
          (case-lambda
            (() (values seq make-seq seq-ref seq-set! seq-length))
            ((k)
             (cond
               ((and (integer? k) (>= k 0) (< k len))
                (seq-ref seq k))
               ((and (symbol? k) (eq? k in))
                ras)
               (else
                 (error 'make-ras-callable
                        (format #f
                                "k=~A is out of range for length=~A~%"
                                k len)))))
            ((k l)
             (cond
               ((and (integer? k) (integer? l)
                     (>= k 0) (<= k l) (<= l len))
                (let ((result (make-seq (- l k))))
                  (do ((n k (+ n 1)))
                    ((= n l) (maker result))
                    (seq-set! result (- n k) (seq-ref seq n))))) 
               ((and (integer? k) (not l) (>= k 0))
                ((maker seq) k len))
               ((and (integer? k) (integer? l)
                     (>= l -1) (< l k) (< k len))
                (let ((result (make-seq (- k l))))
                  (do ((n k (- n 1)))
                    ((= n l) (maker result))
                    (seq-set! result (- k n) (seq-ref seq n))))) 
               ((and (not k) (integer? l) (>= l -1))
                (let ((result (make-seq (- len l 1))))
                  (do ((n (- len 1) (- n 1)))
                    ((= n l) (maker result))
                    (seq-set! result (- len n 1) (seq-ref seq n)))))
               (else
                 (error 'make-ras-callable
                        (format #f
                                "at least k=~A or l=~A is out of range for length=~A~%"
                                k l len)))))
            )))))
  (set! callable-ras?
    (lambda (xpr)
      (and (procedure? xpr)
           (eqv? (condition-case (xpr in)
                   ((exn) #f))
                 ras))))
  )

#|[
(sequence? xpr)
--- procedure ---
evaluates xpr to a sequence type, initially a list, pseudolist, vector
or string.
To be updated, if new sequence types are added.
]|#
(define (sequence? xpr)
  ;; standard sequences, to be updated by sequence-constructors
  (or (list? xpr)
      (pair? xpr)
      (vector? xpr)
      (string? xpr)))

#|[
(sequence-constructors)
(sequence-constructors seq)
(sequence-constructors sym)
--- procedure ---
the first resets the internal database and the sequence? predicate,
the second selects and returns the constructor corresponding to the sequence
argument,
and the third adds a new sequential-access or random-access constructor,
according to the symbol 'sas or 'ras. sequence? is updated as well.
]|#
(define sequence-constructors
  (let* (
    (standard-db
      (list
        (cons list?
              (lambda (seq)
                (make-sas-callable seq
                                   cons
                                   car
                                   cdr
                                   null?)))
        (cons pair?
              (lambda (seq)
                (make-sas-callable seq
                                   cons
                                   car
                                   cdr
                                   atom?)))
        (cons vector?
              (lambda (seq)
                (make-ras-callable seq
                                   make-vector
                                   vector-ref
                                   vector-set!
                                   vector-length)))
        (cons string?
              (lambda (seq)
                (make-ras-callable seq
                                   make-string
                                   string-ref
                                   string-set!
                                   string-length)))
        (cons (lambda (x) #t)
              (lambda (seq)
                (error 'sequence "not a sequence" seq)))
        ))
    (db standard-db)
    (db->sequence?
      (lambda (db)
        (lambda (seq)
          (let loop ((tests (map car db)))
            (cond
              ((null? (cdr tests)) #f)
              (((car tests) seq) #t)
              (else (loop (cdr tests))))))))
    )
    (case-lambda
      (()
       ;; reset database and seq?
       (set! db standard-db)
       (set! sequence? (db->sequence? db))
       (if #f #f))
      ((sym/seq)
       (cond
         ((symbol? sym/seq)
          ;; add new constructor
          (case sym/seq
            ((ras)
             (lambda (seq? seq-make seq-ref seq-set! seq-length)
               (set! db
                 (let recur ((db db))
                   (if (null? (cdr db))
                     (list
                       (cons seq?
                             (lambda (seq)
                               (make-ras-callable seq
                                                  seq-make
                                                  seq-ref
                                                  seq-set!
                                                  seq-length)))
                       (car db))
                     (cons (car db) (recur (cdr db))))))
               (set! sequence? (db->sequence? db))
               (if #f #f)))
            ((sas)
             (lambda (seq? seq-cons seq-car seq-cdr seq-null?)
               (set! db
                 (let recur ((db db))
                   (if (null? (cdr db))
                     (list
                       (cons seq?
                             (lambda (seq)
                               (make-ras-callable seq
                                                  seq-cons
                                                  seq-car
                                                  seq-cdr
                                                  seq-null?)))
                       (car db))
                     (cons (car db) (recur (cdr db))))))
               (set! sequence? ;seq?)
                 (lambda (seq)
                   (let ((tests (map car (reverse (cdr (reverse db))))))
                     (if (memv #t (map (lambda (fn) (fn seq))
                                       tests))
                         #t #f))))
               (if #f #f)))
            (else
              (error 'sequence-constructors "wrong sequence type" sym/seq))
            ))
         (else
           ;; return matching constructor
           (let loop ((db db))
             (if ((caar db) sym/seq)
               (cdar db)
               (loop (cdr db)))))
         )))))

#|[
(make-callable seq)
--- procedure ---
makes the sequence seq callable
]|#
(define (make-callable seq)
  ((sequence-constructors seq) seq))

#|[
(callable? xpr)
--- procedure ---
evaluates xpr to a callable sequence
]|#
(define (callable? xpr)
  (or (callable-sas? xpr)
      (callable-ras? xpr)))

#|[
(callable-null? clb)
--- procedure ---
is the callable-sequence clb empty?
]|#
(define (callable-null? xpr)
  (and (callable? xpr) (zero? (callable-length xpr))))

#|[
(callable-flat? clb)
--- procedure ---
is the callable sequence clb flat?
]|#
(define (callable-flat? clb)
  (let ((len (callable-length clb)))
    (call-with-current-continuation
      (lambda (return)
        (let loop ((i 0))
            (if (= i len)
              #t
              (if (sequence? (clb i))
                (return #f)
                (loop (+ i 1)))))))))
    ;(do ((i 0 (+ i 1)))
    ;  ((= i len) result)
    ;  (if (sequence? (clb i)) (set! result #f)))))

#|[
(callable-length clb)
--- procedure ---
returns the length of the callable sequence clb
]|#
(define (callable-length clb)
  (cond
    ((callable-sas? clb)
     (call-with-values clb
                       (lambda (seq seq-cons seq-car seq-cdr seq-null?)
                         (let loop ((seq seq) (k 0))
                           (if (seq-null? seq)
                             k
                             (loop (seq-cdr seq) (+ k 1)))))))
    ((callable-ras? clb)
     (call-with-values clb
                       (lambda (seq seq-make seq-ref seq-set! seq-length)
                         (seq-length seq))))
    (else (error 'callable-length
                 "sequence-type not implemented" (clb)))
    ))

#|[
(callable-nil clb)
--- procedure ---
returns an empty callable sequence of the same type as clb
]|#
(define (callable-nil clb)
  ;; provide for atoms as pseudolist nils
  (let (
    (seq
      (cond
        ((callable-sas? clb)
         (apply sas-nil (call-with-values clb list)))
        ((callable-ras? clb)
         (apply ras-nil (call-with-values clb list)))
        (else 
          (error 'callable-nil "sequence type not implemented" (clb)))))
    )
    (if (sequence? seq)
      (make-callable seq)
      seq)))

#|[
(callable-data clb)
--- procedure ---
returns the encapsulated sequence of the flat callable-sequence clb
]|#
(define (callable-data clb)
  (clb))

#|[
(callable-indices ok? clb)
--- procedure ---
returns the list of indices, k, for which (clb k) passes the ok? test
]|#
(define (callable-indices ok? clb)
  (let ((len (callable-length clb)))
    (let loop ((k 0) (result '()))
      (cond
        ((= k len) (reverse result))
        ((ok? (clb k))
         (loop (+ k 1) (cons k result)))
        (else
          (loop (+ k 1) result))))))

#|[
(callable-copy clb)
--- procedure ---
returns a callable sequence which is a copy of the initial one
]|#
(define (callable-copy clb)
  (clb 0 #f))

#|[
(callable-map fn clb)
--- procedure ---
maps the callable-sequence, clb, via procedure fn
]|#
(define (callable-map fn clb)
  (make-callable
    (cond
      ((callable-sas? clb)
       (apply sas-map fn (call-with-values clb list)))
      ((callable-ras? clb)
       (apply ras-map fn (call-with-values clb list)))
      (else 
        (error 'callable-map "sequence-type not implemented" (clb))))))

#|[
(callable-for-each fn clb)
--- procedure ---
executes fn for each item of clb
]|#
(define (callable-for-each fn clb)
  (let ((len (callable-length clb)))
    (do ((k 0 (+ k 1)))
      ((= k len) (if #f #f))
      (fn (clb k)))))

#|[
(callable-filter ok? clb)
--- procedure ---
returnstwo callable sequences filtering items of clb
via ok? or not-ok? respectively
]|#
(define (callable-filter ok? clb)
  (cond
    ((callable-sas? clb)
     (receive (sas-yes sas-no)
       (apply sas-filter ok? (call-with-values clb list))
       (values (make-callable sas-yes) (make-callable sas-no))))
    ((callable-ras? clb)
     (receive (ras-yes ras-no)
       (apply ras-filter ok? (call-with-values clb list))
       (values (make-callable ras-yes) (make-callable ras-no))))
    (else 
      (error 'callable-filter "sequence-type not implemented" (clb)))))

#|[
(callable-reverse clb)
(callable-reverse clb clb1)
--- procedure ---
returns a callable sequence which is the reverse of the first argument
appended to the second one which defaults to callable-nil, if not given
]|#
(define callable-reverse
  (case-lambda
    ((clb clb1)
     (make-callable
       (cond
         ((and (callable-sas? clb) (callable-sas? clb1))
          (apply sas-reverse (clb) (call-with-values clb1 list)))
         ((and (callable-ras? clb) (callable-ras? clb1))
          (apply ras-reverse (clb) (call-with-values clb1 list)))
         (else 
           (error 'callable-reverse "sequence types not equal" (clb) (clb1))))))
    ((clb)
     (callable-reverse clb (callable-nil clb)))
     ;(clb #f -1))
    ))

#|[
(callable-append clb . clbs)
--- procedure ---
returns the callable sequence appending encapsulated sequences
of same type
]|#
(define (callable-append clb . clbs)
  (cond
    ((null? clbs) clb)
    ((null? (cdr clbs))
     (let ((clb1 (car clbs)))
       (let ((seq (clb)) (seq1 (clb1)))
         (make-callable
           (cond
             ((and (callable-sas? clb) (callable-sas? clb1))
              (apply sas-append seq (call-with-values clb1 list)))
             ((and (callable-ras? clb) (callable-ras? clb1))
              (apply ras-append seq (call-with-values clb1 list)))
             (else 
               (error 'callable-append
                      "sequence-types different"
                      seq
                      seq1)))))))
    (else
      (callable-append clb
                       (apply callable-append
                              (car clbs)
                              (cdr clbs))))))


#|[
(callable-collect item-xpr (var clb ok-xpr ...))
(callable-collect item-xpr (var clb ok-xpr ...) (var1 clb1 ok-xpr1 ...) ...)
--- macro ---
creates a new callable-sequence by binding var to each element
of the callable-sequence clb in sequence, and if it passes the checks,
ok-xpr ..., inserts the value of xpr into the resulting pseudolist.
The qualifieres, (var clb ok-xpr ...), are processed
sequentially from left to right, so that filters of a
qualifier have access to the variables of qualifiers
to its left.
]|#
(define-syntax callable-collect
  (syntax-rules ()
   ((_ item-xpr (var clb ok-xpr ...))
    (let ((len (callable-length clb)))
      (make-callable
        (let recur ((i 0))
          (if (= i len)
            '()
            (let ((var (clb i)))
              (if (and ok-xpr ...)
                (cons item-xpr (recur (+ i 1)))
                (recur (+ i 1)))))))))
   ((_ item-xpr (var clb ok-xpr ...) (var1 clb1 ok-xpr1 ...) ...)
    (let ((len (callable-length clb)))
      (make-callable
        (let recur ((i 0))
          (if (= i len)
            '()
            (let ((var (clb i)))
              (if (and ok-xpr ...)
                (append
                  ((callable-collect item-xpr (var1 clb1 ok-xpr1 ...) ...))
                  (recur (+ i 1)))
                (recur (+ i 1)))))))))
   ))

;;; nested sequences

#|[
(callable-data* clb)
--- procedure ---
nested version of callable-data
]|#
(define (callable-data* clb)
  (callable-data
    (callable-map (lambda (x)
                    (if (callable? x)
                        (callable-data* x)
                        x))
                  clb
                  )))

#|[
(callable-map* fn clb)
--- procedure ---
nested version of callable-map, i.e. maps a nested callable-sequence
]|#
(define (callable-map* fn clb)
  (callable-map
    (lambda (x)
      (if (callable? x)
        (callable-map* fn x)
        (fn x)))
    clb))

#|[
(make-callable* seq)
--- procedure ---
nested version of make-callable, i.e. creates a nested callable-sequence
from a nested ordinary sequence
]|#
(define (make-callable* seq)
  (callable-map
    (lambda (x)
      (if (sequence? x)
          (make-callable* x)
          x))
    (make-callable seq)))

#|[
(callable-sequences)
(callable-sequences sym)
--- procedure ---
documentation procedure
]|#
(define callable-sequences
  (let (
    (alist '(
      (make-sas-callable
        procedure:
        (make-sas-callable seq seq-cons seq-car seq-cdr seq-null?)
        "sequential access constructor with arguments similar to lists"
        )
      (callable-sas?
        procedure:
        (callable-sas? xpr)
        "evaluates xpr to a sequential access callable-sequence?"
        )
      (make-ras-callable
        procedure:
        (make-ras-callable seq make-seq seq-ref seq-set! seq-length)
        "random access constructor with arguments similar to vectors"
        )
      (callable-ras?
        procedure:
        (callable-ras? xpr)
        "evaluates xpr to a random access callable-sequence?"
        )
      (sequence?
        procedure:
        (sequence? xpr)
        "evaluates xpr to a sequence type, initially a list, pseudolist, vector"
        "or string."
        "To be updated, if new sequence types are added."
        )
      (sequence-constructors
        procedure:
        (sequence-constructors)
        (sequence-constructors seq)
        (sequence-constructors sym)
        "the first resets the internal database and the sequence? predicate,"
        "the second selects and returns the constructor corresponding to the sequence"
        "argument,"
        "and the third adds a new sequential-access or random-access constructor,"
        "according to the symbol 'sas or 'ras. sequence? is updated as well."
        )
      (make-callable
        procedure:
        (make-callable seq)
        "makes the sequence seq callable"
        )
      (callable?
        procedure:
        (callable? xpr)
        "evaluates xpr to a callable sequence"
        )
      (callable-null?
        procedure:
        (callable-null? clb)
        "is the callable-sequence clb empty?"
        )
      (callable-flat?
        procedure:
        (callable-flat? clb)
        "is the callable sequence clb flat?"
        )
      (callable-length
        procedure:
        (callable-length clb)
        "returns the length of the callable sequence clb"
        )
      (callable-nil
        procedure:
        (callable-nil clb)
        "returns an empty callable sequence of the same type as clb"
        )
      (callable-data
        procedure:
        (callable-data clb)
        "returns the encapsulated sequence of the flat callable-sequence clb"
        )
      (callable-indices
        procedure:
        (callable-indices ok? clb)
        "returns the list of indices, k, for which (clb k) passes the ok? test"
        )
      (callable-copy
        procedure:
        (callable-copy clb)
        "returns a callable sequence which is a copy of the initial one"
        )
      (callable-map
        procedure:
        (callable-map fn clb)
        "maps the callable-sequence, clb, via procedure fn"
        )
      (callable-for-each
        procedure:
        (callable-for-each fn clb)
        "executes fn for each item of clb"
        )
      (callable-filter
        procedure:
        (callable-filter ok? clb)
        "returnstwo callable sequences filtering items of clb"
        "via ok? or not-ok? respectively"
        )
      (callable-reverse
        procedure:
        (callable-reverse clb)
        (callable-reverse clb clb1)
        "returns a callable sequence which is the reverse of the first argument"
        "appended to the second one which defaults to callable-nil, if not given"
        )
      (callable-append
        procedure:
        (callable-append clb . clbs)
        "returns the callable sequence appending encapsulated sequences"
        "of same type"
        )
      (callable-collect
        macro:
        (callable-collect item-xpr (var clb ok-xpr ...))
        (callable-collect item-xpr (var clb ok-xpr ...) (var1 clb1 ok-xpr1 ...) ...)
        "creates a new callable-sequence by binding var to each element"
        "of the callable-sequence clb in sequence, and if it passes the checks,"
        "ok-xpr ..., inserts the value of xpr into the resulting pseudolist."
        "The qualifieres, (var clb ok-xpr ...), are processed"
        "sequentially from left to right, so that filters of a"
        "qualifier have access to the variables of qualifiers"
        "to its left."
        )
      (callable-data*
        procedure:
        (callable-data* clb)
        "nested version of callable-data"
        )
      (callable-map*
        procedure:
        (callable-map* fn clb)
        "nested version of callable-map, i.e. maps a nested callable-sequence"
        )
      (make-callable*
        procedure:
        (make-callable* seq)
        "nested version of make-callable, i.e. creates a nested callable-sequence"
        "from a nested ordinary sequence"
        )
      (callable-sequences
        procedure:
        (callable-sequences)
        (callable-sequences sym)
        "with sym: documentation of exported symbol"
        "without sym: list of exported symbols"
        )
        ))
      )
      (case-lambda
        (() (map car alist))
        ((sym)
         (let ((pair (assq sym alist)))
           (if pair
             (for-each print (cdr pair))
             (print "Choose one of " (map car alist))))))))
)