[Emacs-diffs] master 0648edf: Split variable macro env from function env

[Noam Postavsky]

branch: master
commit 0648edf3e05e224ee8410ab244df7364f919dc58
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>

    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.
---
 lisp/emacs-lisp/cl-macs.el | 64 ++++++++++++++++++++--------------------------
 1 file changed, 28 insertions(+), 36 deletions(-)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index db1518c..b1ada00 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.