source: project/wiki/eggref/5/bindings @ 36468

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

bindings 1.2 docu updated

File size: 12.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, sequence equivalents for list-ref,
19list-tail and null? have to be implemented, which use a database routine
20named bind-seq-db.
21
22The syntax of the fundamental bind macro is as follows
23
24<macro>(bind pat seq (where fender ...) .. xpr ....)</macro>
25
26Here, a pattern, pat, is a nested psudolist of (mostly) symbols, seq a
27sequencce expression, i.e. a mixture of pseudolists, vectors and
28strings, fender a check expression on pattern variables, var, of the form
29(var ok? ...) and xpr ....  constitute the body of the macro. Note the
30special use of dots here and below: Three dots repeat the expression to
31the left zero or many times, two dots zero or one times and four dots
32one or many times.
33
34This macro binds pattern variables, i.e. symbols of pat, to corresponding
35sequenceds of seq, checks, if the fenders succeed and exectutes the body
36in this context.
37
38There are some features, which I would like to have and which are
39implemented as well. First wildcards, represented by the underscore
40symbol. It matches everything, but binds nothing. So it can appear
41multiple times in the same macro. Wildcard symbols are simply not
42collected in the internal destructure routine.
43
44Second, non-symbol literals, which don't bind anything, of course, but
45match only expressions evaluating to themselves.
46
47The last feature missing is fenders, which is important in particular
48for bind-case and can easily be implemented with a where clause: A
49pattern matches successfully if only each pattern variable can be bound
50and the checks as well as the fenders are satisfied. If the where
51clause doesn't pass, the next pattern is tried in bind-case or a
52bind-seq-exception is signalled in bind.
53
54This version is a port to chicken-5 from the last version 7.1 of
55chicken-4, which in turn was a complete rewrite. The code no longer
56uses Graham's dbind implementation. Instead, a direct implementation of
57bind is given, which doesn't need gensyms. The internal destructure
58routine transforms the pattern and sequence arguments into three lists,
59pairs, literals and tails. Pairs is a list of pattern-variable and
60corresponding sequence-accesscode pairs to be used in a let at runtime,
61literals and tails check for equality of literals and their
62corresponding sequence values, and the emptyness of sequence tails
63corresponding to null patterns respectively. So, contrary to Graham's
64dbind, an exception is raised if the lengths of a pattern and its
65corresponding sequence don't match. Fenders are supplied in a where
66clause at the very beginning of the macro body: A list of
67pattern-variable predicates pairs is internally transformed into a list
68of predicate calls.
69
70Algebraic types of the latest chicken-4 version are removed and will be
71outsourced to another egg.
72
73=== Documentation
74
75==== bindings
76
77<procedure>(bindings sym ..)</procedure>
78
79documentation procedure. Shows the exported symbols and the syntax of
80such an exported symbol, respectively.
81
82=== Sequence routines
83
84==== bind-pseudo-list?
85
86<procedure>(bind-pseudo-list? xpr)</procedure>
87
88always #t
89
90==== bind-seq-exception
91
92<procedure>(bind-seq-exception loc . args)</procedure>
93
94generates an exception to be raised
95
96==== bind-seq-db
97
98<procedure>(bind-seq-db)</procedure>
99
100shows the sequence database
101
102<procedure>(bind-seq-db type? ref: ref tail: tail)</procedure>
103
104adds a new custom sequence type with predicate type? and keyword
105arguments ref: and tail:  naming procedures to be later accessed
106via bind-seq-ref and bind-seq-tail respectively.
107
108==== bind-seq-ref
109
110<procedure>(bind-seq-ref seq k)</procedure>
111
112sequence analog of list-ref
113
114==== bind-seq-tail
115
116<procedure>(bind-seq-tail seq k)</procedure>
117
118sequence analog of list-tail
119
120==== bind-seq-null?
121
122<procedure>(bind-seq-null? xpr)</procedure>
123
124sequence analog of null?
125
126=== Binding macros
127
128====  bind
129
130<macro>(bind pat seq (where fender ...) .. xpr ....)</macro>
131
132binds pattern variables of pat to subexpressions of seq and executes
133xpr .... in this context, provided all fenders return #t, if supplied.
134
135==== bindable?
136
137<macro>(bindable? pat (where fender ...) ..)</macro>
138
139returns a unary predicate which checks, if its sequence argument matches
140the pattern argument, pat, of bindable? and passes all of its fenders
141(the syntax is slightly changed for consistency).
142
143====  bind-case
144
145<macro>(bind-case seq (pat (where fender ...) .. xpr ....) ....)</macro>
146
147Matches seq against a series of patterns and executes the body of the
148first matching pattern satisfying fenders (if given).
149
150==== bind-define
151
152<macro>(bind-define pat seq pat1 seq1 ... (where fender ...) ..)</macro>
153
154defines pattern variables of pat pat1 ... with values matching
155subexpressions of seq seq1 ... in one go
156
157==== bind-set!
158
159<macro>(bind-set! pat seq pat1 seq1 ... (where fender ...) ..)</macro>
160
161sets symbols of pat pat1 ... to corresponding subexpressions of seq seq1 ...
162
163==== bind-lambda
164
165<macro>(bind-lambda pat (where fender ...) .. xpr ....)</macro>
166
167combination of lambda and bind, one pattern argument
168
169====  bind-lambda*
170
171<macro>(bind-lambda* pat (where fender ...) .. xpr ....)</macro>
172
173combination of lambda and bind, multiple pattern arguments
174
175==== bind-case-lambda
176
177<macro>(bind-case-lambda (pat (where fender ...) .. xpr ....) ....)</macro>
178
179Combination of bind-case and lambda with one pattern argument
180
181==== bind-case-lambda*
182
183<macro>(bind-case-lambda* (pat (where fender ...) .. xpr ....) ....)</macro>
184
185Combination of bind-case and lambda with multiple pattern arguments
186
187==== bind-named
188
189<macro>(bind-named loop pat seq (where fender ...) .. xpr ....)</macro>
190
191named version of bind.
192loop is bound to a procedure, which can be used in the body xpr ....
193
194==== bindrec
195
196<macro>(bindrec pat seq (where fender ...) .. xpr ....)</macro>
197
198bind pattern variables of pat to subsequences of seq recursively
199
200====  bind-let
201
202<macro>(bind-let loop .. ((pat seq) ...) (where fender ...) .. xpr ....)</macro>
203
204like let, named and unnamed, but binds patterns to sequence templates.
205In the named case loop is bound to a one-parameter-procedure accessible
206in the body xpr ....
207
208==== bind-let*
209
210<macro>(bind-let* ((pat seq) ...) (where fender ...) .. xpr ....)</macro>
211
212like let*, but binds patterns to sequence templates
213
214==== bind-letrec
215
216<macro>(bind-letrec ((patseq) ...)  (where fender ...) .. xpr ....)</macro>
217
218like letrec, but binds patterns to sequence templates
219
220==== bind/cc
221
222<macro>(bind/cc cc xpr ....)</macro>
223
224captures the current continuation in cc and executes xpr .... in this
225context.
226
227=== Requirements
228
229simple-exceptions
230
231=== Usage
232
233<enscript highlight=scheme>
234(import bindings)
235</enscript>
236
237=== Examples
238
239<enscript highlight=scheme>
240
241(import bindings)
242
243(let ((stack #f) (push! #f) (pop! #f))
244  (bind-set! (stack (push! pop!))
245    (list
246      '()
247      (vector
248        (lambda (xpr) (set! stack (cons xpr stack)))
249        (lambda () (set! stack (cdr stack))))))
250  (push! 1)
251  (push! 0)
252  stack)
253; -> '(0 1)
254
255(begin
256  (bind-define (top push! pop!)
257    (let ((lst '()))
258      (vector
259        (lambda () (car lst))
260        (lambda (xpr) (set! lst (cons xpr lst)))
261        (lambda () (set! lst (cdr lst))))))
262  (push! 0)
263  (push! 1)
264  (pop!)
265  (top))
266; -> 0
267
268(bind a 1 a)
269; -> 1
270
271(bind (x y z w) '(1 2 3 4) (list x y z w))
272; -> '(1 2 3 4)
273
274(bind (x . y) '#(1 2 3 4) (list x y))
275; -> '(1 #(2 3 4))
276
277(bind (x (y (z u . v)) w) '(1 #(2 "foo") 4)
278  (list x y z u v w))
279; -> '(1 2 #\f #\o "o" 4)
280
281(bind (x (y (z . u)) v . w) (vector 1 (list 2 (cons 3 4)) 5 6)
282  (list x y z u v w))
283; -> '(1 2 3 4 5 #(6))
284
285((bind-lambda (a (b . C) . d)
286   (list a b C d))
287 '(1 #(20 30 40) 2 3))
288; -> '(1 20 #(30 40) (2 3))
289
290((bind-lambda* ((a (b . C) . d) (e . f))
291   (list a b C d e f))
292 '(1 #(20 30 40) 2 3) '#(4 5 6))
293; -> '(1 20 #(30 40) (2 3) 4 #(5 6))
294
295(bind-named loop (x (a . b) y) '(5 #(1) 0)
296  (where (x integer?))
297  (if (zero? x)
298    (list x a b y)
299    (loop (list (- x 1) (cons a (cons a b)) (+ y 1)))))
300; -> '(0 1 (1 1 1 1 1 . #()) 5)
301
302(bind-named loop (x y) '(5 0)
303  (if (zero? x)
304    (vector x y)
305    (loop (vector (- x 1) (+ y 1)))))
306; -> '#(0 5)
307
308(bind-let (((x y (z . w)) '(1 2 #(3 4 5))))
309  (list x y z w))
310; -> '(1 2 3 #(4 5))
311
312(bind-let (
313  (((x y) z) '(#(1 2) 3))
314  (u (+ 2 2))
315  ((v w) '#(5 6))
316  )
317  (list x y z u v w))
318; -> '(1 2 3 4 5 6)
319
320(bind-let loop (((a b) '(5 0)))
321  (where (a integer?))
322  (if (zero? a)
323    (list a b)
324    (loop (list (- a 1) (+ b 1)))))
325; -> '(0 5)
326
327(bind-let loop (
328  ((x . y) '(1 2 3))
329  ((z) '#(10))
330  )
331  (where (x integer?) (y (list-of? integer?)) (z integer?))
332  (if (zero? z)
333    (list x y z)
334    (loop (cons (+ x 1) (map add1 y)) (list (- z 1)))))
335; -> '(11 (12 13) 0)
336
337(bind-let* (
338  (((x y) z) '(#(1 2) 3))
339  (u (+ 1 2 x))
340  ((v w) (list (+ z 2) 6))
341  )
342  (list x y z u v w))
343; -> '(1 2 3 4 5 6)
344
345(bindrec ((o?) e?)
346  (vector (list (lambda (m) (if (zero? m) #f (e? (- m 1)))))
347          (lambda (n) (if (zero? n) #t (o? (- n 1)))))
348  (where (o? procedure?) (e? procedure?))
349  (list (o? 95) (e? 95)))
350; -> '(#t #f)
351
352(bind-letrec (
353  ((o? (e?))
354   (list (lambda (m) (if (zero? m) #f (e? (- m 1))))
355         (vector (lambda (n) (if (zero? n) #t (o? (- n 1)))))))
356  )
357  (list (o? 95) (e? 95)))
358; -> '(#t #f)
359
360((bindable? ()) '())
361; -> #t
362
363((bindable? (a (b C) . d)) '(1 (2 3) . 4))
364; -> #t
365
366((bindable? (a (b C) . d)) '(1 #(2 3) 4 5))
367; -> #t
368
369((bindable? (a (b . C) . d)) '(1 (2 3) 4))
370; -> #t
371
372((bindable? (a (b . C) . d)) '#(1 2 3 4 5))
373; -> #f
374
375((bindable? (a (b C) d)) '(1 (2 3) 4 5))
376; -> #f
377
378((bindable? (a b) (even? a)) '#(1 2))
379; -> #f
380
381(bind-case '#(1 2)
382  (() '())
383  ((a) (list a))
384  ((a b) (list a b))
385  ((a b C) (list a b C)))
386; -> '(1 2))
387
388(define (my-map fn lst)
389  (bind-case lst
390    (() '())
391    ((x . xs) (cons (fn x) (my-map fn xs)))))
392(my-map add1 '(1 2 3)))
393; -> '(2 3 4)
394
395(define (vector-reverse vec)
396  (let ((result (make-vector (vector-length vec) #f)))
397    (let loop ((vec vec))
398      (bind-case vec
399        (() result)
400        ((x . xs)
401         (vector-set! result
402                      (vector-length xs)
403                      x)
404         (loop (subvector vec 1)))))))
405(vector-reverse #(0 1 2 3))
406; -> #(3 2 1 0)
407
408((bind-case-lambda
409   ((a (b . C) . d) (list a b C d))
410   ((e . f) (where (e zero?)) e)
411   ((e . f) (list e f)))
412 '(1 2 3 4 5))
413; -> '(1 (2 3 4 5)))
414
415((bind-case-lambda
416   ((e . f) (where (e zero?)) f)
417   ((e . f) (list e f)))
418 '#(0 2 3 4 5))
419;-> '#(2 3 4 5))
420
421((bind-case-lambda
422   ((a (b . C) . d) (list a b C d))
423   ((e . f) (list e f)))
424 '(1 #(2 3 4) 5 6))
425; -> '(1 2 #(3 4) (5 6))
426
427((bind-case-lambda*
428   (((a b C . d) (e . f))
429    (list a b C d e f)))
430 '(1 2 3) '#(4 5 6))
431; -> '(1 2 3 () 4 #(5 6))
432
433((bind-case-lambda*
434   (((a (b . C) . d) (e . f))
435    (list a b C d e f)))
436 '(1 #(20 30 40) 2 3) '(4 5 6))
437; -> '(1 20 #(30 40) (2 3) 4 (5 6))
438
439</enscript>
440
441== Last update
442
443Aug 30, 2018
444
445== Author
446
447[[/users/juergen-lorenz|Juergen Lorenz]]
448
449== License
450
451 Copyright (c) 2011-2018, Juergen Lorenz
452 All rights reserved.
453
454 Redistribution and use in source and binary forms, with or without
455 modification, are permitted provided that the following conditions are
456 met:
457 
458 Redistributions of source code must retain the above copyright
459 notice, this list of conditions and the following disclaimer.
460 
461 Redistributions in binary form must reproduce the above copyright
462 notice, this list of conditions and the following disclaimer in the
463 documentation and/or other materials provided with the distribution.
464 Neither the name of the author nor the names of its contributors may be
465 used to endorse or promote products derived from this software without
466 specific prior written permission.
467   
468 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
469 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
470 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
471 PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
472 HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
473 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
474 TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
475 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
476 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
477 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
478 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
479
480== Version History
481; 1.2 : bug with null? pattern fixed
482; 1.1 : sequence routines prifixed
483; 1.0 : chicken-5 port from chicken-4, version 7.1, with modifications
Note: See TracBrowser for help on using the repository browser.