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.
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Tue, 05 Jul 2016 23:37:14 +0000 |
| parents |
9086482c09ee
|
| children |
a3466a551136
|
| branches/tags |
(none) |
| files |
package.lisp src/utils.lisp src/wam/wam.lisp |
Changes
--- 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
--- 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
--- 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))