Subject: bug#72334: [PATCH] Always print commas and comma-ats specially

From: Thuna <[email-masked]>
Date: Tue, 04 Mar 2025 22:02:55 +0100

>> ---
>>  src/print.c | 58 ++++++++++++++++++++++-------------------------------
>>  1 file changed, 24 insertions(+), 34 deletions(-)
>>
>> diff --git a/src/print.c b/src/print.c
>> index c7cba5bface..adc63ec253c 100644
>> --- a/src/print.c
>> +++ b/src/print.c
>> @@ -2483,48 +2483,32 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
>>        break;
>>
>>      case Lisp_Cons:
>> +      Lisp_Object car = XCAR (obj);
>
> I guess you do this here because of caching, but now we don't know that
>
>     CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))
>
> so don't we risk a crash here?

That's being checked for in
>>        else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
no?  Or am I misunderstanding the problem?

>>        /* If deeper than spec'd depth, print placeholder.  */
>>        if (FIXNUMP (Vprint_level)
>>  	  && print_depth > XFIXNUM (Vprint_level))
>>  	print_c_string ("...", printcharfun);
>>        else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
>> -	       && EQ (XCAR (obj), Qquote))
>> +	       && (EQ (car, Qquote) ||
>> +		   EQ (car, Qfunction) ||
>> +		   EQ (car, Qbackquote) ||
>> +		   EQ (car, Qcomma) ||
>> +		   EQ (car, Qcomma_at)))
>>  	{
>> -	  printchar ('\'', printcharfun);
>> +	  if (EQ (car, Qquote))
>> +	    printchar ('\'', printcharfun);
>> +	  else if (EQ (car, Qfunction))
>> +	    print_c_string("#'", printcharfun);
>> +          else if (EQ (car, Qbackquote))
>> +	    printchar ('`', printcharfun);
>> +          else if (EQ (car, Qcomma))
>> +	    printchar (',', printcharfun);
>> +          else if (EQ (car, Qcomma_at))
>> +	    print_c_string (",@", printcharfun);
>
> Hmm, I don't know if it matters except for code cleanliness, but I'm
> wondering if we can avoid testing for the same thing twice.
>
> Can't you make the same additions in the code below instead?  Or
> reorganize it somehow to be more clean?

I don't really see a straightforward way to do that while not repeating
the `else' section below.  You could have a `type = X' in the condition
to avoid having to compare `car' again, but that would be about it.

> Hmm, this is a little bit hard to review.  Do we really need to inline
> `cl-print--cons-tail`?  Just as a very high-level comment, it seems like
> we go from two relatively small functions to one big and complex one.
> Is that justified?

Hm, yes, I can see how that would be difficult to review.  This can (I
think; I've not tested) be done with a small patch, which I've attached,
but I think that it's overall easier to reason about the large function,
which I've outlined below.  Nevertheless, feel free to go with either
(though do run the tests on the attached patch, please).

> (cl-defmethod cl-print-object ((object cons) stream)
>   (let ((count 0))
>     (cl-flet* (
The local function `quotedp' checks if OBJ should be quoted (that is,
"'foo", "#'foo", etc.).  If TAILP is non-nil, then OBJ should be quoted
even when it's at a tail position (the difference between "(foo . ,bar)"
and "(foo quote bar)").
>                (quotedp (obj &optional tailp)
>                  (and print-quoted
>                       (consp obj)
>                       (consp (cdr obj))
>                       (null (cddr obj))
>                       (or (and (not tailp) (memq (car object) '(function quote)))
>                           (memq (car obj) '(\` \, \,@ \,.)))))
The local function `endp' checks if TAIL terminates the printing of a
list at the cdr position (that is, an atom, a [tail] quoted form, a
backref [#N#], or a circular object [#N=]).
>                (endp (tail)
>                  (or (atom tail)
>                      (quotedp tail t)
>                      (cond
>                       ((zerop count) nil)
>                       (cl-print--number-table
>                        (numberp (gethash object cl-print--number-table)))
>                       ((memq object cl-print--currently-printing))
>                       (t (push object cl-print--currently-printing)
>                          nil)))))
>       (cond
This branch is when we exceed the depth limit.
>        ((and cl-print--depth (natnump print-level)
>              (> cl-print--depth print-level))
>         (cl-print-insert-ellipsis object nil stream))
This branch is when OBJECT is quoted.
>        ((quotedp object)
>         (princ (cl-case (car object)
>                  (quote "'")
>                  (function "#'")
>                  (t (car object)))
>                stream)
>         (cl-print-object (cadr object) stream))
This branch is when OBJECT is a non-quoted cons.  My understanding is
that backrefs and circular objects would have already been handled by
:around/:before methods, so we can immediately assume we're dealing with
a normal list.
>        (t
>         (princ "(" stream)
We go until the current object terminates the normal printing of a list.
Since OBJECT is not circular or a backref (by our previous assumption),
quoted (due to the previous branch), or a non-cons (by the method
specialization), we will not hit this immediately, so we will at least
print one item (which is a necessary condition, given we already opened
a parenthesis).
>         (while (not (endp object))
If we exceed the length, we print an ellipsis and exit such that we
immediately insert a closing parenthesis.
>           (if (and (natnump print-length) (>= count print-length))
>               (progn
>                 (cl-print-insert-ellipsis object t stream)
>                 (setq object nil))
Otherwise we print the current item and move along.
>             (cl-print-object (pop object) stream)
Unless the new tail is nil, we will be printing _something_, whether it
be another item or a dot, so we can directly print a space to avoid
having to do it later.
>             (when object
>               (princ " " stream)))
>           (cl-incf count))
When we're here, `(endp object)' will be true.  If OBJECT is nil, then
we just insert a closing parenthesis, otherwise we insert ". "
(remember, we already inserted the space in the `while' loop) and then
print the final tail before.
>         (when object
>           (princ ". " stream)
Since OBJECT here is either an atom, a quoted form, a backref, or a
circular object, calling cl-print-object will always do the right thing.
The only non-obvious one is the quoted form - that will call this method
again, going into the `(quotedp object)' branch [It might get stuck in
the depth branch?  I am not fully sure about that.] and print normally.
>           (cl-print-object object stream))
>         (princ ")" stream))))))

diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 5af34361b92..76f964b828e 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -89,6 +89,11 @@ cl-print--cons-tail
   (let ((count 1))
     (cl-print-object car stream)
     (while (and (consp object)
+                (not (and print-quoted
+                          (memq (car object) '(\, \` \,@ \,.))
+                          (consp object)
+                          (consp (cdr object))
+                          (null (cddr object))))
                 (not (cond
                       (cl-print--number-table
                        (numberp (gethash object cl-print--number-table)))