;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                         Queue Operations                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Classes

;;; Queue class.
(defclass <queue> ()
  (elements :type      <list>
            :accessor  elements
            :initvalue '()))

;;; These objects can be inserted to a priority queue.
(defclass <keyed-object> ()
  (key :type      <number>
       :accessor  key
       :initarg   :key
       :initvalue 0))

;;; Priority-queue is a queue that holds <keyed-object>s.
(defclass <priority-queue> (<queue>))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Interface

;;; Is the queue empty?
(defgeneric (empty-queue? queue))

;;; Reset the queue -- get rid of all the elements.
(defgeneric (reset queue))

;;; Put a value in.
(defgeneric (enqueue element queue))

;;; Get the top queue element without removing it.
(defgeneric (queue-top queue))

;;; Pull the next element out.
(defgeneric (dequeue queue))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Implementation

(defmethod (empty-queue? (q <queue>))
  (null? (elements q)))

(defmethod (reset (q <queue>))
  (set! (elements q) empty))

;;; Add an element - always at the end.
(defmethod (enqueue x (q <queue>))
  (let ((pair (list x)))
    (if (empty-queue? q)
      (set! (elements q) pair)
      (set! (tail (last-pair (elements q))) pair))))

;;; Getting a value out always takes the first one.
(defmethod (queue-top (q <queue>))
  (if (empty-queue? q)
    (error 'dequeue "queue is empty.")
    (head (elements q))))

;;; Getting a value out of a queue.
(defmethod (dequeue (q <queue>))
  (let ((obj (queue-top q)))
    (set! (elements q) (tail (elements q)))
    obj))

;;; Forbid addition of non-<keyed-object> things in <priority-queue>s.
(defmethod (enqueue x (q <priority-queue>))
  (error 'priority-queue "elements must be <keyed-object>."))

;;; Add an element with a priority to a <priority-queue>.
(defmethod (enqueue (x <keyed-object>) (q <priority-queue>))
  (let ((elts (elements q))
        (xkey (key x)))
    ;; this adds x to a list by modifying the list
    (define (insert-x! lst)
      (if (or (null? (tail lst)) (< xkey (key (second lst))))
        (set! (tail lst) (cons x (tail lst)))
        (insert-x! (tail lst))))
    (if (or (null? elts) (< xkey (key (head elts))))
      (set! (elements q) (cons x elts))
      (insert-x! elts))))