SBCL執行 - 符號（和循環）返回重複的項目

Question

我發現SBCL'do-symbols'（和循環）返回重複的項目。

測試環境：SBCL 1.1.4 x86的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)))) 

當調用上包 '測試包-DO符號'：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 

但是，即使環路可在一些包返回重複的項目，你可以使用下面的代碼來看看「測試包-DO符號」和「測試包環」

之間的區別

(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。對於從多個包繼承的符號，語句可能會執行多次。

Answer 2

Hans已經寫過關於DO-SYMBOLS規範。

最明顯的解決方法是用PUSHNEW更換PUSH。

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

Answer 3

在進一步的除了雷納的回答，我提出了一個宏觀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)))) 

（未經測試，抱歉）。