a2ff64cc3ac9

--- a/package.lisp	Mon Feb 06 14:32:50 2017 +0000
+++ b/package.lisp	Wed Feb 15 10:23:50 2017 +0000
@@ -258,6 +258,16 @@
   (:export
     ))
 
+(defpackage :sand.pq
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils)
+  (:export
+    ))
+
 (defpackage :sand.easing
   (:use
     :cl

--- a/sand.asd	Mon Feb 06 14:32:50 2017 +0000
+++ b/sand.asd	Wed Feb 15 10:23:50 2017 +0000
@@ -33,6 +33,7 @@
                :sketch
                :split-sequence
                :trivia
+               :trivial-main-thread
                :vex
                :yason
 
@@ -49,6 +50,7 @@
     :components ((:file "utils")
                  (:file "primes")
                  (:file "graphs")
+                 (:file "pq")
                  (:file "graphviz")
                  (:file "hanoi")
                  (:file "urn")

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/pq.lisp	Wed Feb 15 10:23:50 2017 +0000
@@ -0,0 +1,48 @@
+(in-package :sand.pq)
+
+;;;; Priority Queue -----------------------------------------------------------
+;;; Jankass priority queue implementation.
+(defstruct pq
+  (contents nil)
+  (predicate #'<)
+  (test #'eql))
+
+
+(defun pqn-priority (node)
+  (first node))
+
+(defun pqn-element (node)
+  (second node))
+
+
+(defun pq-resort (pq)
+  (zapf (pq-contents pq)
+        (sort % (pq-predicate pq) :key #'pqn-priority))
+  pq)
+
+(defun pq-lookup (pq element)
+  (find element (pq-contents pq)
+        :key #'pqn-element
+        :test (pq-test pq)))
+
+(defun pq-insert (pq element priority)
+  (zapf (pq-contents pq)
+        (merge 'list `((,priority ,element)) % (pq-predicate pq)
+               :key #'pqn-priority))
+  pq)
+
+(defun pq-ensure (pq element priority)
+  (let ((existing (pq-lookup pq element)))
+    (if existing
+      (progn (setf (car existing) priority)
+             (pq-resort pq)
+             t)
+      (progn (pq-insert pq element priority)
+             nil)))
+  pq)
+
+(defun pq-dequeue (pq)
+  (if (pq-contents pq)
+    (values (pqn-element (pop (pq-contents pq))) t)
+    (values nil nil)))
+