1. Destructuring sequence expressions with bindings
    1. Documentation
      1. bindings
    2. Sequence routines
      1. bind-pseudo-list?
      2. bind-seq-exception
      3. bind-seq-db
      4. bind-seq-ref
      5. bind-seq-tail
      6. bind-seq-null?
    3. Binding macros
      1. bind
      2. bindable?
      3. bind-case
      4. bind-define
      5. bind-set!
      6. bind-lambda
      7. bind-lambda*
      8. bind-case-lambda
      9. bind-case-lambda*
      10. bind-named
      11. bindrec
      12. bind-let
      13. bind-let*
      14. bind-letrec
      15. bind/cc
    4. Requirements
    5. Usage
    6. Examples
  2. Last update
  3. Author
  4. License
  5. Version History

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 all destructure arbitrary mixtures of (pseudo-) lists, vectors and strings, which match a pattern, and can be easily enhanced, to accept other sequence types as well, arrays, for example. For this to be possible, sequence equivalents for list-ref, list-tail and null? have to be implemented, which use a database routine named bind-seq-db.

The syntax of the fundamental bind macro is as follows

[syntax] (bind pat seq (where fender ...) .. xpr ....)

Here, a pattern, pat, is a nested psudolist of (mostly) symbols, seq a sequencce expression, i.e. a mixture of pseudolists, vectors and strings, fender a check expression on pattern variables, var, of the form (var ok? ...) and xpr .... constitute the body of the macro. Note the special use of dots here and below: Three dots repeat the expression to the left zero or many times, two dots zero or one times and four dots one or many times.

This macro binds pattern variables, i.e. symbols of pat, to corresponding sequenceds of seq, checks, if the fenders succeed and exectutes the body in this context.

There are some features, which I would like to have and which are implemented as well. First wildcards, represented by the underscore symbol. It matches everything, but binds nothing. So it can appear multiple times in the same macro. Wildcard symbols are simply not collected in the internal destructure routine.

Second, non-symbol literals, which don't bind anything, of course, but match only expressions evaluating to themselves.

The last feature missing is fenders, which is important in particular for bind-case and can easily be implemented with a where clause: A pattern matches successfully if only each pattern variable can be bound and the checks as well as the fenders are satisfied. If the where clause doesn't pass, the next pattern is tried in bind-case or a bind-seq-exception is signalled in bind.

This version is a port to chicken-5 from the last version 7.1 of chicken-4, which in turn was a complete rewrite. The code no longer uses Graham's dbind implementation. Instead, a direct implementation of bind is given, which doesn't need gensyms. The internal destructure routine transforms the pattern and sequence arguments into three lists, pairs, literals and tails. Pairs is a list of pattern-variable and corresponding sequence-accesscode pairs to be used in a let at runtime, literals and tails check for equality of literals and their corresponding sequence values, and the emptyness of sequence tails corresponding to null patterns respectively. So, contrary to Graham's dbind, an exception is raised if the lengths of a pattern and its corresponding sequence don't match. Fenders are supplied in a where clause at the very beginning of the macro body: A list of pattern-variable predicates pairs is internally transformed into a list of predicate calls.

Algebraic types of the latest chicken-4 version are removed and will be outsourced to another egg.

Documentation

bindings

[procedure] (bindings sym ..)

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

Sequence routines

bind-pseudo-list?

[procedure] (bind-pseudo-list? xpr)

always #t

bind-seq-exception

[procedure] (bind-seq-exception loc . args)

generates an exception to be raised

bind-seq-db

[procedure] (bind-seq-db)

shows the sequence database

[procedure] (bind-seq-db type? ref: ref tail: tail)

adds a new custom sequence type with predicate type? and keyword arguments ref: and tail: naming procedures to be later accessed via bind-seq-ref and bind-seq-tail respectively.

bind-seq-ref

[procedure] (bind-seq-ref seq k)

sequence analog of list-ref

bind-seq-tail

[procedure] (bind-seq-tail seq k)

sequence analog of list-tail

bind-seq-null?

[procedure] (bind-seq-null? xpr)

sequence analog of null?

Binding macros

bind

[syntax] (bind pat seq (where fender ...) .. xpr ....)

binds pattern variables of pat to subexpressions of seq and executes xpr .... in this context, provided all fenders return #t, if supplied.

bindable?

[syntax] (bindable? pat (where fender ...) ..)

returns a unary predicate which checks, if its sequence argument matches the pattern argument, pat, of bindable? and passes all of its fenders (the syntax is slightly changed for consistency).

bind-case

[syntax] (bind-case seq (pat (where fender ...) .. xpr ....) ....)

Matches seq against a series of patterns and executes the body of the first matching pattern satisfying fenders (if given).

bind-define

[syntax] (bind-define pat seq pat1 seq1 ... (where fender ...) ..)

defines pattern variables of pat pat1 ... with values matching subexpressions of seq seq1 ... in one go

bind-set!

[syntax] (bind-set! pat seq pat1 seq1 ... (where fender ...) ..)

sets symbols of pat pat1 ... to corresponding subexpressions of seq seq1 ...

bind-lambda

[syntax] (bind-lambda pat (where fender ...) .. xpr ....)

combination of lambda and bind, one pattern argument

bind-lambda*

[syntax] (bind-lambda* pat (where fender ...) .. xpr ....)

combination of lambda and bind, multiple pattern arguments

bind-case-lambda

[syntax] (bind-case-lambda (pat (where fender ...) .. xpr ....) ....)

Combination of bind-case and lambda with one pattern argument

bind-case-lambda*

[syntax] (bind-case-lambda* (pat (where fender ...) .. xpr ....) ....)

Combination of bind-case and lambda with multiple pattern arguments

bind-named

[syntax] (bind-named loop pat seq (where fender ...) .. xpr ....)

named version of bind. loop is bound to a procedure, which can be used in the body xpr ....

bindrec

[syntax] (bindrec pat seq (where fender ...) .. xpr ....)

bind pattern variables of pat to subsequences of seq recursively

bind-let

[syntax] (bind-let loop .. ((pat seq) ...) (where fender ...) .. xpr ....)

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*

[syntax] (bind-let* ((pat seq) ...) (where fender ...) .. xpr ....)

like let*, but binds patterns to sequence templates

bind-letrec

[syntax] (bind-letrec ((patseq) ...) (where fender ...) .. xpr ....)

like letrec, but binds patterns to sequence templates

bind/cc

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

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

Requirements

simple-exceptions

Usage

(import bindings)

Examples


(import bindings)

(let ((stack #f) (push! #f) (pop! #f))
  (bind-set! (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
  (bind-define (top push! pop!)
    (let ((lst '()))
      (vector
        (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))

((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-named loop (x (a . b) y) '(5 #(1) 0)
  (where (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-named 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)))
  (where (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))
  )
  (where (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)))))
  (where (o? procedure?) (e? procedure?))
  (list (o? 95) (e? 95)))
; -> '(#t #f)

(bind-letrec (
  ((o? (e?))
   (list (lambda (m) (if (zero? m) #f (e? (- m 1))))
         (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

((bindable? (a b) (even? a)) '#(1 2))
; -> #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) (where (e zero?)) e)
   ((e . f) (list e f)))
 '(1 2 3 4 5))
; -> '(1 (2 3 4 5)))

((bind-case-lambda
   ((e . f) (where (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 C d))
   ((e . f) (list 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 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

Aug 30, 2018

Author

Juergen Lorenz

License

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

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