* bug#28362: 26.0.50; [PATCH] gensym in core elisp
@ 2017-09-05 17:11 Mark Oteiza
2017-09-05 17:27 ` Mark Oteiza
2017-09-11 20:35 ` Mark Oteiza
0 siblings, 2 replies; 5+ messages in thread
From: Mark Oteiza @ 2017-09-05 17:11 UTC (permalink / raw)
To: 28362
[-- Attachment #1: Type: text/plain, Size: 1372 bytes --]
Wishlist.
It would be nice to have gensym live in subr.el or C for the utility of
having uniquely named uninterned symbols. It is helpful, for instance,
in the readability of macroexpansions of pcase and other macros that
generate many uninterned symbols of the same name.
As far as C vs Elisp--cl-gensym is about 10x slower than make-symbol,
but as far as macroexpansion goes, I get the impression gensym is not a
big contributing factor. Consider the following:
(defmacro case-lambda (&rest spec)
"Return an arbitrary arity function."
(declare (indent 0) (debug (&rest (pcase-QPAT body))))
(let ((args (make-symbol "args")))
`(lambda (&rest ,args)
(pcase-exhaustive ,args ,@spec))))
(benchmark-run-compiled 1000
(macroexpand-all
'(case-lambda
(`() t)
(`(,x) (cons x 1))
(`(,x ,y) (list x y 2))
(`(,x ,y . ,z) (pcase-lambda (`(,cat ,dog))
(vector cat dog x y z 8)))))
The difference between the benchmark with make-symbol and make-symbol
fset to gensym is less than 1% (looking at profiler samples, interval
set to 1us).
I wrote a naïve gensym in C that is only about 1.5x to 2x faster than
cl-gensym (and incompatible because of the inaccessible counter). Patch
attached.
I also attached a patch putting gensym into subr.el.
I've tested both patches.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gensym implemented in alloc.c --]
[-- Type: text/x-patch, Size: 14450 bytes --]
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index b1ada00f4a..2db256d631 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -161,25 +161,19 @@ cl--expr-depends-p
;;; Symbols.
-(defvar cl--gensym-counter 0)
+(defvaralias 'cl--gensym-counter 'gensym-counter)
;;;###autoload
-(defun cl-gensym (&optional prefix)
- "Generate a new uninterned symbol.
-The name is made by appending a number to PREFIX, default \"G\"."
- (let ((pfix (if (stringp prefix) prefix "G"))
- (num (if (integerp prefix) prefix
- (prog1 cl--gensym-counter
- (setq cl--gensym-counter (1+ cl--gensym-counter))))))
- (make-symbol (format "%s%d" pfix num))))
+(cl--defalias 'cl-gensym 'gensym)
+(defvar cl--gentemp-counter 0)
;;;###autoload
(defun cl-gentemp (&optional prefix)
"Generate a new interned symbol with a unique name.
-The name is made by appending a number to PREFIX, default \"G\"."
- (let ((pfix (if (stringp prefix) prefix "G"))
+The name is made by appending a number to PREFIX, default \"T\"."
+ (let ((pfix (if (stringp prefix) prefix "T"))
name)
- (while (intern-soft (setq name (format "%s%d" pfix cl--gensym-counter)))
- (setq cl--gensym-counter (1+ cl--gensym-counter)))
+ (while (intern-soft (setq name (format "%s%d" pfix cl--gentemp-counter)))
+ (setq cl--gentemp-counter (1+ cl--gentemp-counter)))
(intern name)))
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 73eb9a4e86..306237ca38 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -250,7 +250,6 @@ cl-unload-function
eval-when
destructuring-bind
gentemp
- gensym
pairlis
acons
subst
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index c6ef8d7a99..3190346497 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1193,7 +1193,7 @@ edebug-make-enter-wrapper
;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
;; Do this after parsing since that may find a name.
(setq edebug-def-name
- (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon")))
+ (or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
`(edebug-enter
(quote ,edebug-def-name)
,(if edebug-inside-func
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 4cf9d9609e..1413b9cd0b 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -295,7 +295,7 @@ ert-with-message-capture
code under test from the behavior of the *Messages* buffer."
(declare (debug (symbolp body))
(indent 1))
- (let ((g-advice (cl-gensym)))
+ (let ((g-advice (gensym)))
`(let* ((,var "")
(,g-advice (lambda (func &rest args)
(if (or (null args) (equal (car args) ""))
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index c232b08bd1..07acc20ae8 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -293,8 +293,8 @@ ert--expand-should-1
(error `(signal ',(car err) ',(cdr err))))))
(cond
((or (atom form) (ert--special-operator-p (car form)))
- (let ((value (cl-gensym "value-")))
- `(let ((,value (cl-gensym "ert-form-evaluation-aborted-")))
+ (let ((value (gensym "value-")))
+ `(let ((,value (gensym "ert-form-evaluation-aborted-")))
,(funcall inner-expander
`(setq ,value ,form)
`(list ',whole :form ',form :value ,value)
@@ -307,10 +307,10 @@ ert--expand-should-1
(and (consp fn-name)
(eql (car fn-name) 'lambda)
(listp (cdr fn-name)))))
- (let ((fn (cl-gensym "fn-"))
- (args (cl-gensym "args-"))
- (value (cl-gensym "value-"))
- (default-value (cl-gensym "ert-form-evaluation-aborted-")))
+ (let ((fn (gensym "fn-"))
+ (args (gensym "args-"))
+ (value (gensym "value-"))
+ (default-value (gensym "ert-form-evaluation-aborted-")))
`(let* ((,fn (function ,fn-name))
(,args (condition-case err
(let ((signal-hook-function #'ert--should-signal-hook))
@@ -352,7 +352,7 @@ ert--expand-should
(ert--expand-should-1
whole form
(lambda (inner-form form-description-form value-var)
- (let ((form-description (cl-gensym "form-description-")))
+ (let ((form-description (gensym "form-description-")))
`(let (,form-description)
,(funcall inner-expander
`(unwind-protect
@@ -430,8 +430,8 @@ ert--should-error-handle-error
`(should-error ,form ,@keys)
form
(lambda (inner-form form-description-form value-var)
- (let ((errorp (cl-gensym "errorp"))
- (form-description-fn (cl-gensym "form-description-fn-")))
+ (let ((errorp (gensym "errorp"))
+ (form-description-fn (gensym "form-description-fn-")))
`(let ((,errorp nil)
(,form-description-fn (lambda () ,form-description-form)))
(condition-case -condition-
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index c96b400809..fe5d2d0728 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -86,10 +86,7 @@ cps--cleanup-table-symbol
(defvar cps--cleanup-function nil)
(defmacro cps--gensym (fmt &rest args)
- ;; Change this function to use `cl-gensym' if you want the generated
- ;; code to be easier to read and debug.
- ;; (cl-gensym (apply #'format fmt args))
- `(progn (ignore ,@args) (make-symbol ,fmt)))
+ `(gensym (format ,fmt ,@args)))
(defvar cps--dynamic-wrappers '(identity)
"List of transformer functions to apply to atomic forms we
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 253b60e753..5935845743 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -213,7 +213,7 @@ pcase--make-docstring
(defmacro pcase-exhaustive (exp &rest cases)
"The exhaustive version of `pcase' (which see)."
(declare (indent 1) (debug pcase))
- (let* ((x (make-symbol "x"))
+ (let* ((x (gensym "x"))
(pcase--dontwarn-upats (cons x pcase--dontwarn-upats)))
(pcase--expand
;; FIXME: Could we add the FILE:LINE data in the error message?
@@ -304,7 +304,7 @@ pcase-dolist
(declare (indent 1) (debug ((pcase-PAT form) body)))
(if (pcase--trivial-upat-p (car spec))
`(dolist ,spec ,@body)
- (let ((tmpvar (make-symbol "x")))
+ (let ((tmpvar (gensym "x")))
`(dolist (,tmpvar ,@(cdr spec))
(pcase-let* ((,(car spec) ,tmpvar))
,@body)))))
@@ -715,7 +715,7 @@ pcase--funcall
(call (progn
(when (memq arg vs)
;; `arg' is shadowed by `env'.
- (let ((newsym (make-symbol "x")))
+ (let ((newsym (gensym "x")))
(push (list newsym arg) env)
(setq arg newsym)))
(if (functionp fun)
@@ -842,7 +842,7 @@ pcase--u1
;; A upat of the form (app FUN PAT)
(pcase--mark-used sym)
(let* ((fun (nth 1 upat))
- (nsym (make-symbol "x"))
+ (nsym (gensym "x"))
(body
;; We don't change `matches' to reuse the newly computed value,
;; because we assume there shouldn't be such redundancy in there.
diff --git a/lisp/json.el b/lisp/json.el
index 64486258cc..fd2f63324c 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -683,6 +683,23 @@ json-readtable
table)
"Readtable for JSON reader.")
+(defmacro json-readtable-dispatch (char)
+ "Dispatch reader function for CHAR."
+ (declare (debug (symbolp)))
+ (let ((table
+ '((?t json-read-keyword "true")
+ (?f json-read-keyword "false")
+ (?n json-read-keyword "null")
+ (?{ json-read-object)
+ (?\[ json-read-array)
+ (?\" json-read-string)))
+ res)
+ (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
+ (push (list c 'json-read-number) table))
+ (pcase-dolist (`(,c . ,rest) table)
+ (push `(,c (,@rest)) res))
+ `(pcase ,char ,@res (_ (signal 'json-readtable-error ,char)))))
+
(defun json-read ()
"Parse and return the JSON object following point.
Advances point just past JSON object."
@@ -690,10 +707,7 @@ json-read
(let ((char (json-peek)))
(if (zerop char)
(signal 'json-end-of-file nil)
- (let ((record (cdr (assq char json-readtable))))
- (if (functionp (car record))
- (apply (car record) (cdr record))
- (signal 'json-readtable-error record))))))
+ (json-readtable-dispatch char))))
;; Syntactic sugar for the reader
diff --git a/lisp/subr.el b/lisp/subr.el
index 2ad52f6a63..ebb8b53b50 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -280,6 +280,20 @@ ignore-errors
\f
;;;; Basic Lisp functions.
+(defvar gensym-counter 0
+ "Number used to construct the name of the next symbol created by `gensym'.")
+
+(defun gensym (&optional prefix)
+ "Return a new uninterned symbol.
+The name is made by appending `gensym-counter' to PREFIX.
+PREFIX can be a string, and defaults to \"G\".
+If PREFIX is a number, it replaces the value of `gensym-counter'."
+ (let ((pfix (if (stringp prefix) prefix "G"))
+ (num (if (integerp prefix) prefix
+ (prog1 gensym-counter
+ (setq gensym-counter (1+ gensym-counter))))))
+ (make-symbol (format "%s%d" pfix num))))
+
(defun ignore (&rest _ignore)
"Do nothing and return nil.
This function accepts any number of arguments, but ignores them."
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index d03ee5eb31..59a72006a8 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -1,4 +1,4 @@
-;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files
+;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files -*- lexical-binding: t -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
diff --git a/lisp/xdg.el b/lisp/xdg.el
index 4973065f91..19accd71e9 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -29,6 +29,7 @@
;; - XDG Base Directory Specification
;; - Thumbnail Managing Standard
;; - xdg-user-dirs configuration
+;; - Desktop Entry Specification
;;; Code:
@@ -146,6 +147,64 @@ xdg-user-dir
(let ((dir (cdr (assoc name xdg-user-dirs))))
(when dir (expand-file-name dir))))
+\f
+;; Desktop Entry Specification
+;; https://specifications.freedesktop.org/desktop-entry-spec/latest/
+
+(defconst xdg-desktop-group-regexp
+ (rx "[" (group-n 1 (+? (in " -Z\\^-~"))) "]")
+ "Regexp matching desktop file group header names.")
+
+(defconst xdg-desktop-entry-regexp
+ (rx (group-n 1 (+ (in "A-Za-z0-9-")))
+ (* blank) "=" (* blank)
+ (group-n 2 (* nonl)))
+ "Regexp matching desktop file entry key-value pairs.")
+
+(defconst xdg-desktop-things
+ '("OnlyShowIn" "NotShowIn" "Actions" "MimeType" "Categories" "Implements")
+ "Names of recognized keys of type \"string(s)\".")
+
+(defun xdg--desktop-value-partition (str)
+ "Partition STRING into elements delimited by unescaped semicolons."
+ (let (res)
+ (dolist (x (split-string (replace-regexp-in-string "\\\\;" "\0" str) ";"))
+ (push (replace-regexp-in-string "\0" "\\\\;" x) res))
+ (when (null (string-match-p "[^[:blank:]]" (car res))) (pop res))
+ (nreverse res)))
+
+(defun xdg--desktop-parse-line ()
+ (skip-chars-forward "[:blank:]")
+ (when (/= (following-char) ?#)
+ (cond
+ ((looking-at xdg-desktop-group-regexp)
+ (match-string 1))
+ ((looking-at xdg-desktop-entry-regexp)
+ (cons (match-string 1) (match-string 2))))))
+
+(defun xdg-desktop-read-file (filename)
+ "Return contents of desktop file FILENAME as an alist."
+ (let (elt group entries res)
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (setq elt (xdg--desktop-parse-line))
+ (cond
+ ((stringp elt)
+ (if (null group) (setq group elt)
+ (push (cons group (nreverse entries)) res)
+ (setq group nil entries nil)))
+ ((consp elt)
+ (pcase-let ((`(,k . ,v) elt))
+ (if (member k xdg-desktop-things)
+ (push (cons k (xdg--desktop-value-partition v)) entries)
+ (push elt entries))))))
+ (forward-line))
+ (when (and group entries)
+ (push (cons group entries) res)))
+ (nreverse res)))
+
(provide 'xdg)
;;; xdg.el ends here
diff --git a/src/alloc.c b/src/alloc.c
index 2cee646256..89372c11b5 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3632,6 +3632,32 @@ Its value is void, and its function definition and property list are nil. */)
return val;
}
+static Lisp_Object default_gensym_prefix;
+
+DEFUN ("gensym", Fgensym, Sgensym, 0, 1, 0,
+ doc: /* Return a new uninterned symbol.
+The name is made by concatenating PREFIX with a counter value.
+PREFIX is a string and defaults to "g".
+There is no provision for resetting the counter. */)
+ (Lisp_Object prefix)
+{
+ static int gensym_counter = 0;
+
+ Lisp_Object suffix, name;
+ int len;
+ char buf[INT_STRLEN_BOUND (EMACS_INT)];
+
+ if (NILP (prefix))
+ prefix = default_gensym_prefix;
+ CHECK_STRING (prefix);
+
+ EMACS_INT count = gensym_counter++;
+ len = sprintf (buf, "%"pI"d", count);
+ suffix = make_string (buf, len);
+ name = concat2 (prefix, suffix);
+ return Fmake_symbol (name);
+}
+
\f
/***********************************************************************
@@ -7515,6 +7541,8 @@ The time is in seconds as a floating point value. */);
DEFVAR_INT ("gcs-done", gcs_done,
doc: /* Accumulated number of garbage collections done. */);
+ default_gensym_prefix = build_pure_c_string ("g");
+
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);
@@ -7527,6 +7555,7 @@ The time is in seconds as a floating point value. */);
defsubr (&Smake_string);
defsubr (&Smake_bool_vector);
defsubr (&Smake_symbol);
+ defsubr (&Sgensym);
defsubr (&Smake_marker);
defsubr (&Smake_finalizer);
defsubr (&Spurecopy);
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: gensym moved to subr.el --]
[-- Type: text/x-patch, Size: 10044 bytes --]
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index b1ada00f4a..d8f3dbf93d 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -161,25 +161,19 @@ cl--expr-depends-p
;;; Symbols.
-(defvar cl--gensym-counter 0)
+(defvaralias 'cl--gensym-counter 'gensym-counter)
;;;###autoload
-(defun cl-gensym (&optional prefix)
- "Generate a new uninterned symbol.
-The name is made by appending a number to PREFIX, default \"G\"."
- (let ((pfix (if (stringp prefix) prefix "G"))
- (num (if (integerp prefix) prefix
- (prog1 cl--gensym-counter
- (setq cl--gensym-counter (1+ cl--gensym-counter))))))
- (make-symbol (format "%s%d" pfix num))))
+(cl--defalias 'cl-gensym 'gensym)
+(defvar cl--gentemp-counter 0)
;;;###autoload
(defun cl-gentemp (&optional prefix)
"Generate a new interned symbol with a unique name.
-The name is made by appending a number to PREFIX, default \"G\"."
- (let ((pfix (if (stringp prefix) prefix "G"))
+The name is made by appending a number to PREFIX, default \"T\"."
+ (let ((pfix (if (stringp prefix) prefix "T"))
name)
- (while (intern-soft (setq name (format "%s%d" pfix cl--gensym-counter)))
- (setq cl--gensym-counter (1+ cl--gensym-counter)))
+ (while (intern-soft (setq name (format "%s%d" pfix cl--gentemp-counter)))
+ (setq cl--gentemp-counter (1+ cl--gentemp-counter)))
(intern name)))
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 73eb9a4e86..306237ca38 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -250,7 +250,6 @@ cl-unload-function
eval-when
destructuring-bind
gentemp
- gensym
pairlis
acons
subst
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index c6ef8d7a99..3190346497 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1193,7 +1193,7 @@ edebug-make-enter-wrapper
;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
;; Do this after parsing since that may find a name.
(setq edebug-def-name
- (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon")))
+ (or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
`(edebug-enter
(quote ,edebug-def-name)
,(if edebug-inside-func
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 4cf9d9609e..1413b9cd0b 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -295,7 +295,7 @@ ert-with-message-capture
code under test from the behavior of the *Messages* buffer."
(declare (debug (symbolp body))
(indent 1))
- (let ((g-advice (cl-gensym)))
+ (let ((g-advice (gensym)))
`(let* ((,var "")
(,g-advice (lambda (func &rest args)
(if (or (null args) (equal (car args) ""))
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index c232b08bd1..07acc20ae8 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -293,8 +293,8 @@ ert--expand-should-1
(error `(signal ',(car err) ',(cdr err))))))
(cond
((or (atom form) (ert--special-operator-p (car form)))
- (let ((value (cl-gensym "value-")))
- `(let ((,value (cl-gensym "ert-form-evaluation-aborted-")))
+ (let ((value (gensym "value-")))
+ `(let ((,value (gensym "ert-form-evaluation-aborted-")))
,(funcall inner-expander
`(setq ,value ,form)
`(list ',whole :form ',form :value ,value)
@@ -307,10 +307,10 @@ ert--expand-should-1
(and (consp fn-name)
(eql (car fn-name) 'lambda)
(listp (cdr fn-name)))))
- (let ((fn (cl-gensym "fn-"))
- (args (cl-gensym "args-"))
- (value (cl-gensym "value-"))
- (default-value (cl-gensym "ert-form-evaluation-aborted-")))
+ (let ((fn (gensym "fn-"))
+ (args (gensym "args-"))
+ (value (gensym "value-"))
+ (default-value (gensym "ert-form-evaluation-aborted-")))
`(let* ((,fn (function ,fn-name))
(,args (condition-case err
(let ((signal-hook-function #'ert--should-signal-hook))
@@ -352,7 +352,7 @@ ert--expand-should
(ert--expand-should-1
whole form
(lambda (inner-form form-description-form value-var)
- (let ((form-description (cl-gensym "form-description-")))
+ (let ((form-description (gensym "form-description-")))
`(let (,form-description)
,(funcall inner-expander
`(unwind-protect
@@ -430,8 +430,8 @@ ert--should-error-handle-error
`(should-error ,form ,@keys)
form
(lambda (inner-form form-description-form value-var)
- (let ((errorp (cl-gensym "errorp"))
- (form-description-fn (cl-gensym "form-description-fn-")))
+ (let ((errorp (gensym "errorp"))
+ (form-description-fn (gensym "form-description-fn-")))
`(let ((,errorp nil)
(,form-description-fn (lambda () ,form-description-form)))
(condition-case -condition-
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index c96b400809..4073e26956 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -86,10 +86,7 @@ cps--cleanup-table-symbol
(defvar cps--cleanup-function nil)
(defmacro cps--gensym (fmt &rest args)
- ;; Change this function to use `cl-gensym' if you want the generated
- ;; code to be easier to read and debug.
- ;; (cl-gensym (apply #'format fmt args))
- `(progn (ignore ,@args) (make-symbol ,fmt)))
+ `(gensym (format ,fmt ,@args)))
(defvar cps--dynamic-wrappers '(identity)
"List of transformer functions to apply to atomic forms we
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index a8b8974cb4..42b1c21695 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -431,7 +431,7 @@ setf
;; code is large, but otherwise results in more efficient code.
`(if ,test ,(gv-get then do)
,@(macroexp-unprogn (gv-get (macroexp-progn else) do)))
- (let ((v (make-symbol "v")))
+ (let ((v (gensym "v")))
(macroexp-let2 nil
gv `(if ,test ,(gv-letplace (getter setter) then
`(cons (lambda () ,getter)
@@ -456,7 +456,7 @@ setf
(gv-get (macroexp-progn (cdr branch)) do)))
(gv-get (car branch) do)))
branches))
- (let ((v (make-symbol "v")))
+ (let ((v (gensym "v")))
(macroexp-let2 nil
gv `(cond
,@(mapcar
diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el
index ce46f66aef..cf8e2f22d8 100644
--- a/lisp/emacs-lisp/inline.el
+++ b/lisp/emacs-lisp/inline.el
@@ -218,7 +218,7 @@ inline--do-letlisteval
`(let* ((,bsym ())
(,listvar (mapcar (lambda (e)
(if (macroexp-copyable-p e) e
- (let ((v (make-symbol "v")))
+ (let ((v (gensym "v")))
(push (list v e) ,bsym)
v)))
,listvar)))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 253b60e753..5935845743 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -213,7 +213,7 @@ pcase--make-docstring
(defmacro pcase-exhaustive (exp &rest cases)
"The exhaustive version of `pcase' (which see)."
(declare (indent 1) (debug pcase))
- (let* ((x (make-symbol "x"))
+ (let* ((x (gensym "x"))
(pcase--dontwarn-upats (cons x pcase--dontwarn-upats)))
(pcase--expand
;; FIXME: Could we add the FILE:LINE data in the error message?
@@ -304,7 +304,7 @@ pcase-dolist
(declare (indent 1) (debug ((pcase-PAT form) body)))
(if (pcase--trivial-upat-p (car spec))
`(dolist ,spec ,@body)
- (let ((tmpvar (make-symbol "x")))
+ (let ((tmpvar (gensym "x")))
`(dolist (,tmpvar ,@(cdr spec))
(pcase-let* ((,(car spec) ,tmpvar))
,@body)))))
@@ -715,7 +715,7 @@ pcase--funcall
(call (progn
(when (memq arg vs)
;; `arg' is shadowed by `env'.
- (let ((newsym (make-symbol "x")))
+ (let ((newsym (gensym "x")))
(push (list newsym arg) env)
(setq arg newsym)))
(if (functionp fun)
@@ -842,7 +842,7 @@ pcase--u1
;; A upat of the form (app FUN PAT)
(pcase--mark-used sym)
(let* ((fun (nth 1 upat))
- (nsym (make-symbol "x"))
+ (nsym (gensym "x"))
(body
;; We don't change `matches' to reuse the newly computed value,
;; because we assume there shouldn't be such redundancy in there.
diff --git a/lisp/subr.el b/lisp/subr.el
index b3f9f90234..83c1fbfe8c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -280,6 +280,20 @@ ignore-errors
\f
;;;; Basic Lisp functions.
+(defvar gensym-counter 0
+ "Number used to construct the name of the next symbol created by `gensym'.")
+
+(defun gensym (&optional prefix)
+ "Return a new uninterned symbol.
+The name is made by appending `gensym-counter' to PREFIX.
+PREFIX can be a string, and defaults to \"G\".
+If PREFIX is a number, it replaces the value of `gensym-counter'."
+ (let ((pfix (if (stringp prefix) prefix "G"))
+ (num (if (integerp prefix) prefix
+ (prog1 gensym-counter
+ (setq gensym-counter (1+ gensym-counter))))))
+ (make-symbol (format "%s%d" pfix num))))
+
(defun ignore (&rest _ignore)
"Do nothing and return nil.
This function accepts any number of arguments, but ignores them."
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#28362: 26.0.50; [PATCH] gensym in core elisp
2017-09-05 17:11 bug#28362: 26.0.50; [PATCH] gensym in core elisp Mark Oteiza
@ 2017-09-05 17:27 ` Mark Oteiza
2017-09-11 20:35 ` Mark Oteiza
1 sibling, 0 replies; 5+ messages in thread
From: Mark Oteiza @ 2017-09-05 17:27 UTC (permalink / raw)
To: 28362
[-- Attachment #1: Type: text/plain, Size: 267 bytes --]
On 05/09/17 at 01:11pm, Mark Oteiza wrote:
>I wrote a naïve gensym in C that is only about 1.5x to 2x faster than
>cl-gensym (and incompatible because of the inaccessible counter). Patch
>attached.
There was a bunch of other crap in that patch--clean one attached.
[-- Attachment #2: gensym_alloc_c.patch --]
[-- Type: text/x-diff, Size: 1622 bytes --]
diff --git a/src/alloc.c b/src/alloc.c
index 2cee646256..89372c11b5 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3632,6 +3632,32 @@ Its value is void, and its function definition and property list are nil. */)
return val;
}
+static Lisp_Object default_gensym_prefix;
+
+DEFUN ("gensym", Fgensym, Sgensym, 0, 1, 0,
+ doc: /* Return a new uninterned symbol.
+The name is made by concatenating PREFIX with a counter value.
+PREFIX is a string and defaults to "g".
+There is no provision for resetting the counter. */)
+ (Lisp_Object prefix)
+{
+ static int gensym_counter = 0;
+
+ Lisp_Object suffix, name;
+ int len;
+ char buf[INT_STRLEN_BOUND (EMACS_INT)];
+
+ if (NILP (prefix))
+ prefix = default_gensym_prefix;
+ CHECK_STRING (prefix);
+
+ EMACS_INT count = gensym_counter++;
+ len = sprintf (buf, "%"pI"d", count);
+ suffix = make_string (buf, len);
+ name = concat2 (prefix, suffix);
+ return Fmake_symbol (name);
+}
+
\f
/***********************************************************************
@@ -7515,6 +7541,8 @@ The time is in seconds as a floating point value. */);
DEFVAR_INT ("gcs-done", gcs_done,
doc: /* Accumulated number of garbage collections done. */);
+ default_gensym_prefix = build_pure_c_string ("g");
+
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);
@@ -7527,6 +7555,7 @@ The time is in seconds as a floating point value. */);
defsubr (&Smake_string);
defsubr (&Smake_bool_vector);
defsubr (&Smake_symbol);
+ defsubr (&Sgensym);
defsubr (&Smake_marker);
defsubr (&Smake_finalizer);
defsubr (&Spurecopy);
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#28362: 26.0.50; [PATCH] gensym in core elisp
2017-09-05 17:11 bug#28362: 26.0.50; [PATCH] gensym in core elisp Mark Oteiza
2017-09-05 17:27 ` Mark Oteiza
@ 2017-09-11 20:35 ` Mark Oteiza
2017-09-12 14:39 ` Eli Zaretskii
1 sibling, 1 reply; 5+ messages in thread
From: Mark Oteiza @ 2017-09-11 20:35 UTC (permalink / raw)
To: 28362
On 05/09/17 at 01:11pm, Mark Oteiza wrote:
>
> Wishlist.
>
> I attached a patch putting gensym into subr.el.
Any comments? Moving gensym doesn't affect much, so I'll happily
commit, say, at the end of the week.
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#28362: 26.0.50; [PATCH] gensym in core elisp
2017-09-11 20:35 ` Mark Oteiza
@ 2017-09-12 14:39 ` Eli Zaretskii
2017-09-12 15:14 ` Mark Oteiza
0 siblings, 1 reply; 5+ messages in thread
From: Eli Zaretskii @ 2017-09-12 14:39 UTC (permalink / raw)
To: Mark Oteiza; +Cc: 28362
> Date: Mon, 11 Sep 2017 16:35:01 -0400
> From: Mark Oteiza <mvoteiza@udel.edu>
>
> On 05/09/17 at 01:11pm, Mark Oteiza wrote:
> >
> > Wishlist.
> >
> > I attached a patch putting gensym into subr.el.
>
> Any comments? Moving gensym doesn't affect much, so I'll happily
> commit, say, at the end of the week.
I see no reasons to have gensym in C, so let's go with the Lisp
version.
Please also add a NEWS entry about this.
Thanks.
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#28362: 26.0.50; [PATCH] gensym in core elisp
2017-09-12 14:39 ` Eli Zaretskii
@ 2017-09-12 15:14 ` Mark Oteiza
0 siblings, 0 replies; 5+ messages in thread
From: Mark Oteiza @ 2017-09-12 15:14 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 28362-done
On 12/09/17 at 05:39pm, Eli Zaretskii wrote:
> > Date: Mon, 11 Sep 2017 16:35:01 -0400
> > From: Mark Oteiza <mvoteiza@udel.edu>
> >
> > On 05/09/17 at 01:11pm, Mark Oteiza wrote:
> > >
> > > Wishlist.
> > >
> > > I attached a patch putting gensym into subr.el.
> >
> > Any comments? Moving gensym doesn't affect much, so I'll happily
> > commit, say, at the end of the week.
>
> I see no reasons to have gensym in C, so let's go with the Lisp
> version.
>
> Please also add a NEWS entry about this.
Done, thank you.
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2017-09-12 15:14 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-09-05 17:11 bug#28362: 26.0.50; [PATCH] gensym in core elisp Mark Oteiza
2017-09-05 17:27 ` Mark Oteiza
2017-09-11 20:35 ` Mark Oteiza
2017-09-12 14:39 ` Eli Zaretskii
2017-09-12 15:14 ` Mark Oteiza
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).