Przeglądaj źródła

made memoize thread-safe

Mark VandenBrink 12 lat temu
rodzic
commit
2ae14bbcc4
1 zmienionych plików z 24 dodań i 8 usunięć
  1. 24 8
      utils.lisp

+ 24 - 8
utils.lisp

@@ -83,17 +83,33 @@ The above will expand to (ash (logand #xFFFBB240 #xFFE00000) -21) at COMPILE tim
   `(aif ,test-form
   `(aif ,test-form
         (progn ,@body)))
         (progn ,@body)))
 
 
+;;; in multi-thread mode, need to protect insertions into hash-table
+;;; Note: CCL hash-tables are thread-safe, but some other implementations
+;;; don't appear to be...
+(defstruct locked-hash-table lock hash-table)
+#+ENABLE-MP (defmacro with-lock ((l) &body body)
+              `(bt:with-lock-held (,l)
+                 ,@body))
+#-ENABLE-MP (defmacro with-lock ((l) &body body)
+              (declare (ignore l))
+              `(progn
+                 ,@body))
+
 (defun mk-memoize (func-name)
 (defun mk-memoize (func-name)
   "Takes a normal function object and returns a memoized one"
   "Takes a normal function object and returns a memoized one"
   (declare #.utils:*standard-optimize-settings*)
   (declare #.utils:*standard-optimize-settings*)
   (let* ((func (symbol-function func-name))
   (let* ((func (symbol-function func-name))
-         (hash-table (make-hash-table :test 'equal)))
-
-    #'(lambda (arg)
-        (multiple-value-bind (value foundp) (gethash arg hash-table)
-          (if foundp
-              value
-              (setf (gethash arg hash-table) (funcall func arg)))))))
+         (the-hash-table (make-locked-hash-table
+                          :lock #+ENABLE-MP (bt:make-lock) #-ENABLE-MP nil
+                          :hash-table (make-hash-table :test 'equal))))
+
+    (with-slots (lock hash-table) the-hash-table
+      #'(lambda (arg)
+          (multiple-value-bind (value foundp) (gethash arg hash-table)
+            (if foundp
+                value
+                (with-lock (lock)
+                  (setf (gethash arg hash-table) (funcall func arg)))))))))
 
 
 (defmacro memoize (func-name)
 (defmacro memoize (func-name)
   "Memoize function associated with FUNC-NAME. Simplified version"
   "Memoize function associated with FUNC-NAME. Simplified version"
@@ -113,7 +129,7 @@ but can be an arbitrary expression returning a tag to be princ'ed first;
 if the expression returns NIL, nothing is printed.
 if the expression returns NIL, nothing is printed.
 EXPRS are expressions, which when the TAG was not NIL are evaluated in order,
 EXPRS are expressions, which when the TAG was not NIL are evaluated in order,
 with their source code then their return values being printed each time.
 with their source code then their return values being printed each time.
-The last expresion is *always* evaluated and its multiple values are returned,
+The last expression is *always* evaluated and its multiple values are returned,
 but its source and return values are only printed if TAG was not NIL;
 but its source and return values are only printed if TAG was not NIL;
 previous expressions are not evaluated at all if TAG returned NIL.
 previous expressions are not evaluated at all if TAG returned NIL.
 The macro expansion has relatively low overhead in space or time."
 The macro expansion has relatively low overhead in space or time."