Programming Praxis

We call our function bind; it’s not quite the same as the destructuring-bind of Common Lisp, and bind is easier to type:

(define-syntax bind (lambda (stx) ; (bind pattern values body ...)
  ; Pattern is a possibly-nested list of symbols, values is a list of items of
  ; the same "shape" as pattern, and body is a non-empty sequence of expressions.
  ; The bind macro executes the body expressions in an environment with each
  ; value let-bound to the corresponding symbol. Writing "& x" at the end of the
  ; pattern list causes the remaining values to be bound to x in a list. Symbol
  ; "_" in the pattern matches the corresponding value but causes no binding.
  ; Extra values are silently ignored, missing values cause an error. Examples:
  ;     (bind (a b c) '(1 2 3) (list c b a)) => (3 2 1)
  ;     (bind (a b c) '(1 2 3 4) (list c b a)) => (3 2 1)
  ;     (bind (a b c) '(1 2) (list c b a)) => causes an error
  ;     (bind (a b (c d)) '(1 2 (3 4)) (list d c b a)) => (4 3 2 1)
  ;     (bind (a b & c) '(1 2 3 4) (list c b a)) => ((3 4) 2 1)
  ;     (bind (a _ c) '(1 2 3) (list c a)) => (3 1)

  ;     (bind (a (b & c)) '(1 (2 3 4)) (list c b a)) => ((3 4) 2 1)
  ;     (let ((x 3)) (bind (a b c) '(1 (+ 1 1) x) (list c b a))) => (x (+ 1 1) 1)
  ;     (let ((x 3)) (bind (a b c) `(1 ,(+ 1 1) ,x) (list c b a))) => (3 2 1)
  ; As an example, the macro-expression (bind (a b c) '(1 2 3) (list c b a))
  ; expands to (let ((a 1)) (let ((b 2)) (let ((c 3)) (list c b a)))). Similar to
  ; Common Lisp destruturing-bind or many "match" macro libraries in Scheme.
  (define (underscore? x) (and (identifier? x) (free-identifier=? x (syntax _))))
  (syntax-case stx (&)
    ((bind () vals body ...) ; end of pattern, ignore extra values
      (syntax (begin body ...)))
    ((bind (& pat) vals body ...) ; rest pattern, collect remaining values
      (syntax (let ((pat vals)) body ...)))
    ((bind (underscore) vals body ...) ; non-binding pattern at end
      (underscore? (syntax underscore)) (syntax (begin body ...)))
    ((bind (underscore pat ...) vals body ...) ; non-binding pattern not at end
      (underscore? (syntax underscore))
        (syntax (bind (pat ...) (cdr vals) body ...)))
    ((bind ((nest ...) pat ...) vals body ...) ; nested pattern
      (syntax (bind (pat ...) (cdr vals) (bind (nest ...) (car vals) body ...))))
    ((bind (pat) vals body ...) ; last binding in pattern
      (syntax (let ((pat (car vals))) body ...)))
    ((bind (pat1 pat2 ...) vals body ...) ; more bindings in pattern
      (syntax (let ((pat1 (car vals))) (bind (pat2 ...) (cdr vals) body ...)))))))

We have to use syntax-case, rather than syntax-rules, because there is no way to escape the underscore in syntax-rules. We illustrate the bind function by reimplementing Okasaki’s physicist’s queues from the prior exercise:

(define queue list)

(define empty (queue '() 0 (delay '()) 0 '()))
(define (empty? q) (bind (_ lenf _ _ _) q (zero? lenf)))

(define (checkw q) (bind (w lenf f lenr r) q
  (if (null? w) (queue (force f) lenf f lenr r) q)))
(define (check q) (bind (w lenf f lenr r) q
  (if (< lenr lenf) (checkw q)
      (let ((fprime (force f)))
      (checkw (queue fprime (+ lenf lenr)
                     (delay (append fprime (reverse r))) 0 '()))))))

(define (snoc q x) (bind (w lenf f lenr r) q
  (check (queue w lenf f (+ lenr 1) (cons x r)))))

(define (head q) (bind (w _ _ _ _) q
  (if (null? w) (error 'head "empty queue") (car w))))
(define (tail q) (bind (w lenf f lenr r) q
  (if (null? w) (error 'tail "empty queue")
    (check (queue (cdr w) (- lenf 1) (delay (cdr (force f))) lenr r)))))

Visually, that is extremely similar to Okasaki’s code. Here is an example:

> (define q empty)
> (set! q (snoc q 1))
> (set! q (snoc q 2))
> (set! q (snoc q 3))
> (head q)
1
> (set! q (tail q))
> (head q)
2
> (set! q (tail q))
> (head q)
3
> (set! q (tail q))
> (empty? q)
#t

This version is more regular than the previous version (every function begins by destructuring the elements of a queue), but that regularity comes at a cost: the snoc and tail functions have to cons up a queue, only to have it destructured in check, and likewise for the call from check to checkw. The let-values code of the previous exercise is more efficient, so we have traded that efficiency for readability. This program is small enough that the readability probably doesn’t matter, but in a larger program it might matter a lot.

You can run the program at https://ideone.com/66284X.

Pages: 1 2