From: Gemini Lasswell Date: Fri, 17 Feb 2017 06:08:03 +0000 (-0800) Subject: Support read syntax for circular objects in Edebug (Bug#23660) X-Git-Tag: emacs-26.0.90~726 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8b912ab47bc91f54565f127abf24c97e5d46a1ba;p=emacs.git 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. --- diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index a8838046a4d..267fc573d3a 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -755,6 +755,11 @@ Maybe clear the markers and delete the symbol's edebug property?" (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 @@ Maybe clear the markers and delete the symbol's edebug property?" (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 @@ Maybe clear the markers and delete the symbol's edebug property?" (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 @@ Maybe clear the markers and delete the symbol's edebug property?" 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 094aa628eec..1b154b7326e 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);