source: project/release/5/bindings/trunk/bindings.scm @ 39398

Last change on this file since 39398 was 39398, checked in by juergen, 6 months ago

bindings 5.0 with new implementation

File size: 25.1 KB
Line 
1; Author: Juergen Lorenz, ju (at) jugilo (dot) de
2;
3; Copyright (c) 2013-2020, Juergen Lorenz
4; All rights reserved.
5;
6; Redistribution and use in source and binary forms, with or without
7; modification, are permitted provided that the following conditions are
8; met:
9;
10; Redistributions of source code must retain the above copyright
11; notice, this list of conditions and the following dispasser.
12;
13; Redistributions in binary form must reproduce the above copyright
14; notice, this list of conditions and the following dispasser in the
15; documentation and/or other materials provided with the distribution.
16;
17; Neither the name of the author nor the names of its contributors may be
18; used to endorse or promote products derived from this software without
19; specific prior written permission.
20;
21; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
22; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
23; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
24; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25; HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32
33#|[
34Yet another implementation of the bindings egg.
35Sequence routines are outsourced to simple-sequences, so that an
36enhanced version of Paul Graham's dbind (On Lisp, p. 232) can be used, a
37variant of Common Lisp's destructuring bind.
38
39But this version of dbind supports setters as well, using dbind without
40body. The reason to put it all in one huge macro is, that both variants
41use a common set of subroutines, which are implemented within the macro
42body. I could have put it into a helper module to be imported by syntax,
43but this subroutines are without interest outside of dbind.
44
45Other enhancements include length checks of sequences, a wildcard, _,
46which matches everything and binds nothing, literals, which match only
47themselfs but can't of course be bound, and dots, which are extensions of
48ellipses: two dots accept zero or one items of the same shape as the
49nested list to its left, and four dots accept only non-empty nested
50lists.
51
52Note, that dbind is not exported, but bind and bind! are exported
53instead.
54]|#
55
56(module bindings (
57  bind
58  bind!
59  bindrec
60  bind-case
61  bindable?
62  bind-lambda
63  bind-lambda*
64  bind-case-lambda
65  bind-case-lambda*
66  bind*
67  bind-loop
68  bind-let*
69  bind-let
70  bind-letrec
71  bind/cc
72  bindings
73  )
74
75(import scheme
76        (only simple-sequences sequence-db seq-ref seq-ref* seq-tail seq-length)
77        (only (chicken condition) condition-case)
78        (only (chicken base) gensym receive print case-lambda error)
79        (only (chicken keyword) keyword?)
80        (only (chicken module) reexport)
81        )
82
83(reexport (only simple-sequences sequence-db))
84
85(import-for-syntax (only (chicken keyword) keyword?))
86
87;;; Graham's dbind for sequences with length checks, literals,
88;;; wildcard and dots, as well as setters.
89(define-syntax dbind
90  (er-macro-transformer
91    (lambda (form rename compare?)
92      (let (
93        (%x (rename 'x))
94        (%_ (rename '_))
95        (%.. (rename '..))
96        (%... (rename '...))
97        (%.... (rename '....))
98        (%if (rename 'if))
99        (%or (rename 'or))
100        (%map (rename 'map))
101        (%let (rename 'let))
102        (%set! (rename 'set!))
103        (%begin (rename 'begin))
104        (%error (rename 'error))
105        (%zero? (rename 'zero?))
106        (%equal? (rename 'equal?))
107        (%lambda (rename 'lambda))
108        (%seq-ref (rename 'seq-ref))
109        (%seq-ref* (rename 'seq-ref*))
110        (%seq-tail (rename 'seq-tail))
111        (%seq-length (rename 'seq-length))
112        (%positive? (rename 'positive?))
113        )
114        (letrec (
115          (literal?
116            (lambda (p)
117              (or (boolean? p)
118                  (char? p)
119                  (number? p)
120                  (string?  p)
121                  (keyword?  p))))
122          (mappend
123            (lambda (fn lists)
124              (apply append (map fn lists))))
125          (dots?
126            (lambda (sym)
127              (or (compare? sym %..)
128                  (compare? sym %...)
129                  (compare? sym %....))))
130          (check-dots
131            (lambda (sym seq)
132              `(,(gensym)
133                (,%if
134                  ,(cond
135                    ((compare? sym %..)
136                     `(,%or (,%zero? (,%seq-length ,seq))
137                            (,%zero? (,%seq-length (,%seq-tail ,seq 1)))))
138                    ((compare? sym %...) #t)
139                    ((compare? sym %....)
140                     `(,%positive? (,%seq-length ,seq))))
141                  (,%seq-length ,seq) 
142                  (,%error 'check-dots "wrong size for this dots" ,seq ',sym)))))
143          (indices
144            ;;; (a b) -> ((a . 0) (b . 1))
145            ;;; (a (b (c))) -> ((a . 0) (b 1 . 0) (c 1 1 . 0))
146            (lambda (pat)
147              (receive (flat ind)
148                (let recur ((pat pat) (k 0))
149                  (cond
150                    ((null? pat)
151                     (values '() '()))
152                    ((pair? pat)
153                     (let ((p (car pat)) (ps (cdr pat)))
154                       (receive (p* i*) (recur p 0)
155                         (receive (ps* is*) (recur ps (+ k 1))
156                           (if (pair? p)
157                             (values (append p* ps*)
158                                     (append (map (lambda (x) (cons k x)) i*)
159                                             is*))
160                             (values (cons p ps*)
161                                     (cons k is*)))))))
162                    (else ;symbol
163                     (values '() '()))))
164                  (map cons flat ind))))
165          (map-seq-ref*
166            ;;; '(a (b c)) '((1 (2 3)) (10 (20 30)))
167            ;;; ->
168            ;;; '((a (1 10))) (b (2 30)) (c (3 30)))
169            (lambda (pat seqs)
170              (let recur ((pi (indices pat)))
171                (if (null? pi)
172                  '()
173                  (let ((api (car pi)) (dpi (cdr pi)))
174                    (cons (list (car api)
175                                `(,%map (,%lambda (,%x)
176                                          (,%seq-ref* ,%x ',(cdr api)))
177                                        ,seqs))
178                          (recur dpi)))))))
179          (destruc
180            ;; (destruc '(a (b . c) . d) 'seq)
181            ;; ->
182            ;; ((a (seq 0))
183            ;;  ((#!g (seq 1)) (b (#!g 0)) (c (#!g 1 #f)))
184            ;;  (d (seq 2 #f)))
185            (lambda (pat seq)
186              (let loop ((pat pat) (seq seq) (n 0))
187                (if (pair? pat)
188                  (let ((p (car pat))
189                        (q (cdr pat))
190                        (recu (loop (cdr pat) seq (+ n 1))))
191                    (cond
192                      ((symbol? p)
193                       (cond
194                         ((compare? p %_) ; wildcard
195                          recu)
196                         ((and (pair? q) (dots? (car q))) ;;;;
197                          ;(print p " PQ " q)
198                          (let ((seqs `(,%seq-tail ,seq ,n)))
199                            ;(cons (list p seqs) '()))) ;ok, ohne checks
200                            (cons (list (check-dots (car q) seqs)
201                                        (list p seqs))
202                                  '())))
203                         (else
204                           (cons `(,p (,%seq-ref ,seq ,n)) recu))))
205                      ;; literals
206                      ((literal? p)
207                       (cons `(,(gensym)
208                                (,%if (,%equal? (,%seq-ref ,seq ,n) ,p)
209                                  #t
210                                  (,%error 'dbind
211                                           "literals don't match"
212                                           (,%seq-ref ,seq ,n) ,p)))
213                             recu))
214                      ;; pair
215                      (else
216                        (cond
217                          ((and (pair? q) (dots? (car q))) ;;;;;
218                           (let ((seqs `(,%seq-tail ,seq ,n)))
219                             (cons (cons (check-dots (car q) seqs)
220                                         (map-seq-ref* p seqs))
221                                   '())))
222                          (else
223                            (let ((g (gensym)))
224                              (cons (cons `(,g (,%seq-ref ,seq ,n))
225                                          (loop p g 0))
226                                    recu)))))) )
227                  (let ((tail `(,%seq-tail ,seq ,n)))
228                    (cond
229                      ((null? pat)
230                        `((,(gensym)
231                            (,%if (,%zero? (,%seq-length ,tail))
232                              #t
233                              (,%error 'dbind
234                                     "tail not empty?"
235                                     ,tail)))))
236                      ((literal? pat)  ;;;;;;
237                       `((,(gensym)
238                          (,%if (,%equal? (,%seq-tail ,seq ,n) ,pat)
239                            #t
240                            (,%error 'dbind
241                                     "literals don't match"
242                                     (,%seq-tail ,seq ,n) ,pat)))))
243                      (else `((,pat ,tail)))))))))
244          (dbind-ex
245            ;; ->
246            ;; (let ((a (seq 0)) (#!g (seq 1)) (d (seq 2 #f)))
247            ;;   (let ((b (#!g 0)) (c (#!g 1 #f)))
248            ;;     (begin body)))
249            (lambda (binds body)
250              (if (null? binds)
251                `(,%begin ,@body)
252                `(,%let ,(map (lambda (b)
253                                (if (pair? (car b)) (car b) b))
254                              binds)
255                   ,(dbind-ex (mappend (lambda (b)
256                                         (if (pair? (car b))
257                                             (cdr b)
258                                             '()))
259                                       binds)
260                              body)))))
261          (dbind-set
262            ;; ->
263            ;; (begin
264            ;;   (set! a (seq 0)) (set! #!g (seq 1)) (set! d (seq 2 #f))
265            ;;   (set! b (#!g 0)) (set! c (#!g 1 #f)))
266            (lambda (binds)
267              (mappend (lambda (b)
268                         (if (pair? (car b))
269                             (cons `(,%set! ,(caar b) ,(cadar b))
270                                   (dbind-set (cdr b)))
271                             (list `(,%set! ,(car b) ,(cadr b)))))
272                       binds)))
273          )
274          (let ((pat (cadr form))
275                (seq (caddr form))
276                (body (cdddr form))
277                (gseq (gensym 'seq)))
278            `(,%let ((,gseq ,seq))
279               ,(if (null? body)
280                  ;; setters
281                  (cond
282                    ((null? pat)
283                     `(,%if (,%zero? (,%seq-length ,gseq))
284                        (,%if #f #f)
285                        (,%error 'dbind "seq too long" ,gseq ',pat)))
286                    ((compare? pat %_)
287                     `(,%if #f #f))
288                    ((literal? pat)
289                     `(,%if (,%equal? ,pat ,gseq)
290                        (,%if #f #f)
291                        (,%error 'dbind "literals don't match"
292                                 ,pat ,gseq)))
293                    ((symbol? pat)
294                     `(,%set! ,pat ,gseq))
295                    ((pair? pat)
296                     `(,%begin ,@(dbind-set (destruc pat gseq)))))
297                  ;; binders
298                  (cond
299                    ((null? pat)
300                     `(,%if (,%zero? (,%seq-length ,gseq))
301                        (,%begin ,@body)
302                        (,%error 'dbind "seq too long" ,gseq ',pat)))
303                    ((compare? pat %_)
304                     `(,%begin ,@body))
305                    ((literal? pat)
306                     `(,%if (,%equal? ,pat ,gseq)
307                        (,%begin ,@body)
308                        (,%error 'dbind "literals don't match"
309                                 ,pat ,gseq)))
310                    ((symbol? pat)
311                     `(,%let ((,pat ,gseq)) ,@body))
312                    ((pair? pat)
313                     (dbind-ex (destruc pat gseq) body)))
314                  ))))))))
315
316;;; (bind pat seq xpr . xprs)
317;;; -------------------------
318;;; binds pattern variables of pat to corresponding places in seq
319;;; and executes body xpr . xprs in this context.
320;;; Literals, wildcard, length checks and dots are supported.
321(define-syntax bind
322  (syntax-rules ()
323    ((_ pat seq xpr . xprs)
324     (dbind pat seq xpr . xprs))))
325
326;;; (bind! pat seq)
327;;; (bind! pat)
328;;; ---------------
329;;; setters corresponding to bind
330(define-syntax bind!
331  (syntax-rules ()
332    ((_ pat seq)
333     (dbind pat seq))
334    ((_ pat)
335     (dbind pat 'pat))))
336
337;;; (bindable? pat (where . fenders) seq)
338;;; (bindable? pat (where . fenders))
339;;; (bindable? pat seq)
340;;; (bindable? pat)
341;;; -------------------------------------
342(define-syntax bindable?
343  (syntax-rules (where)
344    ((_ pat (where fender ...) seq)
345     (condition-case (dbind pat seq (and fender ...))
346       ((exn) #f)))
347    ((_ pat seq)
348     (condition-case (dbind pat seq #t)
349       ((exn) #f)))
350    ;; curried versions
351    ((_ pat (where fender ...))
352     (lambda (seq)
353       (bindable? pat (where fender ...) seq)))
354    ((_ pat)
355     (lambda (seq)
356       (bindable? pat seq)))
357    ))
358
359(define (all-bindable? pat lst)
360  (let loop ((lst lst))
361    (cond
362      ((null? lst) #t)
363      (((bindable? (eval pat)) (car lst)) (loop (cdr lst)))
364      (else
365        (error 'all-bindable? "fails in bind with " pat (car lst))))))
366
367#|[
368The following macro does more or less the same what the match macro from
369the matchable package does, for example
370
371  (bind-case '(1 (2 3))
372    ((x y) (where (number? y)) (list x y))
373    ((x (y . z)) (list x y z))
374    ((x (y z)) (list x y z))) ;-> '(1 2 (3))
375
376or, to give a more realistic example, mapping:
377
378  (define (my-map fn lst)
379    (bind-case lst
380      (() '())
381      ((x . xs) (cons (fn x) (my-map fn xs)))))
382]|#
383
384;;; (bind-case seq (pat (where fender ...) xpr ....) ....)
385;;; (bind-case seq (pat xpr ....) ....)
386;;; ------------------------------------------------------
387;;; Checks if seq matches patterns pat  ....
388;;; in sequence, binds the pattern variables of the first matching
389;;; pattern to corresponding subexpressions of seq and executes
390;;; body expressions xpr .... in this context
391(define-syntax bind-case
392  (syntax-rules (where)
393    ((_ seq)
394     (error 'bind-case "no pattern to match" seq))
395    ((_ seq (pat (where fender ...) xpr . xprs))
396     (if (bindable? pat (where fender ...) seq)
397       (dbind pat seq xpr . xprs)
398       (error 'bind-seq "sequence doesn't match pattern with fenders"
399              seq 'pat 'fender ...)))
400    ((_ seq (pat xpr . xprs))
401     (if (bindable? pat seq)
402       (dbind pat seq xpr . xprs)
403       (error 'bind-seq "sequence doesn't match pattern" seq 'pat)))
404    ((_ seq (pat (where fender ...) xpr . xprs) . clauses)
405     (if (bindable? pat (where fender ...) seq)
406       (dbind pat seq xpr . xprs)
407       (bind-case seq . clauses)))
408    ((_ seq (pat xpr . xprs) . clauses)
409     (if (bindable? pat seq)
410       (dbind pat seq xpr . xprs)
411       (bind-case seq . clauses)))
412    ))
413
414#|[
415Now we can define two macros, which simply combine lambda with
416bind, the first destructures simply one argument, the second a
417whole list. An example of a call and its result is
418
419  ((bind-lambda (a (b . c) . d) (list a b c d))
420   '(1 #(20 30 40) 2 3))
421  -> '(1 20 #(30 40) (2 3)))))
422
423  ((bind-lambda* ((a (b . c) . d) (e . f))
424     (list a b c d e f))
425   '(1 #(20 30 40) 2 3) '#(4 5 6))
426  -> '(1 20 #(30 40) (2 3) 4 #(5 6)))
427]|#
428
429;;; (bind-lambda pat xpr ....)
430;;; --------------------------
431;;; combination of lambda and bind, one pattern argument
432(define-syntax bind-lambda
433  (syntax-rules ()
434    ((_ pat xpr . xprs)
435     (lambda (x) (dbind pat x xpr . xprs)))
436    ))
437
438;;; (bind-lambda* pat xpr ....)
439;;; ---------------------------
440;;; combination of lambda and bind, multiple pattern arguments
441(define-syntax bind-lambda*
442  (syntax-rules ()
443    ((_ pat xpr . xprs)
444     (lambda x (dbind pat x xpr . xprs)))
445     ))
446
447#|[
448The next two macros combine lambda and bind-case and do more or less the
449same as match-lambda and match-lambda* in the matchable package. The
450first destructures one argument, the second a list of arguments.
451Here is an example together with its result (note the >> fender):
452
453  ((bind-case-lambda
454     ((a (b . c) . d) (list a b c d))
455     ((e . f) (>> e zero?) e)
456     ((e . f) (list e f)))
457   '(1 2 3 4 5))
458  -> '(1 (2 3 4 5))
459
460  ((bind-case-lambda*
461     (((a (b . c) . d) (e . f))
462      (list a b c d e f)))
463   '(1 #(20 30 40) 2 3) '(4 5 6))
464  -> '(1 20 (30 40) (2 3) 4 (5 6))
465]|#
466
467;;; (bind-case-lambda (pat (where fender ...) xpr ....) ....)
468;;; (bind-case-lambda (pat xpr ....) ....)
469;;; ---------------------------------------------------------
470;;; combination of lambda and bind-case, one pattern argument
471(define-syntax bind-case-lambda
472  (syntax-rules (where)
473    ((_ (pat (where fender ...) xpr . xprs))
474     (lambda (x)
475       (bind-case x (pat (where fender ...) xpr . xprs))))
476    ((_ (pat xpr . xprs))
477     (lambda (x)
478       (bind-case x (pat xpr . xprs))))
479    ((_ clause . clauses)
480     (lambda (x)
481       (bind-case x clause . clauses)))
482    ))
483
484;;; (bind-case-lambda* (pat (where fender ...) xpr ....) ....)
485;;; (bind-case-lambda* (pat xpr ....) ....)
486;;; ----------------------------------------------------------
487;;; combination of lambda and bind-case, multiple pattern arguments
488(define-syntax bind-case-lambda*
489  (syntax-rules (where)
490    ((_ (pat (where fender ...) xpr . xprs))
491     (lambda x
492       (bind-case x (pat (where fender ...) xpr . xprs))))
493    ((_ (pat xpr . xprs))
494     (lambda x
495       (bind-case x (pat xpr . xprs))))
496    ((_ clause . clauses)
497     (lambda x
498       (bind-case x clause . clauses)))
499    ))
500
501#|[
502The following macro, bind-loop, is an anaphoric version of bind.
503It introduces an unrenamed symbol, loop, behind the scene and binds it
504to a procedure, which can be used in the body.
505For example
506
507  (bind-loop (x y) '(5 0)
508    (if (zero? x)
509      (list x y)
510      (loop (list (sub1 x) (add1 y)))))
511  -> '(0 5)
512]|#
513
514;;; (bind-loop pat seq xpr ....)
515;;; ----------------------------
516;;; anaphoric version of bind, introducing loop routine behind the scene
517(define-syntax bind-loop
518  (er-macro-transformer
519    (lambda (form rename compare?)
520      (let ((pat (cadr form))
521            (seq (caddr form))
522            (xpr (cadddr form))
523            (xprs (cddddr form))
524            (%letrec (rename 'letrec))
525            (%bind-lambda (rename 'bind-lambda)))
526        `((,%letrec ((loop (,%bind-lambda ,pat ,xpr ,@xprs)))
527            loop)
528          ,seq)))))
529
530#|[
531The following macro, bind*, is a named version of bind. It takes an
532additional argument besides those of bind, which is bound to a
533recursive procedure, which can be called in bind's body. The pattern
534variables are initialised with the corresponding subexpressions in seq.
535For example
536
537  (bind* loop (x y) '(5 0)
538    (if (zero? x)
539      (list x y)
540      (loop (list (sub1 x) (add1 y)))))
541  -> '(0 5)
542]|#
543
544;;; (bind* name pat seq xpr ....)
545;;; ---- ------------------------
546;;; named version of bind
547(define-syntax bind*
548  (syntax-rules ()
549    ((_ name pat seq xpr . xprs)
550     ((letrec ((name (bind-lambda pat xpr . xprs)))
551        name)
552      seq))))
553
554#|[
555The following three macros are analoga of the standard base macros let,
556let* and letrec, the first named or unnamed. For example
557
558(bind-let loop (((a b) '(5 0)))
559  (if (zero? a)
560    (list a b)
561    (loop (list (sub1 a) (add1 b)))))
562-> '(0 5)
563
564A recursive version of bind follows
565]|#
566
567;;; (bind-let* ((pat seq) ...) xpr . xprs)
568;;; --------------------------------------
569;;; sequentually binding patterns to sequences
570(define-syntax bind-let*
571  (syntax-rules ()
572    ((_ () xpr . xprs)
573     (let () xpr . xprs))
574    ((_ ((pat seq)) xpr . xprs)
575     (dbind pat seq xpr . xprs))
576    ((_ ((pat seq) (pat1 seq1) ...) xpr . xprs)
577     (dbind pat seq (bind-let* ((pat1 seq1) ...) xpr . xprs)))
578     ))
579
580;;; (bind-let name .. ((pat seq) ...) xpr . xprs)
581;;; ---------------------------------------------
582;;; binding patterns to sequences in parallel, whith or without a
583;;; recursive name procedure
584(define-syntax bind-let
585  (syntax-rules ()
586    ((_ ((pat seq) ...) xpr . xprs)
587     (dbind (pat ...) (list seq ...) xpr . xprs))
588    ((_ name ((pat seq) ...) xpr . xprs)
589     ((letrec ((name (bind-lambda* (pat ...) xpr . xprs)))
590        name)
591      seq ...))
592    ))
593
594;;; (bind-letrec ((pat seq) ...) xpr . xprs)
595;;; ----------------------------------------
596;;; binding patterns to sequences recursively
597(define-syntax bind-letrec
598  (syntax-rules ()
599    ((_ ((pat seq) ...) xpr . xprs)
600     (bind-let ((pat 'pat) ...)
601       (bind! (pat ...) (list seq ...))
602       xpr . xprs))))
603   
604;;; (bindrec pat seq xpr . xprs)
605;;; ----------------------------
606;;; recursive version of bind
607(define-syntax bindrec
608  (syntax-rules ()
609    ((_ pat seq xpr . xprs)
610     (dbind pat 'pat
611       (bind! pat seq)
612       xpr . xprs))))
613
614#|[
615I don't like the let/cc syntax, because it differs from let syntax,
616here is bind/cc, which does the same.
617]|#
618
619;;; (bind/cc cc xpr ....)
620;;; ---------------------
621;;; captures the current continuation, binds it to cc and executes
622;;; xpr .... in this context
623(define-syntax bind/cc
624  (syntax-rules ()
625    ((_ cc xpr . xprs)
626     (call-with-current-continuation
627       (lambda (cc) xpr . xprs)))))
628
629(define (symbol-dispatcher alist) ; internal
630  (case-lambda
631    (()
632     (map car alist))
633    ((sym)
634     (let ((pair (assq sym alist)))
635       (if pair
636         (for-each print (cdr pair))
637         (error "Not in list"
638                sym
639                (map car alist)))))))
640
641;;; (bindings sym ..)
642;;; -----------------
643;;; documentation procedure
644(define bindings
645  (symbol-dispatcher '(
646    (sequence-db
647      procedure:
648      (sequence-db)
649      (sequence-db seq)
650      (sequence-db seq? seq-length seq-ref seq-tail seq-maker . pos?)
651      "sequence database processing, reexported from simple-sequences:"
652      "the first resets the database to the standard with"
653      "lists, pairs, vectors and strings,"
654      "the second returns the vector of handlers as well as the discriminator,"
655      "the third adds a new database record either at the end or before the"
656      "pos? discriminator."
657      "A record cosists of a discriminator, seq?, and a vector with items"
658      "seq-lenth, seq-ref, seq-tail and seq-maker patterned after vectors."
659      "Note, that the last record can handle atoms, albeit it is not a"
660      "sequence."
661      )
662    (bindings
663      procedure:
664      (bindings sym ..)
665      "documentation procedure")
666    (bind
667      macro:
668      (bind pat seq)
669      (bind pat seq . body)
670      "a variant of Common Lisp's destructuring-bind with body"
671      "multiple set!s without")
672    (bind-case
673      macro:
674      (bind-case seq (pat (where fender ...) xpr ....) ....)
675      (bind-case seq (pat xpr ....) ....)
676      "matches seq against pat with optional fenders in a case regime")
677    (bindable?
678      macro:
679      (bindable? pat (where fender ...) seq)
680      (bindable? pat seq)
681      (bindable? pat (where fender ...))
682      (bindable? pat)
683      "The first two check if sequence seq matches pattern pat"
684      "with optional fenders."
685      "The second two are curried versions of the first two")
686    (bind!
687      macro:
688      (bind! pat seq)
689      "sets multiple variables by destructuring its sequence arguments")
690    (bind-lambda
691      macro:
692      (bind-lambda pat xpr ....)
693      "combination of lambda and bind, one pattern argument")
694    (bind-lambda*
695      macro:
696      (bind-lambda* pat xpr ....)
697      "combination of lambda and bind, multiple pattern arguments")
698    (bind*
699      macro:
700      (bind* loop pat seq xpr ....)
701      "named version of bind,"
702      "deprecated, use bind-loop instead")
703    (bind-loop
704      macro:
705      (bind-loop pat seq xpr ....)
706      "anaphoric version of bind,"
707      "introduces a routine named loop behind the scene,"
708      "to be used in the body xpr ....")
709    (bind-let
710      macro:
711      (bind-let loop .. ((pat seq) ...) xpr ....)
712      "nested version of let, named and unnamed")
713    (bind-let*
714      macro:
715      (bind-let* ((pat seq) ...) xpr ....)
716      "nested version of let*")
717    (bindrec
718      macro:
719      (bindrec pat seq xpr ....)
720      "recursive version of bind")
721    (bind-letrec
722      macro:
723      (bind-letrec ((pat seq) ...) xpr ....)
724      "recursive version of bind-let")
725    (bind-case-lambda
726      macro:
727      (bind-case-lambda (pat (where fender ...) xpr ....) ....)
728      (bind-case-lambda (pat xpr ....) ....)
729      "combination of lambda and bind-case with one pattern argument")
730    (bind-case-lambda*
731      macro:
732      (bind-case-lambda* (pat (where fender ...) xpr ....) ....)
733      (bind-case-lambda* (pat xpr ....) ....)
734      "combination of lambda and bind-case with multiple pattern arguments")
735    (bind/cc
736      macro:
737      (bind/cc cc xpr ....)
738      "binds cc to the current contiunation"
739      "and execute xpr ... in this context")
740    )))
741
742) ; module
743
Note: See TracBrowser for help on using the repository browser.