bug#19814: 24.4; pcase-lambda

[Leo Liu]

The attached patch intends to implement pcase-lambda with lambda-list
being a list of positional UPatterns. &rest is supported. Comments?

diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 868a9578..5d912097 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -204,7 +204,7 @@ (pcase-let
                           "defface"))
               (el-tdefs '("defgroup" "deftheme"))
               (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
-                       "pcase-let" "pcase-let*" "save-restriction"
+                       "pcase-lambda" "pcase-let" "pcase-let*" 
"save-restriction"
                        "save-excursion" "save-selected-window"
                        ;; "eval-after-load" "eval-next-after-load"
                        "save-window-excursion" "save-current-buffer"
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 797de9ab..8fe156c4 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -297,6 +297,16 @@ (defun macroexpand-all (form &optional environment)
 
 ;;; 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-progn (exps)
   "Return an expression equivalent to `(progn ,@EXPS)."
   (if (cdr exps) `(progn ,@exps) (car exps)))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index b495793b..0c71451b 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -164,6 +164,23 @@ (defmacro pcase-exhaustive (exp &rest cases)
      ;; FIXME: Could we add the FILE:LINE data in the error message?
      exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
 
+;;;###autoload
+(defmacro pcase-lambda (lambda-list &rest body)
+  (declare (doc-string 2) (indent defun))
+  (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)
+       ,@(remq nil (list (nth 0 body) (nth 1 body) (nth 2 body)))
+       (pcase ,args
+         (,(list '\` pats) . ,(nthcdr 3 body))))))
+
 (defun pcase--let* (bindings body)
   (cond
    ((null bindings) (macroexp-progn body))