Destructuring sequence expressions with bindings

Automatic destructuring of expressions is a handy feature, which can be successfully used in writing procedural macros, for example. Some programming languages use it extensively, in particular ML and its descendents Haskell and Miranda. And Chicken offers an egg called matchable, which does it as well.

This library provides an alternative to matchable, a bunch of macros, all starting with the bind prefix, and all being derived from bind and related macros. They destructure nested pseudolists which match a pattern and can be easily enhanced to accept other sequence types as well, vectors, strings, arrays, or what have you. All this sequence types can be nested and mixed as you need it.

This version uses the sequence routines from simple-sequences and is based again on Paul Graham's dbind (On Lisp, p. 232), a version of Common Lisp's destructuring-bind.

But this version of dbind supports setters as well, using dbind without body. The reason to put it all in one huge macro is, that both variants use a common set of subroutines, which are implemented within the macro body. I could have put it into a helper module to be imported by syntax, but this subroutines are without interest outside of dbind.

Other enhancements include length checks of sequences, a wildcard, _, which matches everything and binds nothing, literals, which match only themselfs but can't of course be bound, and dots, which are extensions of ellipses: two dots accept zero or one items of the same shape as the nested list to its left, and four dots accept only non-empty nested lists.

Note, that dbind is not exported, bind and bind! are exported instead.

[syntax] (bind pat seq xpr . xprs)
[syntax] (bind! pat seq)

Here, a pattern, pat, is either

a symbol,
a literal (char, string, keyword, boolean or number)
a dotted list
a pair of patterns.

where dotted lists (i.e nested list patterns followed by two, tree or four dots) are new since version 4.0, and seq is a nested sequence expression, i.e. a mixture of pseudolists, vectors and strings. Other sequence types can be added by means of sequence-db, which is reexported from simple-sequences.

Patterns are used to control the destructuring of sequences, bind pattern variables to corresponding subexpressions of seq, controlling their length and checking if literals match themselfs. Then either the body is executed in this context, or the pattern variables are set! to the values of the corresponding subexpression. Since the wildcard binds nothing, it can appear multiple times in the same macro.

Documentation

sequence-db

[procedure] (sequence-db)
[procedure] (sequence-db seq)
[procedure] (sequence-db seq? seq-length seq-ref seq-tail seq-maker . pos?)

database processing: the first resets the database to the standard with lists, pairs, vectors and strings, the second returns the vector of handlers as well as the discriminator, the third adds a new database record either at the end or before the pos? discriminator. A record cosists of a discriminator, seq?, and a vector with items seq-lenth, seq-ref, seq-tail and seq-maker patterned after vectors. Note, that the last record can handle atoms, albeit it is not a sequence. This routine is reexported from simple-sequences.


(import simple-sequences bindings checks)

(let ((stack #f) (push! #f) (pop! #f))
  (bind! (stack (push! pop!))
    (list
      '()
      (vector
        (lambda (xpr) (set! stack (cons xpr stack)))
        (lambda () (set! stack (cdr stack))))))
  (push! 1)
  (push! 0)
  stack)
; -> '(0 1)

(begin
  (define lst '())
  (bind! (top push! pop!)
    (list
      (lambda () (car lst))
      (lambda (xpr) (set! lst (cons xpr lst)))
      (lambda () (set! lst (cdr lst)))))
  (push! 0)
  (push! 1)
  (pop!)
  (top)
; -> 0

(bind a 1 a)
; -> 1

(bind (x y as ....) '(-1 0 1 2 3 4) (list x y as))
;-> '(-1 0 (1 2 3))

(bind (x y as ..) '(-1 0)  (list x y as))
;-> '(-1 0 ())

(bind ((as (bs cs)) ...)
      '((1 (2 3)) (10 (20 30)))
      (list as bs cs))
;-> '((1 10) (2 20) (3 30))

(bind (x y z w) '(1 2 3 4) (list x y z w))
; -> '(1 2 3 4)

(bind (x . y) #(1 2 3 4) (list x y))
; -> (1 #(2 3 4))

(bind (x (y (z u . v)) w) '(1 #(2 "foo") 4)
  (list x y z u v w))
; -> '(1 2 #\f #\o "o" 4)

(bind (x (y (z . u)) v . w) (vector 1 (list 2 (cons 3 4)) 5 6)
  (list x y z u v w))
; -> '(1 2 3 4 5 #(6))

(let ()
  (bind! (a _ (b #f . bs) c))
  (and (eq? a 'a) (eq? b 'b) (eq? bs 'bs) (eq? c 'c)))
; -> #t

((bind-lambda (a (b cs ...) ds ...)
   (list a b cs ds))
 '(1 #(20 30 40) 2 3))
;-> '(1 20 (30 40) (2 3))

((bind-lambda (a (b (cs ds) ...) . es)
   (list a b cs ds es))
 '(1 #(20 (30 40)) 2 3))
;-> '(1 20 (30) (40) (2 3))

((bind-lambda (a (b . c) . d)
   (list a b c d))
 '(1 #(20 30 40) 2 3))
; -> '(1 20 #(30 40) (2 3))

((bind-lambda* ((a (b . c) . d) (e . f))
   (list a b c d e f))
 '(1 #(20 30 40) 2 3) #(4 5 6))
; -> '(1 20 #(30 40) (2 3) 4 #(5 6))

(bind-loop (x (a . b) y) '(5 #(1) 0)
  (if (zero? x)
    (list x a b y)
    (loop (list (- x 1) (cons a (cons a b)) (+ y 1)))))
; -> '(0 1 (1 1 1 1 1 . #()) 5)

(bind* loop (x (a . b) y) '(5 #(1) 0)
  (if (zero? x)
    (list x a b y)
    (loop (list (- x 1) (cons a (cons a b)) (+ y 1)))))
; -> '(0 1 (1 1 1 1 1 . #()) 5)

(bind-loop (x y) '(5 0)
  (if (zero? x)
    (vector x y)
    (loop (vector (- x 1) (+ y 1)))))
; -> #(0 5)

(bind* loop (x y) '(5 0)
  (if (zero? x)
    (vector x y)
    (loop (vector (- x 1) (+ y 1)))))
; -> #(0 5)

(bind-let (((x y (z . w)) '(1 2 #(3 4 5))))
  (list x y z w))
; -> '(1 2 3 #(4 5))

(bind-let (
  (((x y) z) '(#(1 2) 3))
  (u (+ 2 2))
  ((v w) #(5 6))
  )
  (list x y z u v w))
; -> '(1 2 3 4 5 6)

(bind-let ((((x y) (zs ..)) '(#(1 2) ()))
           (((us vs) ...) '((3 4) (30 40) (300 400))))
  (list x y zs us vs))
;-> '(1 2 () (3 30 300) (4 40 400))

(bind-let loop (((a b) '(5 0)))
  (if (zero? a)
    (list a b)
    (loop (list (- a 1) (+ b 1)))))
-> '(0 5)

(bind-let loop (((x . y) '(1 2 3))
                ((z) #(10)))
  (if (zero? z)
    (list x y z)
    (loop (cons (+ x 1) (map add1 y)) (list (- z 1)))))
-> '(11 (12 13) 0)

(bind-let* (
  (((x y) z) '(#(1 2) 3))
  (u (+ 1 2 x))
  ((v w) (list (+ z 2) 6))
  )
  (list x y z u v w))
; -> '(1 2 3 4 5 6)

(bindrec ((o?) e?)
  (vector (list (lambda (m) (if (zero? m) #f (e? (- m 1)))))
          (lambda (n) (if (zero? n) #t (o? (- n 1)))))
  (list (o? 95) (e? 95)))
; -> '(#t #f)

(bind-letrec (
  (o? (lambda (m) (if (zero? m) #f (e? (- m 1)))))
  ((e?) (vector (lambda (n) (if (zero? n) #t (o? (- n 1))))))
  )
  (list (o? 95) (e? 95)))
; -> '(#t #f)

((bindable? ()) '())
; -> #t

(bindable? (a (b cs .. d)) '(1 (2 3)))
;-> #t

((bindable? (a (b c) . d)) '(1 (2 3) . 4))
; -> #t

((bindable? (a (b c) . d)) '(1 #(2 3) 4 5))
; -> #t

((bindable? (a (b . c) . d)) '(1 (2 3) 4))
; -> #t

((bindable? (a (b . c) . d)) '#(1 2 3 4 5))
; -> #f

((bindable? (a (b c) d)) '(1 (2 3) 4 5))
; -> #f

(bindable? (a b) (where (even? a) (odd? b)) '(2 2))
; -> #f

(bind-case #(1 2)
  (() #f)
  ((a) #f)
  ((a b) (list a b))
  ((a b c) #f))
; -> '(1 2))

(bind-case #(2 2)
  ((a b) (where (even? a) (odd? b)) #f)
  ((a b) (where (odd? a) (even? b)) #f)
  ((a b) (list a b)))
; -> '(2 2)

(bind-case '(0 4)
  ((a bs ....) #f)
  ((a bs ...) (list a bs)))
;-> '(0 ())

(bind-case '(0 1 2 3 4)
  ((a bs ..) #f)
  ((a bs ...) (list a bs)))
;-> '(0 (1 2 3))

(bind-case '(0 #(1 (2 3)) 4)
  ((a (bs (cs (ds))) ..) #f)
  ((a (bs (cs ds)) ..) (list a bs cs ds))) 
;-> '(0 (1) (2) (3))

(define (my-map fn lst)
  (bind-case lst
    (() '())
    ((x . xs) (cons (fn x) (my-map fn xs)))))
(my-map add1 '(1 2 3)))
; -> '(2 3 4)

(define (vector-reverse vec)
  (let ((result (make-vector (vector-length vec) #f)))
    (let loop ((vec vec))
      (bind-case vec
        (() result)
        ((x . xs)
         (vector-set! result
                      (vector-length xs)
                      x)
         (loop (subvector vec 1)))))))
(vector-reverse #(0 1 2 3))
; -> #(3 2 1 0)

((bind-case-lambda
   ((a (b . c) . d) (list a b c d))
   ((e . f) (where (zero? e)) e)
   ((e . f) (list e f)))
 '(1 2 3 4 5))
; -> '(1 (2 3 4 5)))

((bind-case-lambda
   ((e . f) (where (zero? e)) f)
   ((e . f) (list e f)))
 #(0 2 3 4 5))
;-> #(2 3 4 5))

((bind-case-lambda
   ((a (b . c) . d) (list a b  d))
   ((e . f) (list e f)))
 '(1 #(2 3 4) 5 6))
; -> '(1 2 #(3 4) (5 6))

((bind-case-lambda*
   (((a b  . d) (e . f))
    (list a b  d e f)))
 '(1 2 3) #(4 5 6))
; -> '(1 2 3 () 4 #(5 6))

((bind-case-lambda*
   (((a (b . c) . d) (e . f))
    (list a b c d e f)))
 '(1 #(20 30 40) 2 3) '(4 5 6))
; -> '(1 20 #(30 40) (2 3) 4 (5 6))

If you want to check out the source code repository of this egg and you are not familiar with Subversion, see this page.

License

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

Version History

5.0 ; new version based again on Graham's dbind, using simple-sequences
4.1 ; dotted lists in bodies added via resolve-dots
4.0 ; dotted patterns added
3.x ; bind-list* removed, bind-list does its job for nested lists only ;;;;;;
3.2: bindable? now in two forms, bind-case improved, both with optional fenders.
3.1: bind* now deprecated, use bind-loop instead.
3.0.1: bugs in bind and bind-listify* fixed
3.0: bind and relatives in two versions, with and without body, bind-listify* replaces bind-seq->list, bind! replaces bind-set! and bind-define
2.1: bind encapsulated in a let
2.0: complete rewrite, code simplified, where clause removed
1.5: prepared for lazy-pairs
1.4: dependency on checks removed
1.3: dependency of << fixed
1.2: bug with null? pattern fixed
1.1: sequence routines prifixed
1.0: chicken-5 port from chicken-4, version 7.1, with modifications