(define-module (pq)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (ice-9 q)
  #:export (make-pq
            pq?
            pq-push!
            pq-pop!
            pq-length
            pq-empty?
            pq-front
            pq-rear
            q-ref
            q-insert!))


(define (make-pq)
  (make-q))

(define (pq? obj)
  "Return #t if OBJ is a priority-queue.
An object is a priority-queue if it is a
queue, and if all elements are ordered from
largest to smallest."
  (and (q? obj)
       (or (q-empty? obj)
           (sorted? (car obj) descending-priority?))))

(define (pq-push! pq e p)
  "Given the priority queue PQ,
element E and its priority P, inserts E
in the appropriate spot given P."
  (let ((ele (cons e p)))
    (if (q-empty? pq)
        (q-push! pq ele)
        (let loop ((i 0))
          (if (or (equal? i (q-length pq))
                  (>= p (cdr (q-ref pq i))))
              (q-insert! pq i ele)
              (loop (1+ i)))))))

(define (pq-pop! pq)
  (q-pop! pq))

(define (pq-length pq)
  (q-length pq))

(define (pq-empty? pq)
  (q-empty? pq))

(define (pq-front pq)
  (q-front pq))

(define (pq-rear pq)
  (q-rear pq))

(define (descending-priority? a b)
  "Helper for pq? Checks that two
adjacent elements in a priority queue
contain a descending number in their cdr
slots."
  (not
   (and (pair? a) (pair? b)
        (integer? (cdr a))
        (integer? (cdr b))
        (>= (cdr b) (cdr a)))))

(define (q-ref q i)
  "Given queue Q and integer I,
returns the element in Q at I, or
a out of range exception."
  (list-ref (car q) i))

(define (q-insert! q i ele)
  "Places item ELE in position I of
Q, or returns an index-out-of-range
exception."
  (let ((lst (car q))
        (len (q-length q)))
    (cond
     ((> i len) (throw 'index-out-of-range q i))
     ((equal? i len)
      (enq! q ele))
     (#t
      (set-car! q (append (list-head lst i)
                          (cons ele (list-tail lst i)))))))
  q)