SBCL do-symbols (and loop)返回重复项

Question

我发现SBCL 'do-symbols‘(and loop)返回重复项。

测试环境: Windows上的SBCL 1.1.4 x86

首先，我们定义了一些辅助函数：

;; compress from Ansi-Common-Lisp
(defun compress (x)
  (labels ((rec (e x n)
             (if (null x)
                 (if (= 1 n)
                     (list e)
                     (list (list e n)))
                 (if (eq e (car x))
                     (rec e (cdr x) (1+ n))
                     (cons (if (= 1 n)
                               e
                               (list e n))
                           (rec (car x)
                                (cdr x)
                                1))))))
    (rec (car x) (cdr x) 1)))

(compress '(a a b c d d d))
;;=> ((A 2) B C (D 3))

;; This one can make the duplicate items visible:
(defun duplicates (list)
  (remove-if-not #'listp (compress (sort list #'string<))))

(duplicates '(a a b c d d d))
;;=> ((A 2) (D 3))

;; This one use 'do-symbols' iterate each symbol in package, and check the
;; result
(defun test-pack-do-symbols (package)
  (let (r)
    (do-symbols (s package (duplicates r))
      (push s r))))

当调用package :SB-MOP上的'test-pack-do-symbols‘时，你可以看到重复的项目

(test-pack-do-symbols :sb-mop)
;;=> ((ADD-METHOD 2) (ALLOCATE-INSTANCE 2) (BUILT-IN-CLASS 2) (CLASS 2)
;;  (CLASS-NAME 2) (COMPUTE-APPLICABLE-METHODS 2) (ENSURE-GENERIC-FUNCTION 2) #'2
;;  (GENERIC-FUNCTION 2) (MAKE-INSTANCE 2) (METHOD 2) (METHOD-COMBINATION 2)
;;  (METHOD-QUALIFIERS 2) (REMOVE-METHOD 2) (STANDARD-CLASS 2)
;;  (STANDARD-GENERIC-FUNCTION 2) (STANDARD-METHOD 2) (STANDARD-OBJECT 2) (T 2))

还有另一种方法可以迭代包中的符号，使用强大的“循环”。

;; Now I define `test-pack-loop' 
(defun test-pack-loop (package)
  (duplicates (loop for s being each symbol in package
                   collect s)))

当调用'test-pack-loop‘时，你看不到重复的项目。

(test-pack-loop :sb-mop)
;;=> NIL

但是，即使循环可能会在一些包中返回重复的项目，您也可以使用以下代码来查看'test-pack-do-symbols‘和'test-pack- loop’之间的区别。

(let (r1 r2)
  (dolist (p (list-all-packages))
    (when (test-pack-do-symbols p)
      (push (package-name p) r1))
    (when (test-pack-loop p)
      (push (package-name p) r2)))
  (print r1)
  (print r2)
  nil)

那么，这是一个bug，还是与标准一致？

Answer 1

请参阅Common Lisp Hyperspec，其中说明

do-symbols遍历包中可访问的符号。对于从多个包继承的符号，语句可能会执行多次。

Answer 2

汉斯已经写过关于DO-SYMBOLS规范的文章。

显而易见的解决办法是用PUSHNEW替换PUSH。

(defun test-pack-do-symbols (package)
  (let (r)
    (do-symbols (s package (duplicates r))
      (pushnew s r))))

Answer 3

除了Rainer的回答之外，我还提出了一个宏do-unique-symbols

(defmacro do-unique-symbols (var
                             &optional (package '*package*) result-form
                             &body body)
  "Like common-lisp:do-symbols, but executes only once per unique symbol."
  (let ((unique-symbols (gensym)))
    `(let (,unique-symbols)
       (do-symbols (symbol ,package)
         (pushnew symbol ,unique-symbols))
       (dolist (,var ,unique-symbols ,result-form)
         ,@body))))

(未测试，抱歉)。