Package: emacs;
Reported by: Helmut Eller <eller.helmut <at> gmail.com>
Date: Thu, 2 Aug 2012 13:21:01 UTC
Severity: normal
Found in version 24.1.50
Done: Stefan Monnier <monnier <at> IRO.UMontreal.CA>
Bug is archived. No further changes may be made.
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)
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.