;;;; streams.queue.scm  -*- Scheme -*-
;;;; Kon Lovett, Feb '19
;;;; Kon Lovett, Aug '10

;;;; From "samples.ss"
;;;; Provides a functional queue abstraction using streams.

(module (streams queue)

(;export
  ;original
  queue-null
  queue-null?
  queue-cons
  queue-head
  queue-tail
  ;extras
  make-queue
  queue)

(import scheme
  (chicken base)
  (chicken fixnum)
  (chicken type)
  (chicken syntax)
  (only type-checks check-pair)
  streams)

;;;

(define (finalize-queue 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)
  (finalize-queue (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-tail "empty queue")
    (finalize-queue (stream-cdr (car q)) (cdr q)) ) )

;;

; l 1 2 3 => q 3 2 1
(define (make-queue ls)
  (let loop ((ls ls) (q queue-null))
    (if (null? ls) q
      (loop (cdr ls) (queue-cons q (car ls))) ) ) )

; 1 2 3 => q 3 2 1
(define (queue . rest) (apply make-queue rest))

) ;(streams queue)