Okasaki’s Physicists Queues
April 2, 2019
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.