GNU bug report logs - #26601
26.0.50; Improvements to cl-symbol-macrolet

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 26601 in the body.
You can then email your comments to 26601 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: npostavs <at> users.sourceforge.net
To: bug-gnu-emacs <at> gnu.org
Subject: 26.0.50; Improvements to cl-symbol-macrolet
Date: Fri, 21 Apr 2017 23:59:23 -0400

[Message part 1 (text/plain, inline)]

Severity: wishlist
Tags: patch

I was looking at the recent fix for #26325 [1: 89898e43c7], and I think splitting the
variable bindings from the main macro environment will simplify things:

[v1-0001-Split-variable-macro-env-from-function-env.patch (text/x-diff, inline)]

From d0233406d88f712041f8307e837b9f4f95f17c4b Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs <at> gmail.com>
Date: Fri, 21 Apr 2017 23:37:05 -0400
Subject: [PATCH v1] 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 db1518ce61..b1ada00f4a 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2047,28 +2047,22 @@ cl--old-macroexpand
       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 @@ cl--sm-macroexpand
              (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 @@ cl-symbol-macrolet
 
 \(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.
 
-- 
2.11.1

[Message part 3 (text/plain, inline)]

[1: 89898e43c7]: 2017-04-21 12:12:42 -0400
  * lisp/emacs-lisp/cl-macs.el: Fix symbol-macrolet
  http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da

Message #8 received at 26601 <at> debbugs.gnu.org (full text, mbox):

From: npostavs <at> users.sourceforge.net
To: 26601 <at> debbugs.gnu.org
Cc: Stefan Monnier <monnier <at> IRO.UMontreal.CA>
Subject: Re: bug#26601: 26.0.50; Improvements to cl-symbol-macrolet
Date: Wed, 07 Jun 2017 22:28:10 -0400

tags 26601 fixed
close 26601 
quit

npostavs <at> users.sourceforge.net writes:

> Subject: [PATCH v1] 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.

Pushed to master [1: 0648edf3e0].

[1: 0648edf3e0]: 2017-06-07 20:03:31 -0400
  Split variable macro env from function env
  http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=0648edf3e05e224ee8410ab244df7364f919dc58

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.