# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1467761834 0
# Node ID 209ecb9eeb253a6b137e0bb54f1e29b3c8a77632
# Parent  9086482c09eec682dbe0bd569f1a4030c7c0f161
Use a queues instead of lists for the logic frame pending predicates

I wonder if this is ACTUALLY faster, since often there will probably only be
a couple of entries in a particular predicate's list?  But then again there are
some HUGE predicates (e.g. successor relations), so it'll benefit us there.

Either way, conceptually the thing should be FIFO, so as long as using queues
doesn't COST us performance I'm happy.

diff -r 9086482c09ee -r 209ecb9eeb25 package.lisp
--- a/package.lisp	Tue Jul 05 23:12:50 2016 +0000
+++ b/package.lisp	Tue Jul 05 23:37:14 2016 +0000
@@ -17,9 +17,11 @@
     #:when-let
     #:unique-items
     #:dis
+    #:gethash-or-init
     #:make-queue
     #:enqueue
     #:dequeue
+    #:queue-contents
     #:queue-empty-p
     #:queue-append)
   (:shadowing-import-from #:cl-arrows
diff -r 9086482c09ee -r 209ecb9eeb25 src/utils.lisp
--- a/src/utils.lisp	Tue Jul 05 23:12:50 2016 +0000
+++ b/src/utils.lisp	Tue Jul 05 23:37:14 2016 +0000
@@ -93,9 +93,28 @@
                 ,@body))
       (recur ,@(mapcar #'extract-val bindings)))))
 
+(defmacro gethash-or-init (key hash-table default-form)
+  "Get the a key's value in a hash table, initializing if necessary.
+
+  If `key` is in `hash-table`: return its value without evaluating
+  `default-form` at all.
+
+  If `key` is NOT in `hash-table`: evaluate `default-form` and insert it before
+  returning it.
+
+  "
+  ;; TODO: think up a less shitty name for this
+  (once-only (key hash-table)
+    (with-gensyms (value found)
+      `(multiple-value-bind (,value ,found)
+        (gethash ,key ,hash-table)
+        (if ,found
+          ,value
+          (setf (gethash ,key ,hash-table) ,default-form))))))
+
 
 ;;;; Queues
-;;; Thanks, Norvig.
+;;; From PAIP (thanks, Norvig).
 
 (deftype queue () '(cons list list))
 (declaim (inline queue-contents make-queue
diff -r 9086482c09ee -r 209ecb9eeb25 src/wam/wam.lisp
--- a/src/wam/wam.lisp	Tue Jul 05 23:12:50 2016 +0000
+++ b/src/wam/wam.lisp	Tue Jul 05 23:37:14 2016 +0000
@@ -674,7 +674,7 @@
     (assert-label-not-already-compiled wam clause label)
     (with-slots (predicates)
         (wam-current-logic-frame wam)
-      (push clause (gethash label predicates))))
+      (enqueue clause (gethash-or-init label predicates (make-queue)))))
   (values))
 
 
@@ -684,7 +684,8 @@
   (with-slots (predicates final)
       (wam-current-logic-frame wam)
     (loop :for clauses :being :the hash-values :of predicates
-          :do (compile-rules wam (reverse clauses))) ; circular dep here, ugh.
+          ;; circular dep on the compiler here, ugh.
+          :do (compile-rules wam (queue-contents clauses)))
     (setf final t))
   (values))