在 Common Lisp 中使用包作为哈希表

Question

最初将大量符号存储在一个包中（与项目包分开），并将其有效地用作项目可访问的哈希表（其中键表示简单的集合成员数据）是否可行？

* (defpackage :project (:use :cl))
#<PACKAGE "PROJECT">

* (defpackage :temp (:use :cl))
#<PACKAGE "TEMP">

* (in-package :project)
#<PACKAGE "PROJECT">

* (intern "ABC" :temp)
TEMP::ABC
NIL

* (find-symbol "ABC" :temp)
TEMP::ABC
:INTERNAL

;The following is not needed for this project, but is available

* (setf (symbol-value (find-symbol "ABC" :temp)) 123)
123

* (symbol-value (find-symbol "ABC" :temp))
123

这似乎可行，但是否有充分的理由避免使用哈希表？我的第一个想法是避免使用大量杂项键符号使项目包混乱。这些符号将在运行时从字符串生成（以检查哈希表中的集合成员资格）。这似乎涉及许多符号的运行时驻留，这些符号可能存储在表中，也可能不存储在表中。但我也想知道

find-symbol

是否比

gethash

更有效率。或者，我可以只对字符串使用

equal

哈希表，但查找的绝对数量似乎指向

eq

而不是

equal

。寻找任何明智的建议，谢谢。

编辑：比较

equal

哈希表与包符号查找的简单测试。

首先，哈希表测试

* (defun random-string (n)
  "Generate a random string of length n."
  (let ((charset "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
    (iter (repeat n)
          (collect (char charset (random (length charset)))
                   result-type string))))
RANDOM-STRING

* (defparameter *ht* (make-hash-table :test #'equal :size 10000))
*HT*

* (iter (for i from 0 to 5000)
      (setf (gethash (random-string 5) *ht*)
            t))
NIL

* (time (dotimes (i 1000000)
        (gethash (random-string 5) *ht*)))

Evaluation took:
  0.150 seconds of real time
  0.109375 seconds of total run time (0.109375 user, 0.000000 system)
  72.67% CPU
  541,959,942 processor cycles
  127,937,760 bytes consed

下一个包查找

* (defpackage :temp1)
#<PACKAGE "TEMP1">

* (iter (for i from 0 to 5000)
      (intern (random-string 5) :temp1))
NIL

* (time (dotimes (i 1000000)
        (find-symbol (random-string 5) :temp1)))

Evaluation took:
  0.224 seconds of real time
  0.171875 seconds of total run time (0.156250 user, 0.015625 system)
  [ Run times consist of 0.015 seconds GC time, and 0.157 seconds non-GC time. ]
  76.79% CPU
  807,944,162 processor cycles
  127,954,624 bytes consed

哈希表快 1.5 倍

Answer 1

你可以这样做，但它在风格上很糟糕，而且几乎肯定很慢。

特别请理解，如果你有一个在运行时创建的字符串，并且你想将它映射到一个唯一的对象，这样所有包含相同字符序列的字符串都映射到同一个对象你必须考虑字符串的每个元素：换句话说，你必须做

equal

对字符串所做的事情。没有秘密魔术可以让您在字符串上使用

eq

。

所以要做你想做的事，非正式地“实习”字符串，你可以比较你正在考虑的选项：

哈希表是一流的对象，并且只做你想做的，这就是它们的设计目的。

Packages 不是完全一流的：您将必须全局管理您使用的包。包几乎肯定会在内部使用哈希表或某种等效结构。包将字符串映射到 symbols，这是预定义的对象，可能相当重量级。包不是设计来做你想做的事，尽管可以被滥用。

在实践中，这意味着包几乎肯定会慢得多，分配更多的内存，你的代码会丑得一塌糊涂。

我做了一些简短的测试，将在新包中创建大量符号（即实习大量唯一字符串）与将这些相同的字符串添加到

equal

哈希表进行比较。这在 LispWorks 中慢了大约 10 倍，在 SBCL 中慢了大约 6 倍。

---

一个可能的反例是你有这样的场景：

• 我有大量对象集合，其中包含字符串之类的东西。
• 对于给定的字符串，我现在希望尽快根据大量对象检查它。

所以我现在想做的是在这些集合中存储以某种独特方式表示字符串的对象，这将节省大量的字符串比较。

传统的方法是使用符号，通过包或（今天可能更好）通过哈希表：

(defvar *string-table*
  ;; Note we're gong to case-fold here.
  (make-hash-table :test #'equalp))

(defun canonicalize-string (s &key (table *string-table*) (upper-case t))
  (or (gethash s table)
      (setf (gethash s table) (make-symbol (if upper-case (string-upcase s) s)))))

现在你需要调用

canonicalize-string

（就像

find-symbol

/

intern

）每当你想要一个字符串的符号，然后你可以写，例如：

(let ((s (canonicalize-string ...)))
  (dolist (set my-large-collection-of-sets nil)
    (when (present-in-set-p s set)
      (return set))))

除了，等等。如果你只使用符号作为字符串的独特化身，为什么要使用符号？

(defun canonicalize-string (s &key (table *string-table*) (upper-case t))
  (or (gethash s table)
      (setf (gethash s table) (if upper-case (string-upcase s) s))))

现在这段代码将分配更少但仍然做与原始代码完全相同的事情。

---

最后要注意的是，定义轻量级内部字符串非常容易，并为它们完成文字语法：

(in-package :cl-user)

(defvar *interned-strings-table* nil)

(defstruct interned-strings-table
  (parent *interned-strings-table*)
  (table (make-hash-table :test #'equal)))

(setf *interned-strings-table*
  (make-interned-strings-table :parent nil))

(defun intern-string (s &optional (table *interned-strings-table*))
  (do ((current table (interned-strings-table-parent current)))
      ((not current)
       (setf (gethash s (interned-strings-table-table table)) s))
    (let ((it (gethash s (interned-strings-table-table current))))
      (when it (return it)))))

(defun clear-interned-strings (&optional (table *interned-strings-table*))
  (do ((current table (interned-strings-table-parent current)))
      ((not current) t)
    (clrhash (interned-strings-table-table current))))

(defun read-interned-string (reader stream char)
  (let ((s (funcall reader stream char)))
    (typecase s
      (string
       (intern-string s))
      (t
       (error "oops")))))

(defun make-string-interning-readtable (&optional (from *readtable*) (to nil))
  (let ((strt (copy-readtable from to)))
    (when (get-dispatch-macro-character #\# #\" strt)
      (error "Someone is already using #\""))
    (set-dispatch-macro-character
     #\# #\"
     (let ((string-reader (get-macro-character #\" strt)))
       (lambda (stream char prefix)
         (declare (ignore prefix))
         (read-interned-string string-reader stream char)))
     strt)
    strt))

现在

*readtable*

设置为

(make-string-interning-readtable)

的结果：

> (eq #"foo" #"foo")
t

> (eq #"foo" (intern-string "foo"))
t

> (eq #"foo" "foo")
nil                                     ;in fact maybe

> (eq "foo" "foo")
nil                                     ;in fact maybe