(I’m posting this in case anyone is curious.)
My idea was that it might reduce the dumped size a little if we used seven
bits per octet in the generated symbol name, instead of formatting the
current value of *gensym-counter* as a decimal as we do now.
With all seven bits per char:
-rwxrwxr-x 1 aidan admin 12349292 10 Feb 22:37 src/xemacs
-r--r--r-- 1 aidan admin 2678 10 Feb 22:12 src/xemacs.def
-rw-rw-r-- 1 aidan admin 7067 10 Feb 22:12 src/xemacs.def.in
-rw-rw-r-- 1 aidan admin 7067 10 Feb 21:18 src/xemacs.def.in.in
-rw-rw-r-- 1 aidan admin 3535640 10 Feb 22:37 src/xemacs.dmp
-----
With the current behaviour:
-rwxrwxr-x 1 aidan admin 12349292 10 Feb 22:34 src/xemacs
-r--r--r-- 1 aidan admin 2678 10 Feb 22:12 src/xemacs.def
-rw-rw-r-- 1 aidan admin 7067 10 Feb 22:12 src/xemacs.def.in
-rw-rw-r-- 1 aidan admin 7067 10 Feb 21:18 src/xemacs.def.in.in
-rw-rw-r-- 1 aidan admin 3536052 10 Feb 22:34 src/xemacs.dmp
Shout if I’m missing something obvious; the patch is below.
diff -r 1e3cf11fa27d lisp/cl.el
--- a/lisp/cl.el Tue Feb 10 16:07:31 2009 +0000
+++ b/lisp/cl.el Tue Feb 10 22:33:10 2009 +0000
@@ -323,11 +323,20 @@
is the prefix, otherwise the prefix defaults to \"G\". If ARG is an integer,
the internal counter is reset to that number before creating the name.
There is no way to specify both using this function."
- (let ((prefix (if (stringp arg) arg "G"))
- (num (if (integerp arg) arg
- (prog1 *gensym-counter*
- (setq *gensym-counter* (1+ *gensym-counter*))))))
- (make-symbol (format "%s%d" prefix num))))
+ (make-symbol (loop
+ with result = nil
+ with num = (if (integerp arg)
+ arg
+ (prog1 *gensym-counter*
+ (setq *gensym-counter*
+ (1+ *gensym-counter*))))
+ until (zerop num)
+ do
+ (push (int-char (logand num #b1111111)) result)
+ (setq num (lsh num -7))
+ finally
+ return (concat (if (stringp arg) arg "G")
+ (apply #'string result)))))
(defun gentemp (&optional arg)
"Generate a new interned symbol with a unique name.
@@ -335,7 +344,17 @@
If ARG is not a string, it is ignored."
(let ((prefix (if (stringp arg) arg "G"))
name)
- (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*)))
+ (while (intern-soft (setq name
+ (loop
+ with result = nil
+ with examining = *gensym-counter*
+ until (zerop examining)
+ do
+ (push (int-char (logand examining #b1111111))
+ result)
+ (setq examining (lsh examining -7))
+ finally return
+ (concat prefix (apply #'string result)))))
(setq *gensym-counter* (1+ *gensym-counter*)))
(intern name)))
--
¿Dónde estará ahora mi sobrino Yoghurtu Nghe, que tuvo que huir
precipitadamente de la aldea por culpa de la escasez de rinocerontes?
_______________________________________________
XEmacs-Beta mailing list
XEmacs-Beta(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-beta