bug#23660: edebug doesn't support circular object read syntax

bug#23660: edebug doesn't support circular object read syntax

[Noam Postavsky]

Do C-u C-M-x on

    '(#1=a . #1#)

Result: Invalid read syntax "#"

It would be useful to support this in order to instrument
macroexpanded code that uses `make-symbol'.

bug#23660: edebug doesn't support circular object read syntax

[Michael Heerdegen]

Noam Postavsky <npostavs@users.sourceforge.net> writes:

> Do C-u C-M-x on
>
>     '(#1=a . #1#)
>
> Result: Invalid read syntax "#"

Instrumenting a constant is surely not very useful.  But instrumenting a
definition that contains that read syntax fails too; e.g.

(defun f ()
  '(#1=a . #1#))

which is not so nice indeed (the above definition doesn't involve
anything circular btw).


Michael.

bug#23660: edebug doesn't support circular object read syntax

[Noam Postavsky]

On Tue, May 31, 2016 at 10:53 AM, Michael Heerdegen
<michael_heerdegen@web.de> wrote:
> (the above definition doesn't involve anything circular btw).

Yes, this particular object is not circular, it's just a minimal
example of what the manual describes in the "Read Syntax for Circular
Objects" section. And `print-circle' needs to be set to non-nil in
order to get such output when printing (e.g. macro-expansions).

bug#23660: Patch (was: bug#23660: edebug doesn't support circular object read syntax)

[Gemini Lasswell]

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

Here's a patch adding support for circular object read syntax to Edebug:


[-- Attachment #2: 0001-Support-read-syntax-for-circular-objects-in-Edebug-B.patch --]
[-- Type: text/plain, Size: 6361 bytes --]

From 5c3a56e4723960cdc335d6daec3387f8114e3cb0 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Thu, 16 Feb 2017 22:08:03 -0800
Subject: [PATCH] Support read syntax for circular objects in Edebug
 (Bug#23660)

* lisp/emacs-lisp/edebug.el (edebug-read-special): New name
for edebug-read-function. Handle the read syntax for circular
objects.
(edebug-read-objects): New variable.
(edebug-read-and-maybe-wrap-form1): Reset edebug-read-objects.

* src/lread.c (Fsubstitute_object_in_subtree): Make
substitute_object_in_subtree into a Lisp primitive.
---
 lisp/emacs-lisp/edebug.el | 60 +++++++++++++++++++++++++++++++++++++----------
 src/lread.c               | 12 ++++++----
 2 files changed, 55 insertions(+), 17 deletions(-)

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index a883804..267fc57 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -755,6 +755,11 @@ edebug-offsets
 (defvar edebug-offsets-stack nil)
 (defvar edebug-current-offset nil) ; Top of the stack, for convenience.
 
+;; The association list of objects read with the #n=object form.
+;; Each member of the list has the form (n . object), and is used to
+;; look up the object for the corresponding #n# construct.
+(defvar edebug-read-objects nil)
+
 ;; We must store whether we just read a list with a dotted form that
 ;; is itself a list.  This structure will be condensed, so the offsets
 ;; must also be condensed.
@@ -826,7 +831,7 @@ edebug-read-alist
     (backquote . edebug-read-backquote)
     (comma . edebug-read-comma)
     (lbracket . edebug-read-vector)
-    (hash . edebug-read-function)
+    (hash . edebug-read-special)
     ))
 
 (defun edebug-read-storing-offsets (stream)
@@ -872,17 +877,47 @@ edebug-read-comma
        (edebug-storing-offsets opoint symbol)
        (edebug-read-storing-offsets stream)))))
 
-(defun edebug-read-function (stream)
-  ;; Turn #'thing into (function thing)
-  (forward-char 1)
-  (cond ((eq ?\' (following-char))
-	 (forward-char 1)
-	 (list
-	  (edebug-storing-offsets (- (point) 2) 'function)
-	  (edebug-read-storing-offsets stream)))
-        (t
-	 (backward-char 1)
-	 (read stream))))
+(defun edebug-read-special (stream)
+  "Read from STREAM a Lisp object beginning with #.
+Turn #'thing into (function thing) and handle the read syntax for
+circular objects.  Let `read' read everything else."
+  (catch 'return
+    (forward-char 1)
+    (let ((start (point)))
+      (cond
+       ((eq ?\' (following-char))
+        (forward-char 1)
+        (throw 'return
+               (list
+                (edebug-storing-offsets (- (point) 2) 'function)
+                (edebug-read-storing-offsets stream))))
+       ((and (>= (following-char) ?0) (<= (following-char) ?9))
+        (while (and (>= (following-char) ?0) (<= (following-char) ?9))
+          (forward-char 1))
+        (let ((n (string-to-number (buffer-substring start (point)))))
+          (when (and read-circle
+                     (<= n most-positive-fixnum))
+            (cond
+             ((eq ?= (following-char))
+              ;; Make a placeholder for #n# to use temporarily.
+              (let* ((placeholder (cons nil nil))
+                     (elem (cons n placeholder)))
+                (push elem edebug-read-objects)
+                ;; Read the object and then replace the placeholder
+                ;; with the object itself, wherever it occurs.
+                (forward-char 1)
+                (let ((obj (edebug-read-storing-offsets stream)))
+                  (substitute-object-in-subtree obj placeholder)
+                  (throw 'return (setf (cdr elem) obj)))))
+             ((eq ?# (following-char))
+              ;; #n# returns a previously read object.
+              (let ((elem (assq n edebug-read-objects)))
+                (when (consp elem)
+                  (forward-char 1)
+                  (throw 'return (cdr elem))))))))))
+      ;; Let read handle errors, radix notation, and anything else.
+      (goto-char (1- start))
+      (read stream))))
 
 (defun edebug-read-list (stream)
   (forward-char 1)			; skip \(
@@ -1074,6 +1109,7 @@ edebug-read-and-maybe-wrap-form1
 	edebug-offsets
 	edebug-offsets-stack
 	edebug-current-offset ; reset to nil
+        edebug-read-objects
 	)
     (save-excursion
       (if (and (eq 'lparen (edebug-next-token-class))
diff --git a/src/lread.c b/src/lread.c
index 094aa62..1b154b7 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -558,8 +558,6 @@ static Lisp_Object read_vector (Lisp_Object, bool);
 
 static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object,
                                               Lisp_Object);
-static void substitute_object_in_subtree (Lisp_Object,
-                                          Lisp_Object);
 static void substitute_in_interval (INTERVAL, Lisp_Object);
 
 \f
@@ -2957,7 +2955,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 		      tem = read0 (readcharfun);
 
 		      /* Now put it everywhere the placeholder was...  */
-		      substitute_object_in_subtree (tem, placeholder);
+		      Fsubstitute_object_in_subtree (tem, placeholder);
 
 		      /* ...and #n# will use the real value from now on.  */
 		      Fsetcdr (cell, tem);
@@ -3326,8 +3324,10 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 /* List of nodes we've seen during substitute_object_in_subtree.  */
 static Lisp_Object seen_list;
 
-static void
-substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
+DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree,
+       Ssubstitute_object_in_subtree, 2, 2, 0,
+       doc: /* Replace every reference to PLACEHOLDER in OBJECT with OBJECT.  */)
+  (Lisp_Object object, Lisp_Object placeholder)
 {
   Lisp_Object check_object;
 
@@ -3345,6 +3345,7 @@ substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
      original.  */
   if (!EQ (check_object, object))
     error ("Unexpected mutation error in reader");
+  return Qnil;
 }
 
 /*  Feval doesn't get called from here, so no gc protection is needed.  */
@@ -4548,6 +4549,7 @@ syms_of_lread (void)
 {
   defsubr (&Sread);
   defsubr (&Sread_from_string);
+  defsubr (&Ssubstitute_object_in_subtree);
   defsubr (&Sintern);
   defsubr (&Sintern_soft);
   defsubr (&Sunintern);
-- 
2.10.1

bug#23660: Patch for (edebug doesn't support circular object read syntax)

[npostavs]

tags 23660 patch
quit

Gemini Lasswell <gazally@runbox.com> writes:

> Here's a patch adding support for circular object read syntax to Edebug:

Looks good, I will push to master in a few days.

The main motivation (which I probably should have mentioned in the OP)
is to step in macro expansions, e.g. after doing (setq print-circle t
print-gensym t)

    (pcase '(1 2)
      (`(,a ,b) (+ a b)))

expands to

    (if (consp #1='(1 2))
        (let* ((#5=#:x (car #1#))
               (#2=#:x (cdr #1#)))
          (if (consp #2#)
              (let* ((#4=#:x (car #2#))
                     (#3=#:x (cdr #2#)))
                (if (null #3#)
                    (let ((b #4#)
                          (a #5#))
                      (+ a b))
                  nil))
            nil))
      nil)

With the patch, I can step through the latter nicely.  Thanks!

bug#23660: Patch for (edebug doesn't support circular object read syntax)

[npostavs]

tags 23660 fixed
close 23660 26.1
quit

npostavs@users.sourceforge.net writes:

>
> Gemini Lasswell <gazally@runbox.com> writes:
>
>> Here's a patch adding support for circular object read syntax to Edebug:
>
> Looks good, I will push to master in a few days.

Pushed.

1: 2017-02-23 20:21:11 -0500 8b912ab47bc91f54565f127abf24c97e5d46a1ba
  Support read syntax for circular objects in Edebug (Bug#23660)