From: Noam Postavsky <npostavs@gmail.com>
To: Lars Ingebrigtsen <larsi@gnus.org>
Cc: 16963@debbugs.gnu.org, Demetrios Obenour <demetriobenour@gmail.com>
Subject: bug#16963: A patch to create a list-with-tail primitive.
Date: Thu, 27 Jun 2019 23:14:31 -0400 [thread overview]
Message-ID: <87v9wq5rl4.fsf@gmail.com> (raw)
In-Reply-To: <m38sto1ksi.fsf@gnus.org> (Lars Ingebrigtsen's message of "Wed, 26 Jun 2019 16:30:21 +0200")
[-- Attachment #1: Type: text/plain, Size: 796 bytes --]
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Lars Ingebrigtsen <larsi@gnus.org> writes:
>
>> Reading this bug report, there seemed to be general agreement that Emacs
>> should have `list*', and that `cl-list*' should be an alias for it, but
>> these patches were not applied.
>>
>> I can't find your name in the Emacs copyright assignment file -- would
>> you be willing to sign a copyright assignment to the FSF?
>
> I asked that three years ago, when the patch was already two years old,
> so I'm guessing that this is not going to happen, so I'm closing this
> bug report.
Oh, this reminds me I had started writing a patch for this. I used the
name cons* instead of list* though, I always found it more logical:
cons* is cons repeated, just like let* is let repeated. Let me dust it
off:
[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 19149 bytes --]
From e44291e055b167548a9b5166764e144644cc6291 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 2 Jul 2017 17:44:02 -0400
Subject: [PATCH] Implement cons* as a C subroutine (Bug#16963)
* src/alloc.c (Fcons_star): New subr.
* doc/lispref/lists.texi (Building Lists): Document it.
* etc/NEWS: Announce it.
* lisp/emacs-lisp/cl-macs.el (cl--compiler-macro-list*): Move to...
* lisp/subr.el (internal--compiler-macro-cons*): ...here, and rename.
Set as compiler-macro for `cons*'.
* lisp/emacs-lisp/backquote.el (backquote-list*-function)
(backquote-list*-macro, backquote-list*): Remove.
(backquote-listify):
* lisp/emacs-lisp/byte-opt.el:
* lisp/emacs-lisp/inline.el (inline--do-quote):
* lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Replace
`backquote-list*' with `cons*'.
* lisp/emacs-lisp/cl-lib.el (cl-list*): Make into alias for `cons*'.
* lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Change special
case for `backquote-list*' macro to special case for
`internal--compiler-macro-cons*' compiler-macro.
---
doc/lispref/lists.texi | 18 +++++
etc/NEWS | 3 +
lisp/emacs-lisp/backquote.el | 50 +-------------
lisp/emacs-lisp/byte-opt.el | 2 +-
lisp/emacs-lisp/cl-lib.el | 15 +---
lisp/emacs-lisp/cl-macs.el | 8 ---
lisp/emacs-lisp/inline.el | 2 +-
lisp/emacs-lisp/macroexp.el | 161 +++++++++++++++++++++----------------------
lisp/subr.el | 9 +++
src/alloc.c | 13 ++++
10 files changed, 129 insertions(+), 152 deletions(-)
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 746b4643c1..a398721c79 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -503,6 +503,24 @@ Building Lists
@end example
@end defun
+@defun cons* object1 &rest objects
+This function is similar to @code{list}, but instead of terminating
+the returned list with @code{nil}, it uses the last argument instead.
+This is mainly useful when adding several elements to a list, to avoid
+having to call @code{cons} repeatedly. For example:
+
+@example
+(setq list (cons* newelt1 newelt2 list))
+@end example
+
+is equivalent to
+
+@example
+(setq list (cons newelt1 (cons newelt2 list)))
+@end example
+
+@end defun
+
@defun make-list length object
This function creates a list of @var{length} elements, in which each
element is @var{object}. Compare @code{make-list} with
diff --git a/etc/NEWS b/etc/NEWS
index b1f1f7293a..06d5e93d02 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1862,6 +1862,9 @@ according to the given numeric value.
** 'condition-case' now accepts 't' to match any error symbol.
+++
+** New subr 'cons*'.
+
++++
** New function 'proper-list-p'.
Given a proper list as argument, this predicate returns its length;
otherwise, it returns nil. 'format-proper-list-p' is now an obsolete
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 5e72dc3b40..fd31d82728 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -29,56 +29,10 @@
;; When it sees ,... inside such a backquote form, it generates (\, ...).
;; For ,@... it generates (\,@ ...).
-;; This backquote will generate calls to the backquote-list* form.
-;; Both a function version and a macro version are included.
-;; The macro version is used by default because it is faster
-;; and needs no run-time support. It should really be a subr.
-
;;; Code:
(provide 'backquote)
-;; function and macro versions of backquote-list*
-
-(defun backquote-list*-function (first &rest list)
- "Like `list' but the last argument is the tail of the new list.
-
-For example (backquote-list* \\='a \\='b \\='c) => (a b . c)"
- ;; The recursive solution is much nicer:
- ;; (if list (cons first (apply 'backquote-list*-function list)) first))
- ;; but Emacs is not very good at efficiently processing recursion.
- (if list
- (let* ((rest list) (newlist (cons first nil)) (last newlist))
- (while (cdr rest)
- (setcdr last (cons (car rest) nil))
- (setq last (cdr last)
- rest (cdr rest)))
- (setcdr last (car rest))
- newlist)
- first))
-
-(defmacro backquote-list*-macro (first &rest list)
- "Like `list' but the last argument is the tail of the new list.
-
-For example (backquote-list* \\='a \\='b \\='c) => (a b . c)"
- ;; The recursive solution is much nicer:
- ;; (if list (list 'cons first (cons 'backquote-list*-macro list)) first))
- ;; but Emacs is not very good at efficiently processing such things.
- (setq list (nreverse (cons first list))
- first (car list)
- list (cdr list))
- (if list
- (let* ((second (car list))
- (rest (cdr list))
- (newlist (list 'cons second first)))
- (while rest
- (setq newlist (list 'cons (car rest) newlist)
- rest (cdr rest)))
- newlist)
- first))
-
-(defalias 'backquote-list* (symbol-function 'backquote-list*-macro))
-
;; A few advertised variables that control which symbols are used
;; to represent the backquote, unquote, and splice operations.
(defconst backquote-backquote-symbol '\`
@@ -219,7 +173,7 @@ backquote-process
(cons (if (eq (car-safe expression) 'quote) 0 1) expression)))))
;; backquote-listify takes (tag . structure) pairs from backquote-process
-;; and decides between append, list, backquote-list*, and cons depending
+;; and decides between append, list, cons*, and cons depending
;; on which tags are in the list.
(defun backquote-listify (list old-tail)
@@ -242,7 +196,7 @@ backquote-listify
(and (consp (car heads))
(eq (car (car heads))
backquote-splice-symbol)))))
- (cons (if use-list* 'backquote-list* 'cons)
+ (cons (if use-list* 'cons* 'cons)
(append heads (list tail))))
tail))
(t (cons 'list heads)))))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 2e09601639..0e53ab85ec 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1168,7 +1168,7 @@ byte-optimize-set
buffer-substring byte-code-function-p
capitalize car-less-than-car car cdr ceiling char-after char-before
char-equal char-to-string char-width compare-strings
- compare-window-configurations concat coordinates-in-window-p
+ compare-window-configurations concat cons* coordinates-in-window-p
copy-alist copy-sequence copy-marker cos count-lines
current-time-string current-time-zone
decode-char
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index c51c70d317..2f1274b71e 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -434,19 +434,8 @@ 'cl-cddddr
;; (while (consp (cdr x)) (pop x))
;; x))
-(defun cl-list* (arg &rest rest)
- "Return a new list with specified ARGs as elements, consed to last ARG.
-Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
-`(cons A (cons B (cons C D)))'.
-\n(fn ARG...)"
- (declare (compiler-macro cl--compiler-macro-list*))
- (cond ((not rest) arg)
- ((not (cdr rest)) (cons arg (car rest)))
- (t (let* ((n (length rest))
- (copy (copy-sequence rest))
- (last (nthcdr (- n 2) copy)))
- (setcdr last (car (cdr last)))
- (cons arg copy)))))
+(defalias 'cl-list* 'cons*)
+(function-put 'cl-list* 'compiler-macro #'internal--compiler-macro-cons*)
(defun cl-ldiff (list sublist)
"Return a copy of LIST with the tail SUBLIST removed."
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 54974ceb7d..18b6707655 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -62,14 +62,6 @@ cl--optimize-speed
;; functions can lead to recursive-loads that prevent the calls from
;; being optimized.
-;;;###autoload
-(defun cl--compiler-macro-list* (_form arg &rest others)
- (let* ((args (reverse (cons arg others)))
- (form (car args)))
- (while (setq args (cdr args))
- (setq form `(cons ,(car args) ,form)))
- form))
-
;; Note: `cl--compiler-macro-cXXr' has been copied to
;; `internal--compiler-macro-cXXr' in subr.el. If you amend either
;; one, you may want to amend the other, too.
diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el
index 70dbff2147..25aee42db2 100644
--- a/lisp/emacs-lisp/inline.el
+++ b/lisp/emacs-lisp/inline.el
@@ -185,7 +185,7 @@ inline--do-quote
(push (inline--do-quote (pop exp)) args))
(setq args (nreverse args))
(if exp
- `(backquote-list* ,@args ,(inline--do-quote exp))
+ `(cons* ,@args ,(inline--do-quote exp))
`(list ,@args))))
(_ (macroexp-quote exp))))
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 9af75320ec..fd5a2864ce 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -201,85 +201,84 @@ macroexp--expand-all
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
Assumes the caller has bound `macroexpand-all-environment'."
- (if (eq (car-safe form) 'backquote-list*)
- ;; Special-case `backquote-list*', as it is normally a macro that
- ;; generates exceedingly deep expansions from relatively shallow input
- ;; forms. We just process it `in reverse' -- first we expand all the
- ;; arguments, _then_ we expand the top-level definition.
- (macroexpand (macroexp--all-forms form 1)
- macroexpand-all-environment)
- ;; Normal form; get its expansion, and then expand arguments.
- (setq form (macroexp-macroexpand form macroexpand-all-environment))
- (pcase form
- (`(cond . ,clauses)
- (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
- (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
- (macroexp--cons
- 'condition-case
- (macroexp--cons err
- (macroexp--cons (macroexp--expand-all body)
- (macroexp--all-clauses handlers 1)
- (cddr form))
- (cdr form))
- form))
- (`(,(or 'defvar 'defconst) . ,_) (macroexp--all-forms form 2))
- (`(function ,(and f `(lambda . ,_)))
- (macroexp--cons 'function
- (macroexp--cons (macroexp--all-forms f 2)
- nil
- (cdr form))
- form))
- (`(,(or 'function 'quote) . ,_) form)
- (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) dontcare))
- (macroexp--cons fun
- (macroexp--cons (macroexp--all-clauses bindings 1)
- (macroexp--all-forms body)
- (cdr form))
- form))
- (`(,(and fun `(lambda . ,_)) . ,args)
- ;; Embedded lambda in function position.
- (macroexp--cons (macroexp--all-forms fun 2)
- (macroexp--all-forms args)
- form))
- ;; The following few cases are for normal function calls that
- ;; are known to funcall one of their arguments. The byte
- ;; compiler has traditionally handled these functions specially
- ;; by treating a lambda expression quoted by `quote' as if it
- ;; were quoted by `function'. We make the same transformation
- ;; here, so that any code that cares about the difference will
- ;; see the same transformation.
- ;; First arg is a function:
- (`(,(and fun (or 'funcall 'apply 'mapcar 'mapatoms 'mapconcat 'mapc))
- ',(and f `(lambda . ,_)) . ,args)
- (macroexp--warn-and-return
- (format "%s quoted with ' rather than with #'"
- (list 'lambda (nth 1 f) '...))
- (macroexp--expand-all `(,fun ,f . ,args))))
- ;; Second arg is a function:
- (`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
- (macroexp--warn-and-return
- (format "%s quoted with ' rather than with #'"
- (list 'lambda (nth 1 f) '...))
- (macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
- (`(funcall #',(and f (pred symbolp)) . ,args)
- ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
- ;; has a compiler-macro.
- (macroexp--expand-all `(,f . ,args)))
- (`(,func . ,_)
- ;; Macro expand compiler macros. This cannot be delayed to
- ;; byte-optimize-form because the output of the compiler-macro can
- ;; use macros.
- (let ((handler (function-get func 'compiler-macro)))
- (if (null handler)
- ;; No compiler macro. We just expand each argument (for
- ;; setq/setq-default this works alright because the variable names
- ;; are symbols).
- (macroexp--all-forms form 1)
- ;; If the handler is not loaded yet, try (auto)loading the
- ;; function itself, which may in turn load the handler.
- (unless (functionp handler)
- (with-demoted-errors "macroexp--expand-all: %S"
- (autoload-do-load (indirect-function func) func)))
+ ;; Normal form; get its expansion, and then expand arguments.
+ (setq form (macroexp-macroexpand form macroexpand-all-environment))
+ (pcase form
+ (`(cond . ,clauses)
+ (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
+ (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
+ (macroexp--cons
+ 'condition-case
+ (macroexp--cons err
+ (macroexp--cons (macroexp--expand-all body)
+ (macroexp--all-clauses handlers 1)
+ (cddr form))
+ (cdr form))
+ form))
+ (`(,(or 'defvar 'defconst) . ,_) (macroexp--all-forms form 2))
+ (`(function ,(and f `(lambda . ,_)))
+ (macroexp--cons 'function
+ (macroexp--cons (macroexp--all-forms f 2)
+ nil
+ (cdr form))
+ form))
+ (`(,(or 'function 'quote) . ,_) form)
+ (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) dontcare))
+ (macroexp--cons fun
+ (macroexp--cons (macroexp--all-clauses bindings 1)
+ (macroexp--all-forms body)
+ (cdr form))
+ form))
+ (`(,(and fun `(lambda . ,_)) . ,args)
+ ;; Embedded lambda in function position.
+ (macroexp--cons (macroexp--all-forms fun 2)
+ (macroexp--all-forms args)
+ form))
+ ;; The following few cases are for normal function calls that
+ ;; are known to funcall one of their arguments. The byte
+ ;; compiler has traditionally handled these functions specially
+ ;; by treating a lambda expression quoted by `quote' as if it
+ ;; were quoted by `function'. We make the same transformation
+ ;; here, so that any code that cares about the difference will
+ ;; see the same transformation.
+ ;; First arg is a function:
+ (`(,(and fun (or 'funcall 'apply 'mapcar 'mapatoms 'mapconcat 'mapc))
+ ',(and f `(lambda . ,_)) . ,args)
+ (macroexp--warn-and-return
+ (format "%s quoted with ' rather than with #'"
+ (list 'lambda (nth 1 f) '...))
+ (macroexp--expand-all `(,fun ,f . ,args))))
+ ;; Second arg is a function:
+ (`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
+ (macroexp--warn-and-return
+ (format "%s quoted with ' rather than with #'"
+ (list 'lambda (nth 1 f) '...))
+ (macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
+ (`(funcall #',(and f (pred symbolp)) . ,args)
+ ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
+ ;; has a compiler-macro.
+ (macroexp--expand-all `(,f . ,args)))
+ (`(,func . ,_)
+ ;; Macro expand compiler macros. This cannot be delayed to
+ ;; byte-optimize-form because the output of the compiler-macro can
+ ;; use macros.
+ (let ((handler (function-get func 'compiler-macro)))
+ (if (null handler)
+ ;; No compiler macro. We just expand each argument (for
+ ;; setq/setq-default this works alright because the variable names
+ ;; are symbols).
+ (macroexp--all-forms form 1)
+ ;; If the handler is not loaded yet, try (auto)loading the
+ ;; function itself, which may in turn load the handler.
+ (unless (functionp handler)
+ (with-demoted-errors "macroexp--expand-all: %S"
+ (autoload-do-load (indirect-function func) func)))
+ (if (eq handler 'internal--compiler-macro-cons*)
+ ;; The `cons*' compiler-macro generates very deep
+ ;; expansions, so macroexpand the arguments first to
+ ;; reduce the chance of exceeding recusion depth while
+ ;; macroexpanding.
+ (macroexp--compiler-macro handler (macroexp--all-forms form 1))
(let ((newform (macroexp--compiler-macro handler form)))
(if (eq form newform)
;; The compiler macro did not find anything to do.
@@ -291,9 +290,9 @@ macroexp--expand-all
(if (eq newform form)
newform
(macroexp--expand-all newform)))
- (macroexp--expand-all newform))))))
+ (macroexp--expand-all newform)))))))
- (_ form))))
+ (_ form)))
;;;###autoload
(defun macroexpand-all (form &optional environment)
diff --git a/lisp/subr.el b/lisp/subr.el
index c59f13b24c..c0b3c68229 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -577,6 +577,15 @@ cddddr
(declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (cdr (cdr (cdr x)))))
+(defun internal--compiler-macro-cons* (_form arg &rest others)
+ (let* ((args (reverse (cons arg others)))
+ (form (car args)))
+ (while (setq args (cdr args))
+ (setq form `(cons ,(car args) ,form)))
+ form))
+
+(function-put 'cons* 'compiler-macro #'internal--compiler-macro-cons*)
+
(defun last (list &optional n)
"Return the last link of LIST. Its car is the last element.
If LIST is nil, return nil.
diff --git a/src/alloc.c b/src/alloc.c
index 64aaa8acdf..1fb7b1fc0b 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2699,6 +2699,18 @@ DEFUN ("list", Flist, Slist, 0, MANY, 0,
return val;
}
+DEFUN ("cons*", FconsX, SconsX, 1, MANY, 0,
+ doc: /* Like `list' but the last argument is the tail of the new list.
+(cons* A B C) is equivalent to (cons A (cons B C)).
+usage: (cons* FIRST &rest LIST) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ Lisp_Object val = args[--nargs];
+
+ while (nargs > 0)
+ val = Fcons (args[--nargs], val);
+ return val;
+}
DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
doc: /* Return a newly created list of length LENGTH, with each element being INIT. */)
@@ -7374,6 +7386,7 @@ syms_of_alloc (void)
N should be nonnegative. */);
defsubr (&Scons);
+ defsubr (&SconsX);
defsubr (&Slist);
defsubr (&Svector);
defsubr (&Srecord);
--
2.11.0
next prev parent reply other threads:[~2019-06-28 3:14 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-03-07 13:58 bug#16963: A patch to create a list-with-tail primitive Demetrios Obenour
2014-03-25 2:10 ` Stefan
2014-03-25 2:45 ` Daniel Colascione
2014-03-27 23:37 ` Demetrios Obenour
2014-03-27 23:38 ` Daniel Colascione
2014-03-28 0:43 ` Demetrios Obenour
2014-03-29 1:46 ` Demetrios Obenour
2014-03-29 1:48 ` Daniel Colascione
2014-03-29 13:30 ` Demetrios Obenour
2016-02-24 2:51 ` Lars Ingebrigtsen
2019-06-26 14:30 ` Lars Ingebrigtsen
2019-06-28 3:14 ` Noam Postavsky [this message]
2019-06-28 3:30 ` Drew Adams
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87v9wq5rl4.fsf@gmail.com \
--to=npostavs@gmail.com \
--cc=16963@debbugs.gnu.org \
--cc=demetriobenour@gmail.com \
--cc=larsi@gnus.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).