* bug#23660: Patch (was: bug#23660: edebug doesn't support circular object read syntax)
2016-05-31 15:13 ` Noam Postavsky
@ 2017-02-20 18:33 ` Gemini Lasswell
2017-02-20 19:39 ` bug#23660: Patch for (edebug " npostavs
0 siblings, 1 reply; 6+ messages in thread
From: Gemini Lasswell @ 2017-02-20 18:33 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 23660
[-- 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
^ permalink raw reply related [flat|nested] 6+ messages in thread