c49425b33f17

--- a/DOCUMENTATION.markdown	Wed Mar 01 19:14:51 2017 +0000
+++ b/DOCUMENTATION.markdown	Wed Mar 01 19:32:57 2017 +0000
@@ -1355,6 +1355,63 @@
 
   
 
+## Package `LOSH.PRIORITY-QUEUES`
+
+Jankass priority queue implementation.
+
+### `MAKE-PRIORITY-QUEUE` (function)
+
+    (MAKE-PRIORITY-QUEUE &KEY (PRIORITY-PREDICATE #'<) (ELEMENT-TEST #'EQL))
+
+Create and return a fresh priority queue.
+
+  `priority-predicate` is the comparison function used to compare priorities,
+  and should be a `<`-like predicate.
+
+  `element-test` should be the equality predicate for elements.
+
+  
+
+### `PQ-DEQUEUE` (function)
+
+    (PQ-DEQUEUE PQ)
+
+Remove and return the element in `pq` with the lowest-numbered priority.
+
+  If `pq` is empty `nil` will be returned.
+
+  A second value is also returned, which will be `t` if an element was present
+  or `nil` if the priority queue was empty.
+
+  
+
+### `PQ-ENSURE` (function)
+
+    (PQ-ENSURE PQ ELEMENT PRIORITY)
+
+Ensure `element` is in `pq` with `priority`.
+
+  If `element` is already in `pq` its priority will be set to `priority`.
+  Otherwise it will be inserted as if by calling `pq-insert`.
+
+  Returns `pq` (which may have been modified).
+
+  
+
+### `PQ-INSERT` (function)
+
+    (PQ-INSERT PQ ELEMENT PRIORITY)
+
+Insert `element` into `pq` with `priority`.
+
+  Returns `pq` (which has been modified).
+
+  
+
+### `PRIORITY-QUEUE` (struct)
+
+Slots: `CONTENTS`, `PREDICATE`, `TEST`
+
 ## Package `LOSH.QUEUES`
 
 A simple queue implementation.

--- a/losh.lisp	Wed Mar 01 19:14:51 2017 +0000
+++ b/losh.lisp	Wed Mar 01 19:32:57 2017 +0000
@@ -616,13 +616,14 @@
 
 
 ;;;; Mutation -----------------------------------------------------------------
-(defun build-zap (place expr env)
-  (multiple-value-bind (temps exprs stores store-expr access-expr)
-      (get-setf-expansion place env)
-    `(let* (,@(mapcar #'list temps exprs)
-            (,(car stores) (symbol-macrolet ((% ,access-expr))
-                             ,expr)))
-      ,store-expr)))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun build-zap (place expr env)
+    (multiple-value-bind (temps exprs stores store-expr access-expr)
+        (get-setf-expansion place env)
+      `(let* (,@(mapcar #'list temps exprs)
+              (,(car stores) (symbol-macrolet ((% ,access-expr))
+                               ,expr)))
+         ,store-expr))))
 
 (defmacro zapf (&rest place-expr-pairs &environment env)
   "Update each `place` by evaluating `expr` with `%` bound to the current value.
@@ -2135,6 +2136,90 @@
     (finding item :such-that (< n weight))))
 
 
+;;;; Priority Queues ----------------------------------------------------------
+;;; Jankass priority queue implementation.
+(defstruct (priority-queue (:conc-name pq-)
+                           (:constructor make-priority-queue%))
+  (contents nil)
+  (predicate #'<)
+  (test #'eql))
+
+
+(defun make-priority-queue (&key (priority-predicate #'<) (element-test #'eql))
+  "Create and return a fresh priority queue.
+
+  `priority-predicate` is the comparison function used to compare priorities,
+  and should be a `<`-like predicate.
+
+  `element-test` should be the equality predicate for elements.
+
+  "
+  (make-priority-queue% :predicate priority-predicate :test element-test))
+
+
+(defmethod print-object ((object priority-queue) stream)
+  (print-unreadable-object (object stream :type t :identity t)
+    (prin1 (pq-contents object) stream)))
+
+
+(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)
+  "Insert `element` into `pq` with `priority`.
+
+  Returns `pq` (which has been modified).
+
+  "
+  (zapf (pq-contents pq)
+        (merge 'list `((,priority ,element)) % (pq-predicate pq)
+               :key #'pqn-priority))
+  pq)
+
+(defun pq-ensure (pq element priority)
+  "Ensure `element` is in `pq` with `priority`.
+
+  If `element` is already in `pq` its priority will be set to `priority`.
+  Otherwise it will be inserted as if by calling `pq-insert`.
+
+  Returns `pq` (which may have been modified).
+
+  "
+  (let ((existing (pq-lookup pq element)))
+    (if existing
+      (progn (setf (car existing) priority)
+             (pq-resort pq))
+      (pq-insert pq element priority)))
+  pq)
+
+(defun pq-dequeue (pq)
+  "Remove and return the element in `pq` with the lowest-numbered priority.
+
+  If `pq` is empty `nil` will be returned.
+
+  A second value is also returned, which will be `t` if an element was present
+  or `nil` if the priority queue was empty.
+
+  "
+  (if (pq-contents pq)
+    (values (pqn-element (pop (pq-contents pq))) t)
+    (values nil nil)))
+
+
 ;;;; Hash Sets ----------------------------------------------------------------
 (defstruct (hash-set (:constructor make-hash-set%))
   (storage (error "Required") :type hash-table :read-only t))
@@ -2352,7 +2437,6 @@
   (hash-table-keys storage))
 
 
-
 ;;;; Bit Sets -----------------------------------------------------------------
 ;;; Implementation of the sets-as-integers idea in the Common Lisp Recipes book.
 (deftype bset () '(integer 0))

--- a/make-docs.lisp	Wed Mar 01 19:14:51 2017 +0000
+++ b/make-docs.lisp	Wed Mar 01 19:32:57 2017 +0000
@@ -19,6 +19,7 @@
         "LOSH.LICENSING"
         "LOSH.MATH"
         "LOSH.MUTATION"
+        "LOSH.PRIORITY-QUEUES"
         "LOSH.QUEUES"
         "LOSH.RANDOM"
         "LOSH.SEQUENCES"

--- a/package.lisp	Wed Mar 01 19:14:51 2017 +0000
+++ b/package.lisp	Wed Mar 01 19:32:57 2017 +0000
@@ -233,6 +233,16 @@
     :notf
     :callf))
 
+(defpackage :losh.priority-queues
+  (:documentation "Jankass priority queue implementation.")
+  (:export
+    :priority-queue
+    :make-priority-queue
+
+    :pq-insert
+    :pq-ensure
+    :pq-dequeue))
+
 (defpackage :losh.queues
   (:documentation "A simple queue implementation.")
   (:export
@@ -302,6 +312,7 @@
    :losh.licensing
    :losh.math
    :losh.mutation
+   :losh.priority-queues
    :losh.queues
    :losh.random
    :losh.sequences