X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsymbol.lisp;h=fe29dd6bc17f0a453cb7e44956bc34271bc66f1b;hb=a18894dbea4495b885e1747babf4e2593dfb705e;hp=30e629e044aa30cd46cb190faa9605efc1ecafd0;hpb=621eebe206ae6c6d0d0897d43247ce5e05c2359a;p=sbcl.git diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index 30e629e..fe29dd6 100644 --- a/src/code/symbol.lisp +++ b/src/code/symbol.lisp @@ -246,6 +246,11 @@ distinct from the global value. Can also be SETF." ;;;; GENSYM and friends +(defun %make-symbol-name (prefix counter) + (with-output-to-string (s) + (write-string prefix s) + (%output-integer-in-base counter 10 s))) + (defvar *gensym-counter* 0 #!+sb-doc "counter for generating unique GENSYM symbols") @@ -272,10 +277,7 @@ distinct from the global value. Can also be SETF." (fixnum (values "G" thing)) (string (values (coerce thing 'simple-string) old))) (declare (simple-string prefix)) - (make-symbol - (with-output-to-string (s) - (write-string prefix s) - (%output-integer-in-base int 10 s)))))) + (make-symbol (%make-symbol-name prefix int))))) (defvar *gentemp-counter* 0) (declaim (type unsigned-byte *gentemp-counter*)) @@ -284,11 +286,6 @@ distinct from the global value. Can also be SETF." #!+sb-doc "Creates a new symbol interned in package PACKAGE with the given PREFIX." (declare (type string prefix)) - (loop - (let ((*print-base* 10) - (*print-radix* nil) - (*print-pretty* nil) - (new-pname (format nil "~A~D" prefix (incf *gentemp-counter*)))) - (multiple-value-bind (symbol existsp) (find-symbol new-pname package) - (declare (ignore symbol)) - (unless existsp (return (values (intern new-pname package)))))))) + (loop for name = (%make-symbol-name prefix (incf *gentemp-counter*)) + while (nth-value 1 (find-symbol name package)) + finally (return (values (intern name package)))))