I do-symbols SBCL (e loop) restituiscono gli elementi duplicati

Question

Ho trovato che i 'do-symbols' (e il ciclo) di SBCL restituiscono elementi duplicati.

ambiente di test: SBCL 1.1.4 x86 su Windows

In primo luogo, si definiscono alcune funzioni 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)))) 

Quando chiamare il 'test-pack-do-simboli' sulla confezione: SB MOP, si possono vedere gli elementi duplicati

(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'è un altro metodo per scorrere i simboli in un pacchetto, utilizzando il potente 'loop'.

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

Quando si chiama il 'ciclo del test-pack', non verranno visualizzati gli elementi duplicati.

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

Ma, anche anello può restituire gli elementi duplicati in alcuni pacchetti, è possibile utilizzare il seguente codice per vedere la differenza tra 'test-pack-do-simboli' e '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) 

Quindi, questo è un bug o coerente con lo standard?

Answer 1

Si prega di fare riferimento alla Common Lisp Hyperspec in cui si afferma

fare-simboli itera oltre i simboli accessibili nel pacchetto. Le dichiarazioni possono essere eseguite più di una volta per i simboli ereditati da più pacchetti.

Answer 2

Hans ha già scritto sulla specifica DO-SYMBOLS.

L'ovvia soluzione è sostituire PUSH con PUSHNEW.

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

Answer 3

In ulteriore aggiunta alla risposta di Rainer, mi propongo una 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)))) 

(testato, sorry).