Commit 8aa13d07 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/emacs-lisp/pcase.el (pcase-lambda): Rewrite.

parent 29f7f98b
2015-03-19 Stefan Monnier <monnier@iro.umontreal.ca> 2015-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
   
* emacs-lisp/pcase.el (pcase-lambda): Rewrite.
* emacs-lisp/eieio.el (object-slots): Return slot names as before * emacs-lisp/eieio.el (object-slots): Return slot names as before
(bug#20141). (bug#20141).
   
......
...@@ -166,23 +166,26 @@ like `(,a . ,(pred (< a))) or, with more checks: ...@@ -166,23 +166,26 @@ like `(,a . ,(pred (< a))) or, with more checks:
;;;###autoload ;;;###autoload
(defmacro pcase-lambda (lambda-list &rest body) (defmacro pcase-lambda (lambda-list &rest body)
"Like `lambda' but allow each argument to be a pattern. "Like `lambda' but allow each argument to be a UPattern.
`&rest' argument is supported." I.e. accepts the usual &optional and &rest keywords, but every
formal argument can be any pattern accepted by `pcase' (a mere
variable name being but a special case of it)."
(declare (doc-string 2) (indent defun) (declare (doc-string 2) (indent defun)
(debug ((&rest pcase-UPAT &optional ["&rest" pcase-UPAT]) body))) (debug ((&rest pcase-UPAT) body)))
(let ((args (make-symbol "args")) (let* ((bindings ())
(pats (mapcar (lambda (u) (parsed-body (macroexp-parse-body body))
(unless (eq u '&rest) (args (mapcar (lambda (pat)
(if (eq (car-safe u) '\`) (cadr u) (list '\, u)))) (if (symbolp pat)
lambda-list)) ;; Simple vars and &rest/&optional are just passed
(body (macroexp-parse-body body))) ;; through unchanged.
;; Handle &rest pat
(when (eq nil (car (last pats 2))) (let ((arg (make-symbol
(setq pats (append (butlast pats 2) (car (last pats))))) (format "arg%s" (length bindings)))))
`(lambda (&rest ,args) (push `(,pat ,arg) bindings)
,@(car body) arg)))
(pcase ,args lambda-list)))
(,(list '\` pats) . ,(cdr body)))))) `(lambda ,args ,@(car parsed-body)
(pcase-let* ,(nreverse bindings) ,@(cdr parsed-body)))))
(defun pcase--let* (bindings body) (defun pcase--let* (bindings body)
(cond (cond
......
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