1.0.23.19 deja vu

[sbcl.git] / src / code / early-extensions.lisp

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index e004f73..341c69b 100644 (file)
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -843,9 +843,9 @@
           (unless (proper-list-of-length-p spec 2)
             (error "malformed ONCE-ONLY binding spec: ~S" spec))
           (let* ((name (first spec))
-                 (exp-temp (gensym (symbol-name name))))
+                 (exp-temp (gensym "ONCE-ONLY")))
             `(let ((,exp-temp ,(second spec))
-                   (,name (gensym "ONCE-ONLY-")))
+                   (,name (gensym ,(symbol-name name))))
                `(let ((,,name ,,exp-temp))
                   ,,(frob (rest specs) body))))))))
 \f
@@ -1214,6 +1214,16 @@
           (*print-length* (or (true *print-length*) 12)))
       (funcall function))))
 
+;;; Returns a list of members of LIST. Useful for dealing with circular lists.
+;;; For a dotted list returns a secondary value of T -- in which case the
+;;; primary return value does not include the dotted tail.
+(defun list-members (list)
+  (when list
+    (do ((tail (cdr list) (cdr tail))
+         (members (list (car list)) (cons (car tail) members)))
+        ((or (not (consp tail)) (eq tail list))
+         (values members (not (listp tail)))))))
+
 ;;; Default evaluator mode (interpeter / compiler)
 
 (declaim (type (member :compile #!+sb-eval :interpret) *evaluator-mode*))