;;;; streams-queue.scm
;;;; Kon Lovett, Aug '10
;;;; From "samples.ss"
:::: Provides a functional queue abstraction using streams.

(module streams-queue

  (;export
    queue-null
    queue-null?
    queue-cons
    queue-head
    queue-tail)

  (import
    scheme chicken
    streams
    (only type-errors
      error-pair))

  (require-library streams type-errors)

  (include "chicken-primitive-object-inlines")
  (include "streams-inlines")
  (include "inline-type-checks")

(define-inline (queue-check f r)
  (if (%fx< (stream-length r) (stream-length f)) (%cons f r)
      (%cons (stream-append f (stream-reverse r)) stream-null) ) )

(define queue-null
  (%cons stream-null stream-null) )

(define (queue-null? x)
  (and (%pair? x) (stream-null (%car x))) )

(define (queue-cons q x)
  (%check-pair 'queue-cons q 'queue)
  (queue-check (%car q) (stream-cons x (%cdr q))) )

(define (queue-head q)
  (%check-pair 'queue-head q 'queue)
  (if (stream-null? (%car q)) (error 'queue-head "empty queue")
      (stream-car (%car q)) ) )

(define (queue-tail q)
  (%check-pair 'queue-tail q 'queue)
  (if (stream-null? (%car q)) (error 'queue-head "empty queue")
      (queue-check (stream-cdr (%car q)) (%cdr q)) ) )

) ;streams-queue