SBCL biểu tượng (và vòng lặp) trả về các mục trùng lặp

Question

Tôi đã tìm thấy các mục trùng lặp trả về SBCL '(biểu tượng').

Kiểm tra môi trường: SBCL 1.1.4 x86 trên Windows

Thứ nhất, chúng tôi xác định một số chức năng helper:

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

Khi gọi 'test-pack-do-những biểu tượng' trên bao bì: SB- MOP, bạn có thể xem các mục trùng lặp

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

Có một phương pháp khác để lặp biểu tượng trong gói, sử dụng vòng lặp hùng mạnh '.

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

Khi gọi 'vòng lặp kiểm tra gói', bạn sẽ không thấy các mục trùng lặp.

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

Nhưng, ngay cả vòng lặp có thể trở lại mục trùng lặp trên một số gói, bạn có thể sử dụng đoạn mã sau để thấy sự khác biệt giữa 'test-pack-do-những biểu tượng' và '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) 

Vì vậy, đây có phải là lỗi hoặc phù hợp với Tiêu chuẩn không?

Answer 1

Vui lòng tham khảo Common Lisp Hyperspec trong đó nêu

làm-ký tự lặp trên những biểu tượng truy cập trong gói. Các câu lệnh có thể thực thi nhiều lần cho các ký hiệu được thừa kế từ nhiều gói.

Answer 2

Hans đã viết về thông số DO-SYMBOLS.

Sửa lỗi rõ ràng là thay thế PUSH bằng PUSHNEW.

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

Answer 3

Bên cạnh đó thêm vào câu trả lời của Rainer, tôi muốn đề nghị một macro 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)))) 

(chưa được kiểm tra, xin lỗi).