Programming Praxis

Our code is a very close translation of Okasaki’s SML code to Scheme:

(define queue list)

(define empty (queue (list) 0 (delay (list)) 0 (list)))
(define (empty? q) (zero? (cadr q)))

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

(define (snoc q x)
  (let-values (((w lenf f lenr r) (apply values q)))
    (check w lenf f (+ lenr 1) (cons x r))))

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

For functions empty?, snoc, head and tail that are visible to the caller, we pass a single argument q and destructure it using either caar or cadr or let-values ... apply values as a poor-man’s pattern matcher. For the internal functions check and checkw, we pass the pieces of the queue, with no need to build them into a data structure and then destructure them later. Here are some examples:

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

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

Pages: 1 2