diff options
Diffstat (limited to 'lisp/emacs-lisp/cl-macs.el')
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 71 |
1 files changed, 46 insertions, 25 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c27a43f3baf..accd70dc4ef 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -301,24 +301,31 @@ FORM is of the form (ARGS . BODY)." (t ;; `simple-args' doesn't handle all the parsing that we need, ;; so we pass the rest to cl--do-arglist which will do ;; "manual" parsing. - (let ((slen (length simple-args))) - (when (memq '&optional simple-args) - (cl-decf slen)) - (setq header + (let ((slen (length simple-args)) + (usage-str ;; Macro expansion can take place in the middle of ;; apparently harmless computation, so it should not ;; touch the match-data. (save-match-data - (cons (help-add-fundoc-usage - (if (stringp (car header)) (pop header)) - ;; Be careful with make-symbol and (back)quote, - ;; see bug#12884. - (help--docstring-quote - (let ((print-gensym nil) (print-quoted t) - (print-escape-newlines t)) - (format "%S" (cons 'fn (cl--make-usage-args - orig-args)))))) - header))) + (help--docstring-quote + (let ((print-gensym nil) (print-quoted t) + (print-escape-newlines t)) + (format "%S" (cons 'fn (cl--make-usage-args + orig-args)))))))) + (when (memq '&optional simple-args) + (cl-decf slen)) + (setq header + (cons + (if (eq :documentation (car-safe (car header))) + `(:documentation (help-add-fundoc-usage + ,(cadr (pop header)) + ,usage-str)) + (help-add-fundoc-usage + (if (stringp (car header)) (pop header)) + ;; Be careful with make-symbol and (back)quote, + ;; see bug#12884. + usage-str)) + header)) ;; FIXME: we'd want to choose an arg name for the &rest param ;; and pass that as `expr' to cl--do-arglist, but that ends up ;; generating code with a redundant let-binding, so we instead @@ -2139,9 +2146,14 @@ Like `cl-flet' but the definitions can refer to previous ones. ;; setq the fresh new `ofargs' vars instead ;-) (let ((shadowings (mapcar (lambda (b) (if (consp b) (car b) b)) bindings))) - ;; If `var' is shadowed, then it clearly can't be - ;; tail-called any more. - (not (memq var shadowings))))) + (and + ;; If `var' is shadowed, then it clearly can't be + ;; tail-called any more. + (not (memq var shadowings)) + ;; If any of the new bindings is a dynamic + ;; variable, the body is not in tail position. + (not (delq nil (mapcar #'macroexp--dynamic-variable-p + shadowings))))))) `(,(car exp) ,bindings . ,(funcall opt-exps exps))) ((and `(condition-case ,err-var ,bodyform . ,handlers) (guard (not (eq err-var var)))) @@ -2417,10 +2429,11 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). (append bindings venv)) macroexpand-all-environment)))) (if malformed-bindings - (macroexp-warn-and-return - (format-message "Malformed `cl-symbol-macrolet' binding(s): %S" - (nreverse malformed-bindings)) - expansion) + (let ((rev-malformed-bindings (nreverse malformed-bindings))) + (macroexp-warn-and-return + (format-message "Malformed `cl-symbol-macrolet' binding(s): %S" + rev-malformed-bindings) + expansion nil nil rev-malformed-bindings)) expansion))) (unless advised (advice-remove 'macroexpand #'cl--sm-macroexpand))))) @@ -3050,7 +3063,7 @@ To see the documentation for a defined struct type, use `(,predicate cl-x)))) (when pred-form (push `(,defsym ,predicate (cl-x) - (declare (side-effect-free error-free)) + (declare (side-effect-free error-free) (pure t)) ,(if (eq (car pred-form) 'and) (append pred-form '(t)) `(and ,pred-form t))) @@ -3106,7 +3119,7 @@ To see the documentation for a defined struct type, use (macroexp-warn-and-return (format "Missing value for option `%S' of slot `%s' in struct %s!" (car (last desc)) slot name) - 'nil) + nil nil nil (car (last desc))) forms) (when (and (keywordp (car defaults)) (not (keywordp (car desc)))) @@ -3115,7 +3128,7 @@ To see the documentation for a defined struct type, use (macroexp-warn-and-return (format " I'll take `%s' to be an option rather than a default value." kw) - 'nil) + nil nil nil kw) forms) (push kw desc) (setcar defaults nil)))) @@ -3365,6 +3378,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (integer . integerp) (keyword . keywordp) (list . listp) + (natnum . natnump) (number . numberp) (null . null) (real . numberp) @@ -3475,6 +3489,10 @@ omitted, a default message listing FORM itself is used." ;;; Compiler macros. +(def-edebug-elem-spec 'cl-define-compiler-macro-list + `(([&optional "&whole" arg] + ,@(car (get 'cl-macro-list 'edebug-elem-spec))))) + ;;;###autoload (defmacro cl-define-compiler-macro (func args &rest body) "Define a compiler-only macro. @@ -3487,7 +3505,10 @@ compiler macros are expanded repeatedly until no further expansions are possible. Unlike regular macros, BODY can decide to \"punt\" and leave the original function call alone by declaring an initial `&whole foo' parameter and then returning foo." - (declare (debug cl-defmacro) (indent 2)) + ;; Like `cl-defmacro', but with the `&whole' special case. + (declare (debug (&define name cl-define-compiler-macro-list + cl-declarations-or-string def-body)) + (indent 2)) (let ((p args) (res nil)) (while (consp p) (push (pop p) res)) (setq args (nconc (nreverse res) (and p (list '&rest p))))) |