SBCL do-symbols (and loop) return duplicate items

Question

I have found that SBCL 'do-symbols' (and loop) return duplicate items.

Testing environment: SBCL 1.1.4 x86 on Windows

Firstly, We define some helper functions:

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

When call the 'test-pack-do-symbols' on package :SB-MOP, you can see the duplicate items

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

There is another method to iterate symbols in a package, using the mighty 'loop'.

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

When call the 'test-pack-loop', you will not see the duplicate items.

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

But, even loop may return duplicate items on some packages, you can use the following code to see the difference between 'test-pack-do-symbols' and '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)

So, is this a bug, or consistent with the Standard?

Tokenism

Answer 1

Please refer to the Common Lisp Hyperspec which states

do-symbols iterates over the symbols accessible in package. Statements may execute more than once for symbols that are inherited from multiple packages.

Pluto

Answer 2

Hans wrote already about the DO-SYMBOLS specification.

The obvious fix is to replace PUSH with PUSHNEW.

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

Hasan

Answer 3

In further addition to Rainer's answer, I'd propose a 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))))

(Untested, sorry).

Fusible