6

我发现 SBCL 'do-symbols'（和循环）返回重复项。

测试环境：SBCL 1.1.4 x86 on Windows

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

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

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

4

3 回答 3

11

请参阅Common Lisp Hyperspec其中指出

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

于 2013-05-27T06:06:48.563 回答
6

汉斯已经写过DO-SYMBOLS规范。

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

(defun test-pack-do-symbols (package)
  (let (r)
    (do-symbols (s package (duplicates r))
      (pushnew s r))))
于 2013-05-27T11:58:33.863 回答
0

除了 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))))

（未经测试，抱歉）。

于 2013-05-30T10:04:34.917 回答