GNU bug report logs - #12119
24.1.50; symbol-macrolet regresssion

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 12119 in the body.
You can then email your comments to 12119 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: Helmut Eller <eller.helmut <at> gmail.com>
To: bug-gnu-emacs <at> gnu.org
Subject: 24.1.50; symbol-macrolet regresssion
Date: Thu, 02 Aug 2012 15:13:03 +0200

In Emacs 24, bzr revno 109393, this file

(require 'cl)

(defun foo ()
  (let ((outer '42))
    (symbol-macrolet ((x outer))
      (let ((x 'inner))
	(assert (eq x 'inner))))))

(foo)

when executed with:  emacs -Q -batch -l symbol-macrolet.el 
produces:  Assertion failed: (eq x (quote inner))

With Emacs 22 the assertions doesn't fail.

Also, in Emacs 22 the macroepansion (via cl-macroexpand-all) 
produces something like

(let ((outer '42))
  (let ((outer 'inner))
    (progn
      (or
       (eq outer 'inner)
       (signal 'cl-assertion-failed
               (list
                '(eq x 'inner))))
      nil)))

while in Emacs 24 it looks like 

(let ((outer '42))
  (progn
    (let ((x 'inner))
      (progn
	(or
	 (eq outer 'inner)
	 (signal 'cl-assertion-failed
		 (list
		  '(eq x 'inner))))
	nil))))

Such a change should be documented.



In GNU Emacs 24.1.50.1 (i686-pc-linux-gnu, GTK+ Version 2.20.1)
 of 2012-08-02 on ix
Bzr revision: 109400 eggert <at> cs.ucla.edu-20120802104919-u42w0m8vbqm4p2l4
Windowing system distributor `The X.Org Foundation', version 11.0.10707000
Configured using:
 `configure '--with-jpeg=no' '--with-gif=no' '--with-tiff=no''

Important settings:
  value of $LANG: en_US
  locale-coding-system: iso-latin-1-unix
  default enable-multibyte-characters: nil

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

From: Stefan Monnier <monnier <at> IRO.UMontreal.CA>
To: Helmut Eller <eller.helmut <at> gmail.com>
Cc: 12119 <at> debbugs.gnu.org
Subject: Re: bug#12119: 24.1.50; symbol-macrolet regresssion
Date: Sat, 04 Aug 2012 19:40:46 -0400

> Also, in Emacs 22 the macroepansion (via cl-macroexpand-all) 
> produces something like

> (let ((outer '42))
>   (let ((outer 'inner))
>     (progn
>       (or
>        (eq outer 'inner)
>        (signal 'cl-assertion-failed
>                (list
>                 '(eq x 'inner))))
>       nil)))

While the above expansion returns the right value, it is not correct.
The right expansion would be

   (let ((outer '42))
     (let ((x 'inner))
       (progn
         (or
          (eq x 'inner)
          (signal 'cl-assertion-failed
                  (list
                   '(eq x 'inner))))
         nil)))

> while in Emacs 24 it looks like 

> (let ((outer '42))
>   (progn
>     (let ((x 'inner))
>       (progn
> 	(or
> 	 (eq outer 'inner)
> 	 (signal 'cl-assertion-failed
> 		 (list
> 		  '(eq x 'inner))))
> 	nil))))

> Such a change should be documented.

That's an accident, so it shouldn't be documented.  The new code is no
better than the old one, and arguably slightly worse since it fails in
your test while the old code worked.
I'm not yet sure how we can fix it properly, tho.


        Stefan

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

From: Helmut Eller <eller.helmut <at> gmail.com>
To: Stefan Monnier <monnier <at> IRO.UMontreal.CA>
Cc: 12119 <at> debbugs.gnu.org
Subject: Re: bug#12119: 24.1.50; symbol-macrolet regresssion
Date: Sun, 05 Aug 2012 13:38:45 +0200

On Sun, Aug 05 2012, Stefan Monnier wrote:

>> Also, in Emacs 22 the macroepansion (via cl-macroexpand-all) 
>> produces something like
>
>> (let ((outer '42))
>>   (let ((outer 'inner))
>>     (progn
>>       (or
>>        (eq outer 'inner)
>>        (signal 'cl-assertion-failed
>>                (list
>>                 '(eq x 'inner))))
>>       nil)))
>
> While the above expansion returns the right value, it is not correct.
> The right expansion would be
>
>    (let ((outer '42))
>      (let ((x 'inner))
>        (progn
>          (or
>           (eq x 'inner)
>           (signal 'cl-assertion-failed
>                   (list
>                    '(eq x 'inner))))
>          nil)))
>
>> while in Emacs 24 it looks like 
>
>> (let ((outer '42))
>>   (progn
>>     (let ((x 'inner))
>>       (progn
>> 	(or
>> 	 (eq outer 'inner)
>> 	 (signal 'cl-assertion-failed
>> 		 (list
>> 		  '(eq x 'inner))))
>> 	nil))))
>
>> Such a change should be documented.
>
> That's an accident, so it shouldn't be documented.  The new code is no
> better than the old one, and arguably slightly worse since it fails in
> your test while the old code worked.
> I'm not yet sure how we can fix it properly, tho.

Well, it depends on the definition of "correct".  The old version seems
to do what the documentation says, i.e., let binding the variable is
treated like letf.  What you call "correct" may be closer to what ANSI
CL does, but such a change should be documented.

Either way, I don't see the point in breaking existing code.

Helmut

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

From: Stefan Monnier <monnier <at> IRO.UMontreal.CA>
To: Helmut Eller <eller.helmut <at> gmail.com>
Cc: 12119 <at> debbugs.gnu.org
Subject: Re: bug#12119: 24.1.50; symbol-macrolet regresssion
Date: Mon, 06 Aug 2012 12:20:18 -0400

> Well, it depends on the definition of "correct".  The old version seems
> to do what the documentation says, i.e., let binding the variable is
> treated like letf.  What you call "correct" may be closer to what ANSI
> CL does, but such a change should be documented.

Oh, I missed this "let -> letf" mapping of the old code.  Now it makes
more sense, thank you.  I'll try and reproduce the old behavior then.


        Stefan

Message #19 received at 12119-done <at> debbugs.gnu.org (full text, mbox):

From: Stefan Monnier <monnier <at> IRO.UMontreal.CA>
To: Helmut Eller <eller.helmut <at> gmail.com>
Cc: 12119-done <at> debbugs.gnu.org
Subject: Re: bug#12119: 24.1.50; symbol-macrolet regresssion
Date: Mon, 06 Aug 2012 15:54:47 -0400

> Well, it depends on the definition of "correct".  The old version seems
> to do what the documentation says, i.e., let binding the variable is
> treated like letf.  What you call "correct" may be closer to what ANSI
> CL does, but such a change should be documented.

I've installed a patch which should re-produce the old letf behavior.


        Stefan


=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2012-08-06 07:31:31 +0000
+++ lisp/ChangeLog	2012-08-06 19:51:40 +0000
@@ -1,3 +1,8 @@
+2012-08-06  Stefan Monnier  <monnier <at> iro.umontreal.ca>
+
+	* emacs-lisp/cl-macs.el (cl--sm-macroexpand): Fix handling of
+	re-binding a symbol that has a symbol-macro (bug#12119).
+
 2012-08-06  Mohsen BANAN  <libre <at> mohsen.1.banan.byname.net>
 
 	* language/persian.el: New file.  (Bug#11812)

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- lisp/emacs-lisp/cl-macs.el	2012-07-26 01:27:33 +0000
+++ lisp/emacs-lisp/cl-macs.el	2012-08-06 19:49:54 +0000
@@ -1668,31 +1668,86 @@
       cl--old-macroexpand
     (symbol-function 'macroexpand)))
 
-(defun cl--sm-macroexpand (cl-macro &optional cl-env)
+(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 cl-env))
+  (let ((macroexpand-all-environment env))
     (while
         (progn
-          (setq cl-macro (funcall cl--old-macroexpand cl-macro cl-env))
-          (cond
-           ((symbolp cl-macro)
+          (setq exp (funcall cl--old-macroexpand exp env))
+          (pcase exp
+            ((pred symbolp)
             ;; Perform symbol-macro expansion.
-            (when (cdr (assq (symbol-name cl-macro) cl-env))
-              (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env)))))
-           ((eq 'setq (car-safe cl-macro))
+             (when (cdr (assq (symbol-name exp) env))
+               (setq exp (cadr (assq (symbol-name exp) env)))))
+            (`(setq . ,_)
             ;; Convert setq to setf if required by symbol-macro expansion.
-            (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f cl-env))
-                                 (cdr cl-macro)))
+             (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env))
+                                  (cdr exp)))
                    (p args))
               (while (and p (symbolp (car p))) (setq p (cddr p)))
-              (if p (setq cl-macro (cons 'setf args))
-                (setq cl-macro (cons 'setq args))
+               (if p (setq exp (cons 'setf args))
+                 (setq exp (cons 'setq args))
                 ;; Don't loop further.
-                nil))))))
-    cl-macro))
+                 nil)))
+            (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
+             ;; CL's symbol-macrolet treats re-bindings as candidates for
+             ;; expansion (turning the let into a letf if needed), contrary to
+             ;; Common-Lisp where such re-bindings hide the symbol-macro.
+             (let ((letf nil) (found nil) (nbs ()))
+               (dolist (binding bindings)
+                 (let* ((var (if (symbolp binding) binding (car binding)))
+                        (sm (assq (symbol-name var) env)))
+                   (push (if (not (cdr sm))
+                             binding
+                           (let ((nexp (cadr sm)))
+                             (setq found t)
+                             (unless (symbolp nexp) (setq letf t))
+                             (cons nexp (cdr-safe binding))))
+                         nbs)))
+               (when found
+                 (setq exp `(,(if letf
+                                  (if (eq (car exp) 'let) 'cl-letf 'cl-letf*)
+                                (car exp))
+                             ,(nreverse nbs)
+                             ,@body)))))
+            ;; FIXME: The behavior of CL made sense in a dynamically scoped
+            ;; language, but for lexical scoping, Common-Lisp's behavior might
+            ;; make more sense (and indeed, CL behaves like Common-Lisp w.r.t
+            ;; lexical-let), so maybe we should adjust the behavior based on
+            ;; the use of lexical-binding.
+            ;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
+            ;;  (let ((nbs ()) (found nil))
+            ;;    (dolist (binding bindings)
+            ;;      (let* ((var (if (symbolp binding) binding (car binding)))
+            ;;             (name (symbol-name var))
+            ;;             (val (and found (consp binding) (eq 'let* (car exp))
+            ;;                       (list (macroexpand-all (cadr binding)
+            ;;                                              env)))))
+            ;;        (push (if (assq name env)
+            ;;                  ;; This binding should hide its symbol-macro,
+            ;;                  ;; but given the way macroexpand-all works, we
+            ;;                  ;; can't prevent application of `env' to the
+            ;;                  ;; sub-expressions, so we need to α-rename this
+            ;;                  ;; variable instead.
+            ;;                  (let ((nvar (make-symbol
+            ;;                               (copy-sequence name))))
+            ;;                    (setq found t)
+            ;;                    (push (list name nvar) env)
+            ;;                    (cons nvar (or val (cdr-safe binding))))
+            ;;                (if val (cons var val) binding))
+            ;;              nbs)))
+            ;;    (when found
+            ;;      (setq exp `(,(car exp)
+            ;;                  ,(nreverse nbs)
+            ;;                  ,@(macroexp-unprogn
+            ;;                     (macroexpand-all (macroexp-progn body)
+            ;;                                      env)))))
+            ;;    nil))
+            )))
+    exp))
 
 ;;;###autoload
 (defmacro cl-symbol-macrolet (bindings &rest body)

Previous Next

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