scope.el: Initial 'cl-tagbody' support

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index 35f2bc5a15df63aa477fad77c6df6fde96da0a13..726459a200d4b1d113b012ead24d336e80b29824 100644 (file)
--- a/lisp/emacs-lisp/scope.el
+++ b/lisp/emacs-lisp/scope.el
@@ -1328,6 +1328,37 @@ a (possibly empty) list of safe macros.")
   ;; Unsafe macro!
   (scope-rx l regexps))
 
+(scope-define-macro-analyzer cl-tagbody (l &rest body)
+  (let (labels statements)
+    (while body
+      (let ((head (pop body)))
+        (if (consp head)
+            (push head statements)
+          (push head labels))))
+    (scope-cl-tagbody l (nreverse labels) (nreverse statements))))
+
+(defvar scope-label-alist nil)
+
+(defun scope-cl-tagbody (l labels statements)
+  (if labels
+      (let* ((label (car labels))
+             (bare (scope-sym-bare label)))
+        (when-let ((beg (scope-sym-pos label)))
+          (scope-report 'label beg (length (symbol-name bare)) beg))
+        (let ((scope-label-alist
+               (if bare
+                   (scope-local-new bare (scope-sym-pos label) scope-label-alist)
+                 scope-label-alist)))
+          (scope-cl-tagbody l (cdr labels) statements)))
+    (scope-n l statements)))
+
+(scope-define-macro-analyzer go (_l label)
+  ;; Change to a local macro defintion induced by `cl-tagbody'.
+  (when-let ((bare (scope-sym-bare label))
+             (pos (alist-get bare scope-label-alist))
+             (beg (scope-sym-pos label)))
+    (scope-report 'label beg (length (symbol-name bare)) pos)))
+
 (scope-define-macro-analyzer rx-define (l name &rest rest)
   (scope-rx-define l name rest))