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.
Advertisements
