Package: emacs;
Reported by: Thuna <thuna.cing <at> gmail.com>
Date: Sun, 28 Jul 2024 13:34:01 UTC
Severity: normal
Tags: patch
Message #38 received at 72334 <at> debbugs.gnu.org (full text, mbox):
From: Stefan Kangas <stefankangas <at> gmail.com> To: Thuna <thuna.cing <at> gmail.com> Cc: 72334 <at> debbugs.gnu.org, Stefan Monnier <monnier <at> iro.umontreal.ca> Subject: Re: bug#72334: [PATCH] Always print commas and comma-ats specially Date: Sun, 23 Feb 2025 00:48:45 +0000
Thuna <thuna.cing <at> gmail.com> writes:
> Ok, I have the tests. In the process I found what I think are bugs in
> print-tests.el and realized that I need to patch cl-print.el as well, so
> I have all of those here as well, as separate patches.
Thanks, I have some comments on the last two patches.
Meanwhile, your first patch LGTM, so I installed that one to get it out
of the way.
> From 8b4d1ff7ef49a7f0b6e432cf03b7aa33c7fd7e48 Mon Sep 17 00:00:00 2001
> From: Thuna <thuna.cing <at> gmail.com>
> Date: Wed, 12 Feb 2025 23:40:44 +0100
> Subject: [PATCH 3/4] Print commas and backquotes correctly
>
> * src/print.c (print_object): Print commas and comma-ats as special
> regardless of whether they are in a backquote or not, so long as
> print-quoted is non-nil. Print tailing backquote, comma, and comma-at
> forms as atoms and not lists. Calculate the head of OBJ once.
Missing a bug number here: (Bug#72334)
> ---
> 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?
> /* 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?
> obj = XCAR (XCDR (obj));
> --print_depth; /* tail recursion */
> goto print_obj;
> }
> - else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
> - && EQ (XCAR (obj), Qfunction))
> - {
> - print_c_string ("#'", printcharfun);
> - obj = XCAR (XCDR (obj));
> - --print_depth; /* tail recursion */
> - goto print_obj;
> - }
> - /* FIXME: Do we really need the new_backquote_output gating of
> - special syntax for comma and comma-at? There is basically no
> - benefit from it at all, and it would be nice to get rid of
> - the recursion here without additional complexity. */
> - else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
> - && EQ (XCAR (obj), Qbackquote))
> - {
> - printchar ('`', printcharfun);
> - new_backquote_output++;
> - print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
> - new_backquote_output--;
> - }
> - else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
> - && (EQ (XCAR (obj), Qcomma)
> - || EQ (XCAR (obj), Qcomma_at))
> - && new_backquote_output)
> - {
> - print_object (XCAR (obj), printcharfun, false);
> - new_backquote_output--;
> - print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
> - new_backquote_output++;
> - }
> else
> {
> printchar ('(', printcharfun);
> @@ -2547,7 +2531,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
> .u.list.tortoise_idx = 0,
> });
> /* print the car */
> - obj = XCAR (obj);
> + obj = car;
> goto print_obj;
> }
> }
> @@ -2670,7 +2654,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
> --print_depth;
> goto next_obj;
> }
> - else if (CONSP (next))
> + else if (CONSP (next)
> + && !(print_quoted
> + && (EQ (Qbackquote, XCAR (next))
> + || EQ (Qcomma, XCAR (next))
> + || EQ (Qcomma_at, XCAR (next)))
> + && CONSP (XCDR (next))
> + && NILP (XCDR (XCDR (next)))))
> {
> if (!NILP (Vprint_circle))
> {
> --
> 2.44.2
>
>
> From c6a9843680ebb075ff0d0041ca590656e06bcee7 Mon Sep 17 00:00:00 2001
> From: Thuna <thuna.cing <at> gmail.com>
> Date: Wed, 12 Feb 2025 23:42:48 +0100
> Subject: [PATCH 4/4] Print backquotes and commas correctly in cl-print.el
>
> * lisp/emacs-lisp/cl-print.el (cl-print--cons-tail): Delete function.
> (cl-print-object): Refactor to do the work of `cl-print--cons-tail' as
> well. Print tailing backquote, comma, and comma-ats as atoms.
Missing bug number here also: (Bug#72334)
> ---
> lisp/emacs-lisp/cl-print.el | 75 ++++++++++++++++++++-----------------
> 1 file changed, 41 insertions(+), 34 deletions(-)
>
> diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
> index 5af34361b92..4ff8c58eae1 100644
> --- a/lisp/emacs-lisp/cl-print.el
> +++ b/lisp/emacs-lisp/cl-print.el
> @@ -66,43 +66,50 @@ cl-print-object-contents
> (error "Missing cl-print-object-contents method"))
>
> (cl-defmethod cl-print-object ((object cons) stream)
> - (if (and cl-print--depth (natnump print-level)
> - (> cl-print--depth print-level))
> - (cl-print-insert-ellipsis object nil stream)
> - (let ((car (pop object)))
> - (if (and print-quoted
> - (memq car '(\, quote function \` \,@ \,.))
> - (consp object)
> - (null (cdr object)))
> - (progn
> - (princ (cond
> - ((eq car 'quote) '\')
> - ((eq car 'function) "#'")
> - (t car))
> - stream)
> - (cl-print-object (car object) stream))
> - (princ "(" stream)
> - (cl-print--cons-tail car object stream)
> - (princ ")" stream)))))
> -
> -(defun cl-print--cons-tail (car object stream)
> - (let ((count 1))
> - (cl-print-object car stream)
> - (while (and (consp object)
> - (not (cond
> + (let ((count 0))
> + (cl-flet* ((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) '(\` \, \,@ \,.)))))
> + (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))))
> - (princ " " stream)
> - (if (or (not (natnump print-length)) (> print-length count))
> - (cl-print-object (pop object) stream)
> - (cl-print-insert-ellipsis object t stream)
> - (setq object nil))
> - (cl-incf count))
> - (when object
> - (princ " . " stream) (cl-print-object object stream))))
> + (t (push object cl-print--currently-printing)
> + nil)))))
> + (cond
> + ((and cl-print--depth (natnump print-level)
> + (> cl-print--depth print-level))
> + (cl-print-insert-ellipsis object nil stream))
> + ((quotedp object)
> + (princ (cl-case (car object)
> + (quote "'")
> + (function "#'")
> + (t (car object)))
> + stream)
> + (cl-print-object (cadr object) stream))
> + (t
> + (princ "(" stream)
> + (while (not (endp object))
> + (if (and (natnump print-length) (>= count print-length))
> + (progn
> + (cl-print-insert-ellipsis object t stream)
> + (setq object nil))
> + (cl-print-object (pop object) stream)
> + (when object
> + (princ " " stream)))
> + (cl-incf count))
> + (when object
> + (princ ". " stream)
> + (cl-print-object object stream))
> + (princ ")" stream))))))
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?
>
> (cl-defmethod cl-print-object-contents ((object cons) _start stream)
> (cl-print--cons-tail (car object) (cdr object) stream))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.