>From 5c3a56e4723960cdc335d6daec3387f8114e3cb0 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell 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); @@ -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