--- a/package.lisp Tue Aug 23 23:26:36 2016 +0000
+++ b/package.lisp Tue Aug 23 23:28:04 2016 +0000
@@ -30,7 +30,6 @@
#:when-let
#:megabytes
#:ecase/tree
- #:gethash-or-init
#:aref-or-init
#:define-lookup
#:queue
--- a/src/utils.lisp Tue Aug 23 23:26:36 2016 +0000
+++ b/src/utils.lisp Tue Aug 23 23:28:04 2016 +0000
@@ -59,25 +59,6 @@
,@body))
(recur ,@(mapcar #'extract-val bindings)))))
-(defmacro gethash-or-init (key hash-table default-form)
- "Get `key`'s value in `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))))))
-
(defmacro aref-or-init (array index default-form)
"Get `index` in `array`, initializing if necessary.
--- a/src/wam.lisp Tue Aug 23 23:26:36 2016 +0000
+++ b/src/wam.lisp Tue Aug 23 23:28:04 2016 +0000
@@ -748,7 +748,7 @@
(multiple-value-bind (functor arity) (find-predicate clause)
(assert-label-not-already-compiled wam clause functor arity)
- (enqueue clause (gethash-or-init
+ (enqueue clause (ensure-gethash
(cons functor arity)
(logic-frame-predicates (wam-current-logic-frame wam))
(make-queue))))
--- a/vendor/make-quickutils.lisp Tue Aug 23 23:26:36 2016 +0000
+++ b/vendor/make-quickutils.lisp Tue Aug 23 23:28:04 2016 +0000
@@ -19,6 +19,7 @@
:weave
:alist-plist
:equivalence-classes
+ :ensure-gethash
:map-product)
:package "TEMPERANCE.QUICKUTILS")
--- a/vendor/quickutils.lisp Tue Aug 23 23:26:36 2016 +0000
+++ b/vendor/quickutils.lisp Tue Aug 23 23:28:04 2016 +0000
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:DEFINE-CONSTANT :SET-EQUAL :CURRY :RCURRY :SWITCH :ENSURE-BOOLEAN :WHILE :UNTIL :TREE-MEMBER-P :WITH-GENSYMS :ONCE-ONLY :ZIP :ALIST-TO-HASH-TABLE :MAP-TREE :WEAVE :ALIST-PLIST :EQUIVALENCE-CLASSES :MAP-PRODUCT) :ensure-package T :package "TEMPERANCE.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:DEFINE-CONSTANT :SET-EQUAL :CURRY :RCURRY :SWITCH :ENSURE-BOOLEAN :WHILE :UNTIL :TREE-MEMBER-P :WITH-GENSYMS :ONCE-ONLY :ZIP :ALIST-TO-HASH-TABLE :MAP-TREE :WEAVE :ALIST-PLIST :EQUIVALENCE-CLASSES :ENSURE-GETHASH :MAP-PRODUCT) :ensure-package T :package "TEMPERANCE.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "TEMPERANCE.QUICKUTILS")
@@ -21,8 +21,8 @@
:TREE-MEMBER-P :ONCE-ONLY :TRANSPOSE
:ZIP :ALIST-TO-HASH-TABLE :MAP-TREE
:WEAVE :SAFE-ENDP :ALIST-PLIST
- :EQUIVALENCE-CLASSES :MAPPEND
- :MAP-PRODUCT))))
+ :EQUIVALENCE-CLASSES :ENSURE-GETHASH
+ :MAPPEND :MAP-PRODUCT))))
(defun %reevaluate-constant (name value test)
(if (not (boundp name))
@@ -377,6 +377,16 @@
classes)))
+ (defmacro ensure-gethash (key hash-table &optional default)
+ "Like `gethash`, but if `key` is not found in the `hash-table` saves the `default`
+under key before returning it. Secondary return value is true if key was
+already in the table."
+ `(multiple-value-bind (value ok) (gethash ,key ,hash-table)
+ (if ok
+ (values value ok)
+ (values (setf (gethash ,key ,hash-table) ,default) nil))))
+
+
(defun mappend (function &rest lists)
"Applies `function` to respective element(s) of each `list`, appending all the
all the result list to a single list. `function` must return a list."
@@ -408,6 +418,7 @@
(export '(define-constant set-equal curry rcurry switch eswitch cswitch
ensure-boolean while until tree-member-p with-gensyms
with-unique-names once-only zip alist-to-hash-table map-tree weave
- alist-plist plist-alist equivalence-classes map-product)))
+ alist-plist plist-alist equivalence-classes ensure-gethash
+ map-product)))
;;;; END OF quickutils.lisp ;;;;