bug#16963: A patch to create a list-with-tail primitive.

bug#16963: A patch to create a list-with-tail primitive.

[Demetrios Obenour]

Since a comment in backquote.el said that backquote-list* needed to be a
primitive, here is an implementation of it as one, under the name
list-with-tail.

=== modified file 'src/alloc.c'
--- src/alloc.c	2014-02-28 21:45:34 +0000
+++ src/alloc.c	2014-03-07 13:27:33 +0000
@@ -2593,6 +2593,26 @@
   return val;
 }
 
+DEFUN ("list-with-tail", Flist_with_tail, Slist_with_tail, 0, MANY, 0,
+       doc: /* Return a newly created list with specified arguments as
elements,
+except for the last argument, which becomes the tail of the list.
+At least one argument is required.
+usage: (list &rest OBJECTS &last TAIL)  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
+{
+  if (nargs == 0)
+    error ("Wrong number of arguments");
+  register Lisp_Object val;
+  nargs--;
+  val = args[nargs];
+
+  while (nargs > 0)
+    {
+      nargs--;
+      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.  */)
@@ -6921,6 +6941,7 @@
 
   defsubr (&Scons);
   defsubr (&Slist);
+  defsubr (&Slist_with_tail);
   defsubr (&Svector);
   defsubr (&Smake_byte_code);
   defsubr (&Smake_list);


Change Log:

  This creates a built-in function, list-with-tail,
  that is identical to backquote-list*-function
  in backquote.el except that it is a primitive.
  This follows the suggestion made in a backquote.el

Sincerely,

Demetrios Obenour

bug#16963: A patch to create a list-with-tail primitive.

[Stefan]

> Since a comment in backquote.el said that backquote-list* needed to be a
> primitive, here is an implementation of it as one, under the name
> list-with-tail.

I think it would make more sense to call it `list*'.  Also it might make
sense to change backquote.el so it uses this `list*' (tho probably only
when passed with enough arguments).


        Stefan

bug#16963: A patch to create a list-with-tail primitive.

[Daniel Colascione]

[-- Attachment #1: Type: text/plain, Size: 574 bytes --]

On 03/24/2014 07:10 PM, Stefan wrote:
>> Since a comment in backquote.el said that backquote-list* needed to be a
>> primitive, here is an implementation of it as one, under the name
>> list-with-tail.
> 
> I think it would make more sense to call it `list*'.  Also it might make
> sense to change backquote.el so it uses this `list*' (tho probably only
> when passed with enough arguments).

Agreed. On more that one occasion, I've wished we had a CL-less `list*'.
If you do add this feature, please make sure the existing list* compiler
macros keep working.


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 901 bytes --]

bug#16963: A patch to create a list-with-tail primitive.

[Demetrios Obenour]

On Mon, 2014-03-24 at 19:45 -0700, Daniel Colascione wrote:
> On 03/24/2014 07:10 PM, Stefan wrote:
> >> Since a comment in backquote.el said that backquote-list* needed to be a
> >> primitive, here is an implementation of it as one, under the name
> >> list-with-tail.
> > 
> > I think it would make more sense to call it `list*'.  Also it might make
> > sense to change backquote.el so it uses this `list*' (tho probably only
> > when passed with enough arguments).
> 
> Agreed. On more that one occasion, I've wished we had a CL-less `list*'.
> If you do add this feature, please make sure the existing list* compiler
> macros keep working.
> 
What about just deleting these compiler macros, and making cl-list* an
alias for list*?

There seems to be little point in keeping them if list* is a primitive.

bug#16963: A patch to create a list-with-tail primitive.

[Daniel Colascione]

[-- Attachment #1: Type: text/plain, Size: 947 bytes --]

On 03/27/2014 04:37 PM, Demetrios Obenour wrote:
> On Mon, 2014-03-24 at 19:45 -0700, Daniel Colascione wrote:
>> On 03/24/2014 07:10 PM, Stefan wrote:
>>>> Since a comment in backquote.el said that backquote-list* needed to be a
>>>> primitive, here is an implementation of it as one, under the name
>>>> list-with-tail.
>>>
>>> I think it would make more sense to call it `list*'.  Also it might make
>>> sense to change backquote.el so it uses this `list*' (tho probably only
>>> when passed with enough arguments).
>>
>> Agreed. On more that one occasion, I've wished we had a CL-less `list*'.
>> If you do add this feature, please make sure the existing list* compiler
>> macros keep working.
>>
> What about just deleting these compiler macros, and making cl-list* an
> alias for list*?
> 
> There seems to be little point in keeping them if list* is a primitive.

The new list* doesn't have an opcode, but cons does.


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 901 bytes --]

bug#16963: A patch to create a list-with-tail primitive.

[Demetrios Obenour]

On Thu, 2014-03-27 at 16:38 -0700, Daniel Colascione wrote:
> On 03/27/2014 04:37 PM, Demetrios Obenour wrote:
> > On Mon, 2014-03-24 at 19:45 -0700, Daniel Colascione wrote:
> >> On 03/24/2014 07:10 PM, Stefan wrote:
> >>>> Since a comment in backquote.el said that backquote-list* needed to be a
> >>>> primitive, here is an implementation of it as one, under the name
> >>>> list-with-tail.
> >>>
> >>> I think it would make more sense to call it `list*'.  Also it might make
> >>> sense to change backquote.el so it uses this `list*' (tho probably only
> >>> when passed with enough arguments).
> >>
> >> Agreed. On more that one occasion, I've wished we had a CL-less `list*'.
> >> If you do add this feature, please make sure the existing list* compiler
> >> macros keep working.
> >>
> > What about just deleting these compiler macros, and making cl-list* an
> > alias for list*?
> > 
> > There seems to be little point in keeping them if list* is a primitive.
> 
> The new list* doesn't have an opcode, but cons does.
> 

Ah I see -- there might be a speed advantage in repeated cons calls, up
to a point. At what point would the function look-up be slower than
repeated function calls (I thought that function calls in Emacs Lisp are
slow)?

bug#16963: A patch to create a list-with-tail primitive.

[Demetrios Obenour]

[-- Attachment #1: Type: text/plain, Size: 1197 bytes --]

On Thu, 2014-03-27 at 16:38 -0700, Daniel Colascione wrote:
> On 03/27/2014 04:37 PM, Demetrios Obenour wrote:
> > On Mon, 2014-03-24 at 19:45 -0700, Daniel Colascione wrote:
> >> On 03/24/2014 07:10 PM, Stefan wrote:
> >>>> Since a comment in backquote.el said that backquote-list* needed to be a
> >>>> primitive, here is an implementation of it as one, under the name
> >>>> list-with-tail.
> >>>
> >>> I think it would make more sense to call it `list*'.  Also it might make
> >>> sense to change backquote.el so it uses this `list*' (tho probably only
> >>> when passed with enough arguments).
> >>
> >> Agreed. On more that one occasion, I've wished we had a CL-less `list*'.
> >> If you do add this feature, please make sure the existing list* compiler
> >> macros keep working.
> >>
> > What about just deleting these compiler macros, and making cl-list* an
> > alias for list*?
> > 
> > There seems to be little point in keeping them if list* is a primitive.
> 
> The new list* doesn't have an opcode, but cons does.
> 
Good point! My testing showed four nested cons calls to be much faster
than list* with five arguments by several dozen times.

Maybe list* should be a macro instead?



[-- Attachment #2: Type: text/html, Size: 2268 bytes --]

bug#16963: A patch to create a list-with-tail primitive.

[Daniel Colascione]

[-- Attachment #1: Type: text/plain, Size: 1544 bytes --]

On 03/28/2014 06:46 PM, Demetrios Obenour wrote:
> On Thu, 2014-03-27 at 16:38 -0700, Daniel Colascione wrote:
>> On 03/27/2014 04:37 PM, Demetrios Obenour wrote:
>> > On Mon, 2014-03-24 at 19:45 -0700, Daniel Colascione wrote:
>> >> On 03/24/2014 07:10 PM, Stefan wrote:
>> >>>> Since a comment in backquote.el said that backquote-list* needed to be a
>> >>>> primitive, here is an implementation of it as one, under the name
>> >>>> list-with-tail.
>> >>>
>> >>> I think it would make more sense to call it `list*'.  Also it might make
>> >>> sense to change backquote.el so it uses this `list*' (tho probably only
>> >>> when passed with enough arguments).
>> >>
>> >> Agreed. On more that one occasion, I've wished we had a CL-less `list*'.
>> >> If you do add this feature, please make sure the existing list* compiler
>> >> macros keep working.
>> >>
>> > What about just deleting these compiler macros, and making cl-list* an
>> > alias for list*?
>> > 
>> > There seems to be little point in keeping them if list* is a primitive.
>> 
>> The new list* doesn't have an opcode, but cons does.
>> 
> Good point! My testing showed four nested cons calls to be much faster
> than list* with five arguments by several dozen times.
> 
> Maybe list* should be a macro instead?

No, list* as a function is perfectly fine --- we might want to call it
indirectly sometimes, e.g., with apply. The compiler macro is sufficient
to convert it to cons calls when we know it's safe. M-x disassemble is
your friend. :-)


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 901 bytes --]

bug#16963: A patch to create a list-with-tail primitive.

[Demetrios Obenour]

On Fri, 2014-03-28 at 18:48 -0700, Daniel Colascione wrote:
> On 03/28/2014 06:46 PM, Demetrios Obenour wrote:
> > On Thu, 2014-03-27 at 16:38 -0700, Daniel Colascione wrote:
> >> On 03/27/2014 04:37 PM, Demetrios Obenour wrote:
> >> > On Mon, 2014-03-24 at 19:45 -0700, Daniel Colascione wrote:
> >> >> On 03/24/2014 07:10 PM, Stefan wrote:
> >> >>>> Since a comment in backquote.el said that backquote-list* needed to be a
> >> >>>> primitive, here is an implementation of it as one, under the name
> >> >>>> list-with-tail.
> >> >>>
> >> >>> I think it would make more sense to call it `list*'.  Also it might make
> >> >>> sense to change backquote.el so it uses this `list*' (tho probably only
> >> >>> when passed with enough arguments).
> >> >>
> >> >> Agreed. On more that one occasion, I've wished we had a CL-less `list*'.
> >> >> If you do add this feature, please make sure the existing list* compiler
> >> >> macros keep working.
> >> >>
> >> > What about just deleting these compiler macros, and making cl-list* an
> >> > alias for list*?
> >> > 
> >> > There seems to be little point in keeping them if list* is a primitive.
> >> 
> >> The new list* doesn't have an opcode, but cons does.
> >> 
> > Good point! My testing showed four nested cons calls to be much faster
> > than list* with five arguments by several dozen times.
> > 
> > Maybe list* should be a macro instead?
> 
> No, list* as a function is perfectly fine --- we might want to call it
> indirectly sometimes, e.g., with apply. The compiler macro is sufficient
> to convert it to cons calls when we know it's safe. M-x disassemble is
> your friend. :-)
> 
Ah thanks!

Here is a patch to fix the Lisp files to exploit a list* primitive.

=== modified file 'lisp/emacs-lisp/cl-lib.el'
--- lisp/emacs-lisp/cl-lib.el	2014-01-01 07:43:34 +0000
+++ lisp/emacs-lisp/cl-lib.el	2014-03-29 13:12:10 +0000
@@ -527,19 +527,13 @@
 ;;    (while (consp (cdr x)) (pop x))
 ;;    x))
 
-(defun cl-list* (arg &rest rest)
+(defalias 'cl-list* (symbol-function 'list*)
   "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)))))
+\n(fn ARG...)")
+(put 'list* 'compiler-macro #'cl--compiler-macro-list*)
+(put 'cl-list* 'compiler-macro #'cl--compiler-macro-list*)
 
 (defun cl-ldiff (list sublist)
   "Return a copy of LIST with the tail SUBLIST removed."

=== modified file 'lisp/emacs-lisp/cl.el'
--- lisp/emacs-lisp/cl.el	2014-01-01 07:43:34 +0000
+++ lisp/emacs-lisp/cl.el	2014-03-29 12:58:27 +0000
@@ -257,7 +257,6 @@
                adjoin
                copy-list
                ldiff
-               list*
                cddddr
                cdddar
                cddadr

bug#16963: A patch to create a list-with-tail primitive.

[Lars Ingebrigtsen]

Demetrios Obenour <demetriobenour@gmail.com> writes:

> Since a comment in backquote.el said that backquote-list* needed to be a
> primitive, here is an implementation of it as one, under the name
> list-with-tail.

[...]

> -(defun cl-list* (arg &rest rest)
> +(defalias 'cl-list* (symbol-function 'list*)
>    "Return a new list with specified ARGs as elements, consed to last

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?

And then, could you re-spin the patches, along with changes to the
lispref manual as needed (and an etc/NEWS entry)?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#16963: A patch to create a list-with-tail primitive.

[Lars Ingebrigtsen]

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.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#16963: A patch to create a list-with-tail primitive.

[Noam Postavsky]

[-- 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

bug#16963: A patch to create a list-with-tail primitive.

[Drew Adams]

> 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:

The name has long been `list*' in Lisp, including
in Common Lisp.  That's the name that should (still)
be used, IMO.

http://clhs.lisp.se/Body/f_list_.htm

  list* is like list except that the last argument to list
  becomes the car of the last cons constructed, while the
  last argument to list* becomes the cdr of the last cons
  constructed. Hence, any given call to list* always
  produces one fewer conses than a call to list with the
  same number of arguments.

  If the last argument to list* is a list, the effect is
  to construct a new list which is similar, but which has
  additional elements added to the front corresponding to
  the preceding arguments of list*.

  If list* receives only one object, that object is returned,
  regardless of whether or not it is a list.