source: project/wiki/eggref/4/bindings @ 35734

Last change on this file since 35734 was 35734, checked in by juergen, 2 years ago

typo corrected

File size: 15.9 KB
Line 
1[[tags: egg]]
2[[toc:]]
3
4
5== Destructuring sequence expressions with bindings
6
7Automatic destructuring of expressions is a handy feature, which can be
8successfully used in writing procedural macros, for example. Some
9programming languages use it extensively, in particular ML and its
10descendents Haskell and Miranda. And Chicken offers an egg called
11matchable, which does it as well.
12
13This library provides an alternative to matchable, a bunch of macros,
14all starting with the bind prefix, and all being derived from bind and
15related macros.  They all destructure arbitrary mixtures of
16(pseudo-) lists, vectors and strings, which match a pattern, and can be
17easily enhanced, to accept other sequence types as well, arrays, for
18example. For this to be possible, seq-db from the basic-sequences egg is
19reexported.
20
21The syntax of the fundamental bind macro is as follows
22
23<macro>(bind pat seq (where fender ...) .. xpr ....)</macro>
24
25Here, a pattern, pat, is a nested psudolist of (mostly) symbols, seq a
26sequencce expression, i.e. a mixture of pseudolists, vectors and
27strings, fender a check expression on pattern variables, var, of the form
28(var ok? ...) and xpr ....  constitute the body of the macro. Note the
29special use of dots here and below: Three dots repeat the expression to
30the left zero or many times, two dots zero or one times and four dots
31one or many times.
32
33This macro binds pattern variables, i.e. symbols of pat, to corresponding
34sequenceds of seq, checks, if the fenders succeed and exectutes the body
35in this context.
36
37There are some features, which I would like to have and which are
38implemented as well. First wildcards, represented by the underscore
39symbol. It matches everything, but binds nothing. So it can appear
40multiple times in the same macro. Wildcard symbols are simply not
41collected in the internal destructure routine.
42
43Second, non-symbol literals, which don't bind anything, of course, but
44match only expressions evaluating to them.
45
46The last feature missing is fenders, which is important in particular
47for bind-case and can easily be implemented with a where clause: A
48pattern matches successfully if only each pattern variable can be bound
49and the checks as well as the fenders are satisfied. If the where
50clause doesn't pass, the next pattern is tried in bind-case or a
51seq-exception is signalled in bind.
52
53This version of the library is a complete rewrite. The code no longer
54uses Graham's dbind implementation. Instead, a direct implementation of
55bind is given, which doesn't need gensyms. The internal destructure
56routine transforms the pattern and sequence arguments into three lists,
57pairs, literals and tails. Pairs is a list of pattern-variable and
58corresponding sequence-accesscode pairs to be used in a let at runtime,
59literals and tails check for equality of literals and their
60corresponding sequence values, and the emptyness of sequence tails
61corresponding to null patterns respectively. So, contrary to Graham's
62dbind, an exception is raised if the lengths of a pattern and its
63corresponding sequence don't match. Fenders are supplied in a where
64clause at the very beginning of the macro body: A list of
65pattern-variable predicates pairs is internally transformed into a list
66of predicate calls.
67
68The latest addition to the library are algebraic types, to be accessed
69via the binding macros, thus making e.g. define-concrete-type obsolete.
70
71=== Documentation
72
73==== bindings
74
75<procedure>(bindings sym ..)</procedure>
76
77documentation procedure. Shows the exported symbols and the syntax of
78such an exported symbol, respectively.
79
80==== seq-db
81
82reexport from the basic-sequences egg
83
84<procedure>(seq-db)</procedure>
85
86shows the sequence database
87
88<procedure>(seq-db type? ref: ref tail: tail maker: maker ra?: random-access?)</procedure>
89
90adds a new custom sequence type with predicate type? and keyword
91arguments ref: tail: maker: ra?: naming procedures to be later accessed
92as seq-ref, seq-tail, seq-maker and seq-randoam-access? respectively.
93
94=== Binding macros
95
96====  bind
97
98<macro>(bind pat seq (where fender ...) .. xpr ....)</macro>
99
100binds pattern variables of pat to subexpressions of seq and executes
101xpr .... in this context, provided all fenders return #t, if supplied.
102
103==== bindable?
104
105<macro>(bindable? pat (where fender ...) ..)</macro>
106
107returns a unary predicate which checks, if its sequence argument matches
108the pattern argument, pat, of bindable? and passes all of its fenders
109(the syntax is slightly changed for consistency).
110
111====  bind-case
112
113<macro>(bind-case seq (pat (where fender ...) .. xpr ....) ....)</macro>
114
115Matches seq against a series of patterns and executes the body of the
116first matching pattern satisfying fenders (if given).
117
118==== bind-define
119
120<macro>(bind-define pat seq pat1 seq1 ... (where fender ...) ..)</macro>
121
122defines pattern variables of pat pat1 ... with values matching
123subexpressions of seq seq1 ... in one go
124
125==== bind-set!
126
127<macro>(bind-set! pat seq pat1 seq1 ... (where fender ...) ..)</macro>
128
129sets symbols of pat pat1 ... to corresponding subexpressions of seq seq1 ...
130
131==== bind-lambda
132
133<macro>(bind-lambda pat (where fender ...) .. xpr ....)</macro>
134
135combination of lambda and bind, one pattern argument
136
137====  bind-lambda*
138
139<macro>(bind-lambda* pat (where fender ...) .. xpr ....)</macro>
140
141combination of lambda and bind, multiple pattern arguments
142
143==== bind-case-lambda
144
145<macro>(bind-case-lambda (pat (where fender ...) .. xpr ....) ....)</macro>
146
147Combination of bind-case and lambda with one pattern argument
148
149==== bind-case-lambda*
150
151<macro>(bind-case-lambda* (pat (where fender ...) .. xpr ....) ....)</macro>
152
153Combination of bind-case and lambda with multiple pattern arguments
154
155==== bind-named
156
157<macro>(bind-named loop pat seq (where fender ...) .. xpr ....)</macro>
158
159named version of bind.
160loop is bound to a procedure, which can be used in the body xpr ....
161
162==== bindrec
163
164<macro>(bindrec pat seq (where fender ...) .. xpr ....)</macro>
165
166bind pattern variables of pat to subsequences of seq recursively
167
168====  bind-let
169
170<macro>(bind-let loop .. ((pat seq) ...) (where fender ...) .. xpr ....)</macro>
171
172like let, named and unnamed, but binds patterns to sequence templates.
173In the named case loop is bound to a one-parameter-procedure accessible
174in the body xpr ....
175
176==== bind-let*
177
178<macro>(bind-let* ((pat seq) ...) (where fender ...) .. xpr ....)</macro>
179
180like let*, but binds patterns to sequence templates
181
182==== bind-letrec
183
184<macro>(bind-letrec ((patseq) ...)  (where fender ...) .. xpr ....)</macro>
185
186like letrec, but binds patterns to sequence templates
187
188==== bind/cc
189
190<macro>(bind/cc cc xpr ....)</macro>
191
192captures the current continuation in cc and executes xpr .... in this
193context.
194
195==== define-algebraic-type
196
197<macro>(define-algebraic-type NAME Name? Constructors ....)</macro>
198
199where each Constructor, Name, is one of
200  (Name (arg arg? ...) ...)
201  (Name (arg arg? ...) ... args args?  ...)
202
203The generated type, NAME, can be destructured with bind, bind-case etc.
204as tagged vectors with #:Name as tag.
205
206=== Requirements
207
208simple-exceptions basic-sequences>=2.0
209
210=== Usage
211
212<enscript highlight=scheme>
213(use bindings)
214</enscript>
215
216=== Examples
217
218<enscript highlight=scheme>
219
220(use bindings)
221
222(let ((stack #f) (push! #f) (pop! #f))
223  (bind-set! (stack (push! pop!))
224    (list
225      '()
226      (vector
227        (lambda (xpr) (set! stack (cons xpr stack)))
228        (lambda () (set! stack (cdr stack))))))
229  (push! 1)
230  (push! 0)
231  stack)
232; -> '(0 1)
233
234(begin
235  (bind-define (top push! pop!)
236    (let ((lst '()))
237      (vector
238        (lambda () (car lst))
239        (lambda (xpr) (set! lst (cons xpr lst)))
240        (lambda () (set! lst (cdr lst))))))
241  (push! 0)
242  (push! 1)
243  (pop!)
244  (top))
245; -> 0
246
247(bind a 1 a)
248; -> 1
249
250(bind (x y z w) '(1 2 3 4) (list x y z w))
251; -> '(1 2 3 4)
252
253(bind (x . y) '#(1 2 3 4) (list x y))
254; -> '(1 #(2 3 4))
255
256(bind (x (y (z u . v)) w) '(1 #(2 "foo") 4)
257  (list x y z u v w))
258; -> '(1 2 #\f #\o "o" 4)
259
260(bind (x (y (z . u)) v . w) (vector 1 (list 2 (cons 3 4)) 5 6)
261  (list x y z u v w))
262; -> '(1 2 3 4 5 #(6))
263
264((bind-lambda (a (b . C) . d)
265   (list a b C d))
266 '(1 #(20 30 40) 2 3))
267; -> '(1 20 #(30 40) (2 3))
268
269((bind-lambda* ((a (b . C) . d) (e . f))
270   (list a b C d e f))
271 '(1 #(20 30 40) 2 3) '#(4 5 6))
272; -> '(1 20 #(30 40) (2 3) 4 #(5 6))
273
274(bind-named loop (x (a . b) y) '(5 #(1) 0)
275  (where (x integer?))
276  (if (zero? x)
277    (list x a b y)
278    (loop (list (- x 1) (cons a (cons a b)) (+ y 1)))))
279; -> '(0 1 (1 1 1 1 1 . #()) 5)
280
281(bind-named loop (x y) '(5 0)
282  (if (zero? x)
283    (vector x y)
284    (loop (vector (- x 1) (+ y 1)))))
285; -> '#(0 5)
286
287(bind-let (((x y (z . w)) '(1 2 #(3 4 5))))
288  (list x y z w))
289; -> '(1 2 3 #(4 5))
290
291(bind-let (
292  (((x y) z) '(#(1 2) 3))
293  (u (+ 2 2))
294  ((v w) '#(5 6))
295  )
296  (list x y z u v w))
297; -> '(1 2 3 4 5 6)
298
299(bind-let loop (((a b) '(5 0)))
300  (where (a integer?))
301  (if (zero? a)
302    (list a b)
303    (loop (list (- a 1) (+ b 1)))))
304; -> '(0 5)
305
306(bind-let loop (
307  ((x . y) '(1 2 3))
308  ((z) '#(10))
309  )
310  (where (x integer?) (y (list-of? integer?)) (z integer?))
311  (if (zero? z)
312    (list x y z)
313    (loop (cons (+ x 1) (map add1 y)) (list (- z 1)))))
314; -> '(11 (12 13) 0)
315
316(bind-let* (
317  (((x y) z) '(#(1 2) 3))
318  (u (+ 1 2 x))
319  ((v w) (list (+ z 2) 6))
320  )
321  (list x y z u v w))
322; -> '(1 2 3 4 5 6)
323
324(bindrec ((o?) e?)
325  (vector (list (lambda (m) (if (zero? m) #f (e? (- m 1)))))
326          (lambda (n) (if (zero? n) #t (o? (- n 1)))))
327  (where (o? procedure?) (e? procedure?))
328  (list (o? 95) (e? 95)))
329; -> '(#t #f)
330
331(bind-letrec (
332  ((o? (e?))
333   (list (lambda (m) (if (zero? m) #f (e? (- m 1))))
334         (vector (lambda (n) (if (zero? n) #t (o? (- n 1)))))))
335  )
336  (list (o? 95) (e? 95)))
337; -> '(#t #f)
338
339((bindable? ()) '())
340; -> #t
341
342((bindable? (a (b C) . d)) '(1 (2 3) . 4))
343; -> #t
344
345((bindable? (a (b C) . d)) '(1 #(2 3) 4 5))
346; -> #t
347
348((bindable? (a (b . C) . d)) '(1 (2 3) 4))
349; -> #t
350
351((bindable? (a (b . C) . d)) '#(1 2 3 4 5))
352; -> #f
353
354((bindable? (a (b C) d)) '(1 (2 3) 4 5))
355; -> #f
356
357((bindable? (a b) (even? a)) '#(1 2))
358; -> #f
359
360(bind-case '#(1 2)
361  (() '())
362  ((a) (list a))
363  ((a b) (list a b))
364  ((a b C) (list a b C)))
365; -> '(1 2))
366
367(define (my-map fn lst)
368  (bind-case lst
369    (() '())
370    ((x . xs) (cons (fn x) (my-map fn xs)))))
371(my-map add1 '(1 2 3)))
372; -> '(2 3 4)
373
374(define (vector-reverse vec)
375  (let ((result (make-vector (vector-length vec) #f)))
376    (let loop ((vec vec))
377      (bind-case vec
378        (() result)
379        ((x . xs)
380         (vector-set! result
381                      (vector-length xs)
382                      x)
383         (loop (subvector vec 1)))))))
384(vector-reverse #(0 1 2 3))
385; -> #(3 2 1 0)
386
387((bind-case-lambda
388   ((a (b . C) . d) (list a b C d))
389   ((e . f) (where (e zero?)) e)
390   ((e . f) (list e f)))
391 '(1 2 3 4 5))
392; -> '(1 (2 3 4 5)))
393
394((bind-case-lambda
395   ((e . f) (where (e zero?)) f)
396   ((e . f) (list e f)))
397 '#(0 2 3 4 5))
398;-> '#(2 3 4 5))
399
400((bind-case-lambda
401   ((a (b . C) . d) (list a b C d))
402   ((e . f) (list e f)))
403 '(1 #(2 3 4) 5 6))
404; -> '(1 2 #(3 4) (5 6))
405
406((bind-case-lambda*
407   (((a b C . d) (e . f))
408    (list a b C d e f)))
409 '(1 2 3) '#(4 5 6))
410; -> '(1 2 3 () 4 #(5 6))
411
412((bind-case-lambda*
413   (((a (b . C) . d) (e . f))
414    (list a b C d e f)))
415 '(1 #(20 30 40) 2 3) '(4 5 6))
416; -> '(1 20 #(30 40) (2 3) 4 (5 6))
417
418;;adding arrays to generic sequence table
419(seq-db array?  ref: array-ref tail: array-tail maker: array ra?: #t)
420
421(bind (x y z) (array 1 2 3) (list x y z))
422;-> '(1 2 3)
423
424(bind (x (y z)) (vector 0 (array 1 2)) (list x y z))
425;-> '(0 1 2)
426
427(bind (x (y . z)) (vector 0 (array 1 2 3 4)) (list x y z))
428;-> '(0 1 @(2 3 4))
429
430;; lists as algebraic type
431(define-algebraic-type LIST List? (Nil) (Cons (x) (xs List?)))
432(define (List->list lst)
433  (bind-case (<< lst List?)
434    ((#:Nil) '())
435    ((#:Cons x xs)
436     (cons x (List->list xs)))))
437(define three (Cons 0 (Cons 1 (Cons 2 (Nil)))))
438(List->list three) ; -> '(0 1 2)
439
440;; typed vectors as algebraic type
441(define-algebraic-type VEC Vec? (Vec (x integer?) xs integer?))
442(define (Vec->list vec)
443  (bind (#:Vec x . xs) (<< vec Vec?)
444    (cons x (vector->list (subvector xs 1)))))
445(define four (Vec 0 1 2 3))
446(Vec->list four) ; -> '(0 1 2 3)
447
448;; typed trees as algebraic type
449(define-algebraic-type TREE Tree?
450  (Leaf (b number?))
451  (Node (left Tree?) (t number?) (right Tree?)))
452(define (leaf-sum tr)
453  (bind-case (<< tr Tree?)
454    ((#:Leaf b) b)
455    ((#:Node left middle right)
456     (+ (leaf-sum left) middle (leaf-sum right)))))
457(define tree (Node (Leaf 1) 2 (Leaf 3)))
458(leaf-sum tree) ; -> 6
459
460</enscript>
461
462== Last update
463
464Nov 07, 2017
465
466== Author
467
468[[/users/juergen-lorenz|Juergen Lorenz]]
469
470== License
471
472 Copyright (c) 2011-2017, Juergen Lorenz
473 All rights reserved.
474
475 Redistribution and use in source and binary forms, with or without
476 modification, are permitted provided that the following conditions are
477 met:
478 
479 Redistributions of source code must retain the above copyright
480 notice, this list of conditions and the following disclaimer.
481 
482 Redistributions in binary form must reproduce the above copyright
483 notice, this list of conditions and the following disclaimer in the
484 documentation and/or other materials provided with the distribution.
485 Neither the name of the author nor the names of its contributors may be
486 used to endorse or promote products derived from this software without
487 specific prior written permission.
488   
489 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
490 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
491 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
492 PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
493 HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
494 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
495 TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
496 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
497 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
498 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
499 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
500
501== Version History
502; 7.1 : bind-case now procedural to improve error message
503; 7.0.4: dependency on simple-exceptions updated
504; 7.0: algebraic types added
505; 6.0: complete rewrite, sequences outsourced
506; 5.0: functor implementation, literal rest parameter bug fixed
507; 4.1: macro-rules and friends moved to procedural-macros, where clauses now follow patterns
508; 4.0: code completely rewritten,simplified  and reorganized, some small syntax changes
509; 3.5.2: code reorganized again to fix compile problems
510; 3.5.1: code reorganized
511; 3.5 : let-macro and letrec-macro added, list-of? replaced by list-of to accept zero to many predicates
512; 3.4 : where and key clauses now work together in macro-rules, moreover, macro-rules can be used in define-macro, so it needn't be imported for-syntax
513; 3.3 : bindings library split in two; fixed a compile-time bug, thanks to John Foerch and Moritz Heidkamp
514; 3.2 : wild-card processing added
515; 3.1 : support for once formal parameters, rename-prefix clause moved to parameter, let-macro and letrec-macro changed to er-macro and renamed
516; 3.0.1 : bugfix in define-er-macro, bind/cc added, three macros moved to macro-helpers
517; 3.0 : library now includes low-level-macros
518; 2.5 : all macros are low-level. Module depends on low-level-macros
519; 2.4.1 : documentation procedure beautified
520; 2.4 : generic functions rewritten, records removed from tests
521; 2.3.4 : internal generic-pair? added again bugfixed
522; 2.3.3 : exception-handler added, internal generic-pair? removed
523; 2.3.2 : bind-case improved, format replaced by print
524; 2.3 : code partially rewritten, syntax of bindable? changed, matching records outsourced to the tests
525; 2.2 : renamed bind? to bindable?, bind/cc moved to list-bindings
526; 2.1 : generics (and hence bind and friends) now accept records, bind/cc added
527; 2.0 : bind-matches? and bind-loop changed to bindable? and bind*, where clauses and generic functions added, syms->vars removed
528; 1.0 : all binding macros can now destructure arbitrary nested sequences, i.e mixtures of lists, pseudo-lists, vectors and strings; dependency on contracts removed.
529; 0.1 : initial import
Note: See TracBrowser for help on using the repository browser.