chickadee » bindings

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 pseudolist 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 flexibility is made possible by one generic function, bind-listify*, which can add three procedures, seq? seq-car and seq-cdr to its local database and thus supplying support for a new sequence type.

The fundamental bind macro is given in two forms, whith and without a body. The former is a variant of Common Lisp's destructuring-bind, the latter simply set!s pattern variables to the corresponding sequence values.

(bind pat seq xpr . xprs)syntax
(bind pat seq)syntax

Here, a pattern, pat, is either

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

seq is a nested sequence expression, i.e. a mixture of pseudolists, vectors and strings (after having added string and vector support to a generic transformer procedure, bind-listify*). This transformer procedure is used to transform seq into a nested list.

Patterns are used to control the destructuring of sequences, bind pattern variables (i.e. symbols in pat except the wildcard, _, which matches everything, but binds nothing) to matching subexpressions of seq and check if literals in pat are equal to matching subexpressions in seq. Since the wildcard binds nothing, it can appear multiple times in the same macro.

Notice the meaning of dots following an expression in the sequel.

  • two dots: the expression appears zero or one times,
  • three dots: zero or many times,
  • four dots: one or many times.

Documentation

bindings

bindings sym ..procedure

documentation procedure. Shows the exported symbols and the syntax of such an exported symbol, respectively.

Procedures

bind-listify*

This is a generic procedure. It is closed over a local database which contains the necessary sequence versions of car and cdr.

bind-listify*procedure

resets the internal database for lists only.

bind-listify* seqprocedure

returns the car-cdr-pair corresponding to seq's type.

bind-listify* pat seqprocedure

transforms a nested pseudolist with possible wildcard, literals and dotted ends to a an ordinary nested list without.

bind-listify* seq? seq-car seq-cdrprocedure

adds support for a new sequence type with predicate seq? and sequence variants of car and cdr to the internal database.

vector-car

vector-car vecprocedure

vector-variant of car.

vector-cdr

vector-cdr vecprocedure

vector-variant of cdr.

string-car

string-car vecprocedure

string-variant of car.

string-cdr

string-cdr vecprocedure

string-variant of cdr.

Binding macros

bind-list

(bind-list pat lst . body)syntax

with body: binds pattern variables of of a flat patern without wildcard, literals and dotted ends, pat, to corresponding values of a flat list and executes the body in this context.

withoud body: set!s pattern variables of a flat patern without wildcard, literals and dotted ends, pat, to corresponding values of a flat list.

bind-list!

(bind-list! pat lst)syntax
(bind-list! pat)syntax

the former is an alias to bind-list without body, the latter is (bind-list! pat 'pat)

bind-list*

(bind-list* pat lst . body)syntax

nested versions of bind-list.

bind

(bind pat seq . body)syntax

with body: binds pattern variables of a nested patern, pat, possibly with wildcard, literals and dotted ends to corresponding values of a nested sequence, seq, possibly with literals and dotted ends, and executes the body xpr .... in this context.

without body: set!s pattern variables of a nested patern, pat, possibly with wildcard, literals and dotted ends, to corresponding values of a nested sequences, seq, possibly with literals and dotted ends.

bind!

(bind! pat seq)syntax
(bind! pat)syntax

the former is an alias to bind without body, the latter (bind! pat 'pat).

bind*

(bind* loop pat seq xpr ....)syntax

named version of bind (body can't be null?). loop is bound to a procedure, which can be used in the body xpr .... Deprecated, use bind-loop instead.

bind-loop

(bind-loop pat seq xpr ....)syntax

anaphoric version of bind. Introduces the unrenamed symbol loop behind the scene, to be used in the body xpr ....

bindrec

(bindrec pat seq xpr ....)syntax

recursive version of bind: bind pattern variables of pat to subsequences of seq recursively

bindable?

(bindable? pat)syntax

returns a unary predicate which checks, if its sequence argument matches the pattern argument, pat.

bind-case

(bind-case seq (pat xpr ....) ....)syntax

Matches seq against a series of patterns and executes the body of the first matching pattern.

bind-lambda

(bind-lambda pat xpr ....)syntax

combination of lambda and bind, one pattern argument.

bind-lambda*

(bind-lambda* pat xpr ....)syntax

combination of lambda and bind, multiple pattern arguments

bind-case-lambda

(bind-case-lambda (pat xpr ....) ....)syntax

Combination of bind-case and lambda with one pattern argument

bind-case-lambda*

(bind-case-lambda* (pat xpr ....) ....)syntax

Combination of bind-case and lambda with multiple pattern arguments

bind-let

(bind-let loop .. ((pat seq) ...) xpr ....)syntax

like let, named and unnamed, but binds patterns to sequence templates. In the named case loop is bound to a one-parameter-procedure accessible in the body xpr ....

bind-let*

(bind-let* ((pat seq) ...) xpr ....)syntax

like let*, but binds patterns to sequence templates

bind-letrec

(bind-letrec ((patseq) ...) xpr ....)syntax

like letrec, but binds patterns to sequence templates.

bind/cc

(bind/cc cc xpr ....)syntax

captures the current continuation in cc and executes xpr .... in this context.

Requirements

None

Examples

(import bindings checks)

;; reset local database to nested pseudolists only
(bind-listify*)
;; add vector and string support
(bind-listify* vector? vector-car vector-cdr)
(bind-listify* string? string-car string-cdr)

(bind-listify* 'a 1) ; -> '(1)
(bind-listify* '(a . as) #(1 2 3))
;-> '(1 #(2 3)))
(bind-listify* '(a (b #f) c) '(1 #(2 #f) 3))
;-> '(1 (2) 3))
(bind-listify* '(a (b (c _ . cs) d) . es) #(1 (2 (3 30 300) 4) 50))
;-> '(1 (2 (3 (300)) 4) #(50)))
(bind-listify* '(a (_ b _) . c) '(1 #(20 30 40) 5))
;-> '(1 (30) (5)))

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

(let ()
  (bind-list! (u v w))
  (and (eq? u 'u) (eq? v 'v) (eq? w 'w)))
: -> #t

(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 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 . 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)
  (>> x integer?)
  (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)
  (>> x integer?)
  (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 loop (((a b) '(5 0)))
  (>> a integer?)
  (if (zero? a)
    (list a b)
    (loop (list (- a 1) (+ b 1)))))
; -> '(0 5)

(bind-let loop (
  ((x . y) '(1 2 3))
  ((z) '#(10))
  )
  (>> x integer?) (>> y (list-of? integer?)) (>> z integer?)
  (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)))))
  (>> o? procedure?) (>> e? procedure?)
  (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 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

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

(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) (>> e zero?) e)
   ((e . f) (list e f)))
 '(1 2 3 4 5))
; -> '(1 (2 3 4 5)))

((bind-case-lambda
   ((e . f) (>> e zero?) 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))

Last update

Feb 27, 2020

Author

Juergen Lorenz

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

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

Contents »