6

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?

3 Answers 3

11

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.

Sign up to request clarification or add additional context in comments.

Comments

6

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

Comments

0

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

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.