--- Begin Message ---
|
Subject: |
24.4; pcase-lambda |
|
Date: |
Sun, 08 Feb 2015 17:01:00 +0800 |
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))
--- End Message ---