; 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)