diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2015-03-17 14:30:42 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2015-03-17 14:30:42 -0400 |
commit | 6f73c465a8990560fedb1c9897c893056b4b04ef (patch) | |
tree | c11bc7dece47cffcc3d76065dcd4db4f07e1e7a4 /lisp/emacs-lisp/cl-macs.el | |
parent | 508049aae95c42a3e6fe989ff403bf7cb6f88433 (diff) | |
download | emacs-6f73c465a8990560fedb1c9897c893056b4b04ef.tar.gz emacs-6f73c465a8990560fedb1c9897c893056b4b04ef.tar.bz2 emacs-6f73c465a8990560fedb1c9897c893056b4b04ef.zip |
* cl-macs.el (cl--transform-lambda): Refine last change.
Fixes: debbugs:20125
* test/automated/cl-lib-tests.el: Use lexical-binding.
(cl-lib-arglist-performance): Refine test to the case where one of the
fields has a non-nil default value. Use existing `mystruct' defstruct.
(cl-lib-struct-accessors): Use `pcase' to be a bit more flexible in the
accepted outputs.
Diffstat (limited to 'lisp/emacs-lisp/cl-macs.el')
-rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 26 |
1 files changed, 15 insertions, 11 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 712a7485167..56fbcf0b2fd 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -257,11 +257,7 @@ FORM is of the form (ARGS . BODY)." (setq cl--bind-defs (cadr cl-defs)) ;; Remove "&cl-defs DEFS" from args. (setcdr cl-defs (cddr cl-defs)) - (setq args (delq '&cl-defs args)) - ;; Optimize away trivial &cl-defs. - (if (and (null (car cl--bind-defs)) - (cl-every (lambda (x) (null (cadr x))) (cdr cl--bind-defs))) - (setq cl--bind-defs nil)))) + (setq args (delq '&cl-defs args)))) (if (setq cl--bind-enquote (memq '&cl-quote args)) (setq args (delq '&cl-quote args))) (if (memq '&whole args) (error "&whole not currently implemented")) @@ -272,11 +268,19 @@ FORM is of the form (ARGS . BODY)." ;; Take away all the simple args whose parsing can be handled more ;; efficiently by a plain old `lambda' than the manual parsing generated ;; by `cl--do-arglist'. - (while (and args (symbolp (car args)) - (not (memq (car args) '(nil &rest &body &key &aux))) - (not (and (eq (car args) '&optional) - (or cl--bind-defs (consp (cadr args)))))) - (push (pop args) simple-args)) + (let ((optional nil)) + (while (and args (symbolp (car args)) + (not (memq (car args) '(nil &rest &body &key &aux))) + (or (not optional) + ;; Optional args whose default is nil are simple. + (null (nth 1 (assq (car args) (cdr cl--bind-defs))))) + (not (and (eq (car args) '&optional) (setq optional t) + (car cl--bind-defs)))) + (push (pop args) simple-args)) + (when optional + (if args (push '&optional args)) + ;; Don't keep a dummy trailing &optional without actual optional args. + (if (eq '&optional (car simple-args)) (pop simple-args)))) (or (eq cl--bind-block 'cl-none) (setq body (list `(cl-block ,cl--bind-block ,@body)))) (let* ((cl--bind-lets nil) (cl--bind-forms nil) @@ -292,7 +296,7 @@ FORM is of the form (ARGS . BODY)." ;; "manual" parsing. (let ((slen (length simple-args))) (when (memq '&optional simple-args) - (push '&optional args) (cl-decf slen)) + (cl-decf slen)) (setq header ;; Macro expansion can take place in the middle of ;; apparently harmless computation, so it should not |