SBCL do-symbols(和循环)返回重复项

Question

我发现SBCL'do-symbols'(和循环)返回重复项.

测试环境: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))))

在包裹上调用'test-pack-do-symbols'时:SB-MOP,您可以看到重复的项目

(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)

那么,这是一个错误,还是与标准一致？

Answer 1

请参阅Common Lisp的Hyperspec其中规定

do-symbols迭代包中可访问的符号.对于从多个包继承的符号,语句可能会执行多次.

Answer 2

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

明显的解决方法是替换PUSH为PUSHNEW.

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