; okasaki's physicist's queues
(use-modules (srfi srfi-11))
(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))))
(define q empty)
(set! q (snoc q 1))
(set! q (snoc q 2))
(display (head q)) (newline)
(set! q (snoc q 3))
(display (head q)) (newline)
(set! q (tail q))
(display (head q)) (newline)
(set! q (tail q))
(display (head q)) (newline)
(set! q (tail q))
(display (empty? q)) (newline)