# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1471994884 0
# Node ID df709571ebe3bb3ec271571dfad3d69a64997835
# Parent  551c9d5d47d4467acddf04cfd79f34039fe9b898
Use `ensure-gethash`

diff -r 551c9d5d47d4 -r df709571ebe3 package.lisp
--- 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
diff -r 551c9d5d47d4 -r df709571ebe3 src/utils.lisp
--- 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.
 
diff -r 551c9d5d47d4 -r df709571ebe3 src/wam.lisp
--- 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))))
diff -r 551c9d5d47d4 -r df709571ebe3 vendor/make-quickutils.lisp
--- 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")
 
diff -r 551c9d5d47d4 -r df709571ebe3 vendor/quickutils.lisp
--- 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 ;;;;