;;;; 	Copyright (C) 1995 Free Software Foundation, Inc.
;;;; 
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;; 
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING.  If not, write to
;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;; 



;;; Based on the interface to 
;;;
;;; "queue.scm"  Queues/Stacks for Scheme 
;;;  Written by Andrew Wilcox (awilcox@astro.psu.edu) on April 1, 1992.
;;;

(define queue:tag (cons 'queue-tag '()))

(define (make-queue) (cons queue:tag (cons '() '())))
(define (queue? obj) (and (pair? obj) (eq? queue:tag (car obj))))
(define (queue-empty? obj) (null? (caar obj)))

(define (queue:queue-empty-check q) (if (queue-empty? q) (throw 'queue-empty q)))
(define (queue-front q) (queue:queue-empty-check q) (cadr q))
(define (queue-rear q) (queue:queue-empty-check q) (cddr q))

(define (queue-push! q d)
  (let ((h (cons d (cadr q))))
    (set-car! (cdr q) h)
    (if (null? (cddr q))
	(set-cdr! (cdr q) h))))

(define (enqueue! q d)
  (let ((h (cons d '())))
    (if (not (null? (cddr q)))
       	(set-cdr! (cddr q) h)
	(set-car! (cdr q) h))
    (set-cdr! (cdr q) h)))

(define (queue-pop! q)
  (let ((h (queue-front q)))
    (if (null? h)
	(throw 'queue-empty q))
    (if (null? (cdr h))
	(set-cdr! (cdr q) '()))
    (set-car! (cdr q) (cdr h))
    (car h)))

(define dequeue! queue-pop!)
(define (queue-length q) (length (cadr q)))

(provide 'queue)
