Split variable macro env from function env

* lisp/emacs-lisp/cl-macs.el (cl--sm-macroexpand): Remove.
(cl-symbol-macrolet): Instead of adding each binding directly into the
main environment with a special key format, put all symbol macro
bindings into a single entry in the main environment under
`:cl-symbol-macros'.
(cl--sm-macroexpand): Look up symbol bindings in the
`:cl-symbol-macros' entry of the environment.

1 files changed, 28 insertions, 36 deletions

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index db1518ce611..b1ada00f4a4 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2047,28 +2047,22 @@ This is like `cl-flet', but for macros instead of functions.
       cl--old-macroexpand
     (symbol-function 'macroexpand)))
 
-(defun cl--symbol-macro-key (sym)
-  "Return the key used in `macroexpand-all-environment' for symbol macro SYM."
-  ;; In the past we've used `symbol-name' instead, but that doesn't
-  ;; preserve the `eq'uality between different symbols of the same name.
-  `(:cl-symbol-macro . ,sym))
-
 (defun cl--sm-macroexpand (exp &optional env)
   "Special macro expander used inside `cl-symbol-macrolet'.
 This function replaces `macroexpand' during macro expansion
 of `cl-symbol-macrolet', and does the same thing as `macroexpand'
 except that it additionally expands symbol macros."
-  (let ((macroexpand-all-environment env))
+  (let ((macroexpand-all-environment env)
+        (venv (alist-get :cl-symbol-macros env)))
     (while
         (progn
           (setq exp (funcall cl--old-macroexpand exp env))
           (pcase exp
             ((pred symbolp)
              ;; Perform symbol-macro expansion.
-             ;; FIXME: Calling `cl--symbol-macro-key' for every var reference
-             ;; is a bit more costly than I'd like.
-             (when (cdr (assoc (cl--symbol-macro-key exp) env))
-               (setq exp (cadr (assoc (cl--symbol-macro-key exp) env)))))
+             (let ((symval (assq exp venv)))
+               (when symval
+                 (setq exp (cadr symval)))))
             (`(setq . ,_)
              ;; Convert setq to setf if required by symbol-macro expansion.
              (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env))
@@ -2086,7 +2080,7 @@ except that it additionally expands symbol macros."
              (let ((letf nil) (found nil) (nbs ()))
                (dolist (binding bindings)
                  (let* ((var (if (symbolp binding) binding (car binding)))
-                        (sm (assoc (cl--symbol-macro-key var) env)))
+                        (sm (assq var venv)))
                    (push (if (not (cdr sm))
                              binding
                            (let ((nexp (cadr sm)))
@@ -2144,30 +2138,28 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
 
 \(fn ((NAME EXPANSION) ...) FORM...)"
   (declare (indent 1) (debug ((&rest (symbolp sexp)) cl-declarations body)))
-  (cond
-   ((cdr bindings)
-    `(cl-symbol-macrolet (,(car bindings))
-       (cl-symbol-macrolet ,(cdr bindings) ,@body)))
-   ((null bindings) (macroexp-progn body))
-   (t
-    (let ((previous-macroexpand (symbol-function 'macroexpand)))
-      (unwind-protect
-          (progn
-            (fset 'macroexpand #'cl--sm-macroexpand)
-            (let ((expansion
-                   ;; FIXME: For N bindings, this will traverse `body' N times!
-                   (macroexpand-all (macroexp-progn body)
-                                    (cons (list (cl--symbol-macro-key
-                                                 (caar bindings))
-                                                (cl-cadar bindings))
-                                          macroexpand-all-environment))))
-              (if (or (null (cdar bindings)) (cl-cddar bindings))
-                  (macroexp--warn-and-return
-                   (format-message "Malformed `cl-symbol-macrolet' binding: %S"
-                                   (car bindings))
-                   expansion)
-                expansion)))
-        (fset 'macroexpand previous-macroexpand))))))
+  (let ((previous-macroexpand (symbol-function 'macroexpand))
+        (malformed-bindings nil))
+    (dolist (binding bindings)
+      (unless (and (consp binding) (symbolp (car binding))
+                   (consp (cdr binding)) (null (cddr binding)))
+        (push binding malformed-bindings)))
+    (unwind-protect
+        (progn
+          (fset 'macroexpand #'cl--sm-macroexpand)
+          (let* ((venv (cdr (assq :cl-symbol-macros macroexpand-all-environment)))
+                 (expansion
+                  (macroexpand-all (macroexp-progn body)
+                                   (cons (cons :cl-symbol-macros
+                                               (append bindings venv))
+                                         macroexpand-all-environment))))
+            (if malformed-bindings
+                (macroexp--warn-and-return
+                 (format-message "Malformed `cl-symbol-macrolet' binding(s): %S"
+                                 (nreverse malformed-bindings))
+                 expansion)
+              expansion)))
+      (fset 'macroexpand previous-macroexpand))))
 
 ;;; Multiple values.