From e846bbf360d1bcee3a35dd05a57bc76cbb22a6f0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 22 Feb 2015 23:50:03 -0500 Subject: [PATCH] * lisp/emacs-lisp/macroexp.el (macroexp-parse-body): Handle cl-declare and :documentation. Change return value format accordingly. * lisp/emacs-lisp/cl-generic.el (cl--generic-lambda): * lisp/emacs-lisp/pcase.el (pcase-lambda): Adjust accordingly. * lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): Use macroexp-parse-body. --- lisp/ChangeLog | 8 ++++++++ lisp/emacs-lisp/cl-generic.el | 2 +- lisp/emacs-lisp/cl-macs.el | 35 ++++++++++++++++------------------- lisp/emacs-lisp/macroexp.el | 19 ++++++++++--------- lisp/emacs-lisp/pcase.el | 2 +- 5 files changed, 36 insertions(+), 30 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ced342baeb9..6352d77ca3a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2015-02-23 Stefan Monnier + + * emacs-lisp/macroexp.el (macroexp-parse-body): Handle cl-declare + and :documentation. Change return value format accordingly. + * emacs-lisp/cl-generic.el (cl--generic-lambda): + * emacs-lisp/pcase.el (pcase-lambda): Adjust accordingly. + * emacs-lisp/cl-macs.el (cl--transform-lambda): Use macroexp-parse-body. + 2015-02-23 Dmitry Gutov Introduce `xref-etags-mode'. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index ccd5bec5685..99924ba288f 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -278,7 +278,7 @@ This macro can only be used within the lexical scope of a cl-generic method." (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody))) (cons (not (not uses-cnm)) `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) - ,@(delq nil (car parsed-body)) + ,@(car parsed-body) ,(if (not (memq nmp uses-cnm)) nbody `(let ((,nmp (lambda () diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c5f49b0ed91..c3da091fb00 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -234,10 +234,9 @@ FORM is of the form (ARGS . BODY)." (let* ((args (car form)) (body (cdr form)) (orig-args args) (cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil) (cl--bind-lets nil) (cl--bind-forms nil) - (header nil) (simple-args nil)) - (while (or (stringp (car body)) - (memq (car-safe (car body)) '(interactive declare cl-declare))) - (push (pop body) header)) + (parsed-body (macroexp-parse-body body)) + (header (car parsed-body)) (simple-args nil)) + (setq body (cdr parsed-body)) (setq args (if (listp args) (cl-copy-list args) (list '&rest args))) (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) (if (setq cl--bind-defs (cadr (memq '&cl-defs args))) @@ -258,7 +257,7 @@ FORM is of the form (ARGS . BODY)." (or (eq cl--bind-block 'cl-none) (setq body (list `(cl-block ,cl--bind-block ,@body)))) (if (null args) - (cl-list* nil (nreverse simple-args) (nconc (nreverse header) body)) + (cl-list* nil (nreverse simple-args) (nconc header body)) (if (memq '&optional simple-args) (push '&optional args)) (cl--do-arglist args nil (- (length simple-args) (if (memq '&optional simple-args) 1 0))) @@ -266,20 +265,18 @@ FORM is of the form (ARGS . BODY)." (cl-list* nil (nconc (nreverse simple-args) (list '&rest (car (pop cl--bind-lets)))) - (nconc (let ((hdr (nreverse header))) - ;; Macro expansion can take place in the middle of - ;; apparently harmless computation, so it should not - ;; touch the match-data. - (save-match-data - (require 'help-fns) - (cons (help-add-fundoc-usage - (if (stringp (car hdr)) (pop hdr)) - ;; Be careful with make-symbol and (back)quote, - ;; see bug#12884. - (let ((print-gensym nil) (print-quoted t)) - (format "%S" (cons 'fn (cl--make-usage-args - orig-args))))) - hdr))) + (nconc (save-match-data ;; Macro expansion can take place in the + ;; middle of apparently harmless computation, so it + ;; should not touch the match-data. + (require 'help-fns) + (cons (help-add-fundoc-usage + (if (stringp (car header)) (pop header)) + ;; Be careful with make-symbol and (back)quote, + ;; see bug#12884. + (let ((print-gensym nil) (print-quoted t)) + (format "%S" (cons 'fn (cl--make-usage-args + orig-args))))) + header)) (list `(let* ,cl--bind-lets ,@(nreverse cl--bind-forms) ,@body))))))) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index b75c8cc50a7..68bf4f62c34 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -297,15 +297,16 @@ definitions to shadow the loaded ones for use in file byte-compilation." ;;; Handy functions to use in macros. -(defun macroexp-parse-body (exps) - "Parse EXPS into ((DOC DECLARE-FORM INTERACTIVE-FORM) . BODY)." - `((,(and (stringp (car exps)) - (pop exps)) - ,(and (eq (car-safe (car exps)) 'declare) - (pop exps)) - ,(and (eq (car-safe (car exps)) 'interactive) - (pop exps))) - ,@exps)) +(defun macroexp-parse-body (body) + "Parse a function BODY into (DECLARATIONS . EXPS)." + (let ((decls ())) + (while (and (cdr body) + (let ((e (car body))) + (or (stringp e) + (memq (car-safe e) + '(:documentation declare interactive cl-declare))))) + (push (pop body) decls)) + (cons (nreverse decls) body))) (defun macroexp-progn (exps) "Return an expression equivalent to `(progn ,@EXPS)." diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 057b12894f9..4706be5e57c 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -180,7 +180,7 @@ like `(,a . ,(pred (< a))) or, with more checks: (when (eq nil (car (last pats 2))) (setq pats (append (butlast pats 2) (car (last pats))))) `(lambda (&rest ,args) - ,@(remq nil (car body)) + ,@(car body) (pcase ,args (,(list '\` pats) . ,(cdr body)))))) -- 2.11.4.GIT