Commit e846bbf3 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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.
parent 3f006e1d
2015-02-23 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <dgutov@yandex.ru>
 
Introduce `xref-etags-mode'.
......
......@@ -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 ()
......
......@@ -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)))))))
......
......@@ -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)."
......
......@@ -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))))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment