如何在Common Lisp中重用gethash查找？

我有一个哈希表，其中的键是相当复杂的列表，包含符号和整数的子列表，值应该根据已经存在的值进行修改。该表是使用

：test#“equal

创建的

我经常做类似的事情：

(defun try-add (i)
  (let ((old-i (gethash complex-list table nil)))
    (if (may-add old-i)
      (push i (gethash complex-list table)))))

---

分析表明

equal

测试需要花费大量时间。我有一个优化的想法，那就是

gethash

查找的数量可以从两个减少到一个。它可以通过重用迭代器在C++中完成，但不确定如何在LISP中完成。有什么想法吗？

一些解决办法可能是：

如果通用模式是lookup->find it->overwrite，则可以将值类型替换为包含该值类型的列表。然后在找到键的值对象后，只需破坏性地替换它的第一个元素，例如

(defun try-add (i)
  (let ((old-i-list (gethash complex-list table nil)))
    (if (may-add (first old-i-list))
      (setf (first old-i-list) i)                     ; overwrite without searching again
      (setf (gethash complex-list table) (list i))))) ; not there? too bad, we have to gethash again

可选地，如果公共模式更像查找->它不在->添加它，您可能需要考虑对自己键入哈希，然后哈希表使用哈希值作为键。这可能更复杂，这取决于这些复杂列表的深度和语义。在这个简单的例子中，您可能会得到一个散列函数，该函数（递归地）xor是它的list参数元素的散列值

---

编辑：回答评论中的问题：想法是哈希表不再将键映射到值，而是将键映射到单个元素列表，其中元素就是值。然后您可以更改这些列表的内容，而无需触及哈希表本身。以下内容来自SBCL：

* (defparameter *my-hash* (make-hash-table))
*MY-HASH*

* (setf (gethash :my-key *my-hash*) (list "old-value"))
("old-value")

* (gethash :my-key *my-hash*)
("old-value")
T

* (defparameter old-value-container (gethash :my-key *my-hash*))
OLD-VALUE-CONTAINER

* (setf (first old-value-container) "new value")
"new value"

* (gethash :my-key *my-hash*)
("new value")
T

---

您可以使用defstruct创建一个值，哈希表中的每个条目都指向该值。您的值列表（您在当前示例中所使用的值）可以存储在其中。结构创建可以在初始gethash调用中完成（作为默认值），也可以在没有值的情况下手动完成。然后，对象可以以您所做的方式受到侧面影响

（这忽略了一个问题，即您是否真的想使用这些复杂值作为哈希表键，或者是否有办法解决这个问题。例如，您可以使用structures/CLOS对象而不是复杂列表作为键，然后您可以使用EQ哈希表。但这在很大程度上取决于您的操作。）“分析表明，相同的测试需要很长时间。”

是的，但是您是否验证了#'相等哈希表查找也需要很多时间

您是否在优化编译器（如SBCL）上编译此文件以提高速度，并查看了编译器注释

---

解决这两个问题后，您还可以为列表键的每一级尝试一个嵌套哈希表。为任意嵌套的哈希表编写宏应该不难。

不要做任何特殊的事情，因为实现会为您做这件事

当然，这种方法是特定于实现的，哈希表的性能在不同的实现之间有所不同（但优化问题总是特定于实现）

以下答案适用于SBCL。我建议检查您的Lisp哈希表是否执行相同的优化。如果没有，请向您的供应商投诉

在SBCL中，哈希表缓存GETHASH访问的最后一个表索引

当调用PUTHASH（或等价地，（SETF GETHASH））时，它首先检查缓存索引处的键是否与您传入的键相等

如果是这样，整个哈希表查找例程将被旁路，并且PUTHASH直接存储在缓存的索引中

请注意，EQ只是一个指针比较，因此速度非常快——它根本不需要遍历列表

---

因此，在您的代码示例中，没有任何开销。

也许我遗漏了一些明显的东西，但是：

(defun try-add (i)
  (let ((old-i (gethash complex-list table)))
    (when (may-add old-i)
      (push i old-i))))

自：

• nil已经是GETHASH的默认值
• GETHASH提取整个对象，这样您就可以在适当的位置修改它，而不是告诉PUSH如何再次查找它
• （样式点：在没有else子句时使用WHEN而不是IF）

编辑：哦，我是：我错过了old-I为零的情况。但是如果这不是常见情况，那么它仍然可能是一个胜利，因为您只需要在这种情况下进行查找：

(defun try-add (i)
  (let ((old-i (gethash complex-list table)))
    (when (may-add old-i)
      (if old-i
         (push i old-i)
        (push i (gethash complex-list table))))))

---

嗯，这样行吗？

您可能实际访问了三次哈希表。为什么？因为

push

宏可能会扩展为执行

gethash

以获取列表的代码，然后执行一些

system:：sethash

操作来存储值

在这个问题中，您正在检查一个位置的值，这是一个列表。如果该列表满足某个谓词测试，那么您将把某个内容推到该位置

可以通过创建特殊用途的运算符来解决此问题，该运算符捕获以下语义：

 (push-if <new-value> <predicate> <place>)

此

push if

定义为一个宏，它使用

表单参数上的

get setf expansion

函数来获取生成代码所需的片段，以便只访问该位置一次

生成的代码计算加载表单以从该位置获取旧值，然后将条件应用于旧值，如果成功，则在从

get setf expansion

获取的相应临时存储变量中准备新值，并计算存储表单

这是您在portable Lisp中所能做的最好的操作，您可能会发现它仍然执行两个哈希操作，如上所述。（在这种情况下，您希望哈希表本身有一个不错的缓存优化。但至少可以减少到两个操作。）

该方法将与内置的突变形式一样优化：<代码> INFF ，<代码> Pux，<代码> RoTATEF等。 如果它仍然很糟糕（执行

 (push-if i #'may-add (gethash complex-list table))

(defmacro push-if (new-value predicate-fun list-place &environment env)
  (multiple-value-bind (temp-syms val-forms
                        store-vars store-form access-form)
                       (get-setf-expansion list-place env)
    (let ((old-val (gensym)))
      (when (rest store-vars)
        (error "PUSH-IF: cannot take ref of multiple-value place"))
      `(multiple-value-bind (,@temp-syms) (values ,@val-forms)
         (let ((,old-val ,access-form))
           (when (funcall ,predicate-fun ,old-val)
             (setf ,(first store-vars) (cons ,new-value ,old-val))
             ,store-form))))))

> (macroexpand '(push-if new test place))
(LET* ((#:VALUES-12731 (MULTIPLE-VALUE-LIST (VALUES))))
 (LET ((#:G12730 PLACE))
  (WHEN (FUNCALL TEST #:G12730) (SETF #:NEW-12729 (CONS NEW #:G12730))
   (SETQ PLACE #:NEW-12729)))) ;

> (macroexpand '(push-if new test (gethash a b)))
(LET*
 ((#:VALUES-12736 (MULTIPLE-VALUE-LIST (VALUES A B)))
  (#:G12732 (POP #:VALUES-12736)) (#:G12733 (POP #:VALUES-12736)))
 (LET ((#:G12735 (GETHASH #:G12732 #:G12733)))
  (WHEN (FUNCALL TEST #:G12735) (SETF #:G12734 (CONS NEW #:G12735))
   (SYSTEM::PUTHASH #:G12732 #:G12733 #:G12734)))) ;