scope.el: Some macros will hurt you if you expand them

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index 59b4a97e2e48ff964d36ba254c73a38816e81fed..c48c9da293310aae61999e542d128e65e82b4dee 100644 (file)
--- a/lisp/emacs-lisp/scope.el
+++ b/lisp/emacs-lisp/scope.el
@@ -459,8 +459,38 @@ Optional argument LOCAL is a local context to extend."
   (scope-1 local object)
   (scope-let local spec-list body))
 
+(defun scope-rx (local regexps)
+  (dolist (regexp regexps)
+    (when (consp regexp)
+      (let* ((head (car regexp))
+             (bare (scope-sym-bare head)))
+        (cond
+         ((memq bare '(literal regex regexp eval))
+          (scope-1 local (cadr regexp)))
+         ((memq bare '( seq sequence and :
+                        or |
+                        zero-or-more 0+ * *?
+                        one-or-more 1+ + +?
+                        zero-or-one optional opt ? ??
+                        = >= ** repeat
+                        minimal-match maximal-match
+                        group submatch
+                        group-n submatch-n))
+          (scope-rx (cdr regexp))))))))
+
 (defvar scope-assume-func-p nil)
 
+(defvar scope-safe-macros t
+  "Specify which macros are safe to expand.
+
+If this is t, all macros are considered safe.  Otherwise, this is
+a (possibly empty) list of safe macros.")
+
+(defun scope-safe-macro-p (macro)
+  (or (eq scope-safe-macros t)
+      (memq macro scope-safe-macros)
+      (get macro 'safe-macro)))
+
 (defun scope-1 (local form &optional top-level)
   (cond
    ((consp form)
@@ -523,8 +553,10 @@ Optional argument LOCAL is a local context to extend."
             (scope-flet local (car forms) (cdr forms)))
            ((memq bare '(cl-labels))
             (scope-labels local (car forms) (cdr forms)))
-           ((memq bare '( eval-when-compile eval-and-compile
-                          setf pop push with-memoization cl-pushnew))
+           ((memq bare '( setf pop push with-memoization cl-pushnew
+                          ;; The following macros evaluate unsafe code.
+                          ;; Never expand them!
+                          static-if eval-when-compile eval-and-compile))
             (scope-n local forms))
            ((memq bare '(with-slots))
             (scope-with-slots local (car forms) (cadr forms) (cddr forms)))
@@ -539,10 +571,25 @@ Optional argument LOCAL is a local context to extend."
             (scope-block local (car forms) (cdr forms)))
            ((memq bare '(cl-return-from))
             (scope-return-from local (car forms) (cadr forms)))
-           (t (scope-1 local (let ((symbols-with-pos-enabled t))
-                               ;; Ignore errors from trying to expand
-                               ;; invalid macro calls such as (dolist).
-                               (ignore-errors (macroexpand-1 form)))))))
+           ((memq bare '(rx))           ; `rx' is unsafe, never expand!
+            (scope-rx local forms))
+           ((memq bare '(cl-eval-when)) ; Likewise!
+            (scope-rx local (cdr forms)))
+           ((scope-safe-macro-p bare)
+            (scope-1 local (let ((symbols-with-pos-enabled t))
+                             ;; Ignore errors from trying to expand
+                             ;; invalid macro calls such as (dolist).
+                             (ignore-errors
+                               (let ((macroexpand-all-environment
+                                      (append
+                                       ;; Inhibit expansion of unsafe
+                                       ;; macros during this expansion.
+                                       ;; We'll encounter them later on
+                                       ;; and handle them manually.
+                                       '((static-if) (rx) (cl-eval-when)
+                                         (eval-when-compile) (eval-and-compile))
+                                       macroexpand-all-environment)))
+                                 (macroexpand-1 form macroexpand-all-environment))))))))
          ;; Assume nothing about unknown top-level forms.
          (top-level nil)
          (scope-assume-func-p (scope-n local forms))))))