1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-22 21:50:45 -08:00

Fix bug in generator function with pcase (Bug#26068)

* lisp/emacs-lisp/cl-macs.el (cl--sm-macroexpand): Remove some calls
to symbol-name.
This commit is contained in:
Paul Pogonyshev 2017-03-12 09:51:23 +01:00 committed by Mark Oteiza
parent d602785139
commit 0d112c00ba

View file

@ -2059,8 +2059,8 @@ except that it additionally expands symbol macros."
(pcase exp (pcase exp
((pred symbolp) ((pred symbolp)
;; Perform symbol-macro expansion. ;; Perform symbol-macro expansion.
(when (cdr (assq (symbol-name exp) env)) (when (cdr (assq exp env))
(setq exp (cadr (assq (symbol-name exp) env))))) (setq exp (cadr (assq exp env)))))
(`(setq . ,_) (`(setq . ,_)
;; Convert setq to setf if required by symbol-macro expansion. ;; Convert setq to setf if required by symbol-macro expansion.
(let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env)) (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env))
@ -2078,7 +2078,7 @@ except that it additionally expands symbol macros."
(let ((letf nil) (found nil) (nbs ())) (let ((letf nil) (found nil) (nbs ()))
(dolist (binding bindings) (dolist (binding bindings)
(let* ((var (if (symbolp binding) binding (car binding))) (let* ((var (if (symbolp binding) binding (car binding)))
(sm (assq (symbol-name var) env))) (sm (assq var env)))
(push (if (not (cdr sm)) (push (if (not (cdr sm))
binding binding
(let ((nexp (cadr sm))) (let ((nexp (cadr sm)))
@ -2149,7 +2149,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
(let ((expansion (let ((expansion
;; FIXME: For N bindings, this will traverse `body' N times! ;; FIXME: For N bindings, this will traverse `body' N times!
(macroexpand-all (macroexp-progn body) (macroexpand-all (macroexp-progn body)
(cons (list (symbol-name (caar bindings)) (cons (list (caar bindings)
(cl-cadar bindings)) (cl-cadar bindings))
macroexpand-all-environment)))) macroexpand-all-environment))))
(if (or (null (cdar bindings)) (cl-cddar bindings)) (if (or (null (cdar bindings)) (cl-cddar bindings))