Subject: bug#12119: closed (Re: bug#12119: 24.1.50; symbol-macrolet regresssion)

From: [email-masked] (GNU bug Tracking System)
Date: Mon, 06 Aug 2012 20:03:02 +0000

Your bug report

#12119: 24.1.50; symbol-macrolet regresssion

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
12119: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=12119
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#12119: 24.1.50; symbol-macrolet regresssion
From: Stefan Monnier <[email-masked]>
To: Helmut Eller <[email-masked]>
Cc: [email-masked]
Date: Mon, 06 Aug 2012 15:54:47 -0400
List-Id: <debbugs-submit.debbugs.gnu.org>

> 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  <[email-masked]>
+
+	* 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  <[email-masked]>
 
 	* 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)

Subject: 24.1.50; symbol-macrolet regresssion
From: Helmut Eller <[email-masked]>
To: [email-masked]
Date: Thu, 02 Aug 2012 15:13:03 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

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 [email-masked]
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