From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.bugs Subject: bug#12119: 24.1.50; symbol-macrolet regresssion Date: Mon, 06 Aug 2012 15:54:47 -0400 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Trace: dough.gmane.org 1344282916 16391 80.91.229.3 (6 Aug 2012 19:55:16 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Mon, 6 Aug 2012 19:55:16 +0000 (UTC) Cc: 12119-done@debbugs.gnu.org To: Helmut Eller Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Mon Aug 06 21:55:16 2012 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1SyTOT-0000kF-Qs for geb-bug-gnu-emacs@m.gmane.org; Mon, 06 Aug 2012 21:55:14 +0200 Original-Received: from localhost ([::1]:51185 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SyTOT-0000ky-1E for geb-bug-gnu-emacs@m.gmane.org; Mon, 06 Aug 2012 15:55:13 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:35071) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SyTOP-0000kd-Od for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 15:55:10 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SyTOO-0002iH-AW for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 15:55:09 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:56732) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SyTOO-0002i0-6n for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 15:55:08 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1SyTW2-00072U-1C for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 16:03:02 -0400 Resent-From: Stefan Monnier Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-To: bug-gnu-emacs@gnu.org Resent-Date: Mon, 06 Aug 2012 20:03:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: cc-closed 12119 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Mail-Followup-To: 12119@debbugs.gnu.org, monnier@IRO.UMontreal.CA Original-Received: via spool by 12119-done@debbugs.gnu.org id=D12119.134428337127039 (code D ref 12119); Mon, 06 Aug 2012 20:03:01 +0000 Original-Received: (at 12119-done) by debbugs.gnu.org; 6 Aug 2012 20:02:51 +0000 Original-Received: from localhost ([127.0.0.1]:38042 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1SyTVq-000722-L5 for submit@debbugs.gnu.org; Mon, 06 Aug 2012 16:02:51 -0400 Original-Received: from chene.dit.umontreal.ca ([132.204.246.20]:40850) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1SyTVo-00071v-3X for 12119-done@debbugs.gnu.org; Mon, 06 Aug 2012 16:02:49 -0400 Original-Received: from faina.iro.umontreal.ca (lechon.iro.umontreal.ca [132.204.27.242]) by chene.dit.umontreal.ca (8.14.1/8.14.1) with ESMTP id q76Jsq3R006286; Mon, 6 Aug 2012 15:54:53 -0400 Original-Received: by faina.iro.umontreal.ca (Postfix, from userid 20848) id 2C9BFB41E3; Mon, 6 Aug 2012 15:54:47 -0400 (EDT) In-Reply-To: (Helmut Eller's message of "Sun, 05 Aug 2012 13:38:45 +0200") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.1.50 (gnu/linux) X-NAI-Spam-Flag: NO X-NAI-Spam-Threshold: 5 X-NAI-Spam-Score: 0 X-NAI-Spam-Rules: 1 Rules triggered RV4302=0 X-NAI-Spam-Version: 2.2.0.9309 : core <4302> : streams <795443> : uri <1185471> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:62881 Archived-At: > 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 =3D=3D=3D 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 + + * 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 =20 * language/persian.el: New file. (Bug#11812) =3D=3D=3D 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))) =20 -(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), contrar= y 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-let= f*) + (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 m= ight + ;; 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-mac= ro, + ;; ;; but given the way macroexpand-all works= , we + ;; ;; can't prevent application of `env' to t= he + ;; ;; sub-expressions, so we need to =CE=B1-r= ename 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)) =20 ;;;###autoload (defmacro cl-symbol-macrolet (bindings &rest body)