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

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 74a0988c98f064a8a44e4d49fcbc2fb402826516..a2500e3fadc971d4cff859a854670af17e1fb1df 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,7 @@
 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
        (bug#20141).
 

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 4706be5e57c9dce108d3e3e376952212629143aa..0e8a969a4029c3b4caf35ac53335d3b6caf89647 100644 (file)
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -166,23 +166,26 @@ like `(,a . ,(pred (< a))) or, with more checks:
 
 ;;;###autoload
 (defmacro pcase-lambda (lambda-list &rest body)
-  "Like `lambda' but allow each argument to be a pattern.
-`&rest' argument is supported."
+  "Like `lambda' but allow each argument to be a UPattern.
+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)
-           (debug ((&rest pcase-UPAT &optional ["&rest" pcase-UPAT]) body)))
-  (let ((args (make-symbol "args"))
-        (pats (mapcar (lambda (u)
-                        (unless (eq u '&rest)
-                          (if (eq (car-safe u) '\`) (cadr u) (list '\, u))))
-                      lambda-list))
-        (body (macroexp-parse-body body)))
-    ;; Handle &rest
-    (when (eq nil (car (last pats 2)))
-      (setq pats (append (butlast pats 2) (car (last pats)))))
-    `(lambda (&rest ,args)
-       ,@(car body)
-       (pcase ,args
-         (,(list '\` pats) . ,(cdr body))))))
+           (debug ((&rest pcase-UPAT) body)))
+  (let* ((bindings ())
+         (parsed-body (macroexp-parse-body body))
+         (args (mapcar (lambda (pat)
+                         (if (symbolp pat)
+                             ;; Simple vars and &rest/&optional are just passed
+                             ;; through unchanged.
+                             pat
+                           (let ((arg (make-symbol
+                                       (format "arg%s" (length bindings)))))
+                             (push `(,pat ,arg) bindings)
+                             arg)))
+                       lambda-list)))
+    `(lambda ,args ,@(car parsed-body)
+       (pcase-let* ,(nreverse bindings) ,@(cdr parsed-body)))))
 
 (defun pcase--let* (bindings body)
   (cond