From ea3768613f759f3802a9dd9826b238c46b46ce67 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 6 Aug 2012 15:53:45 -0400 Subject: [PATCH] * lisp/emacs-lisp/cl-macs.el (cl--sm-macroexpand): Fix handling of re-binding a symbol that has a symbol-macro. Fixes: debbugs:12119 --- lisp/ChangeLog | 5 ++ lisp/emacs-lisp/cl-macs.el | 93 ++++++++++++++++++++++++++++++-------- 2 files changed, 79 insertions(+), 19 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 72b6db71cfa..23f8b3ec831 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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 * language/persian.el: New file. (Bug#11812) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 00ba6b9e0d0..95aa1f18a0c 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1668,31 +1668,86 @@ This is like `cl-flet', but for macros instead of functions. 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) - ;; 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)) - ;; Convert setq to setf if required by symbol-macro expansion. - (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f cl-env)) - (cdr cl-macro))) - (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)) - ;; Don't loop further. - nil)))))) - cl-macro)) + (setq exp (funcall cl--old-macroexpand exp env)) + (pcase exp + ((pred symbolp) + ;; Perform symbol-macro expansion. + (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 env)) + (cdr exp))) + (p args)) + (while (and p (symbolp (car p))) (setq p (cddr p))) + (if p (setq exp (cons 'setf args)) + (setq exp (cons 'setq args)) + ;; Don't loop further. + 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) -- 2.39.2