Commit 751adc4b authored by Leo Liu's avatar Leo Liu
Browse files

Add macro pcase-lambda

Fixes: debbugs:19814

* emacs-lisp/lisp-mode.el (el-kws-re): Include `pcase-lambda'.

* emacs-lisp/macroexp.el (macroexp-parse-body): New function.

* emacs-lisp/pcase.el (pcase-lambda): New Macro.
parent fd6f7d14
2015-02-09 Leo Liu <>
* emacs-lisp/pcase.el (pcase-lambda): New Macro. (Bug#19814)
* emacs-lisp/lisp-mode.el (el-kws-re): Include `pcase-lambda'.
* emacs-lisp/macroexp.el (macroexp-parse-body): New function.
2015-02-08 Paul Eggert <>
Port to platforms lacking test -a and -o
......@@ -204,7 +204,7 @@
(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"
......@@ -297,6 +297,16 @@ definitions to shadow the loaded ones for use in file byte-compilation."
;;; Handy functions to use in macros.
(defun macroexp-parse-body (exps)
`((,(and (stringp (car exps))
(pop exps))
,(and (eq (car-safe (car exps)) 'declare)
(pop exps))
,(and (eq (car-safe (car exps)) 'interactive)
(pop exps)))
(defun macroexp-progn (exps)
"Return an expression equivalent to `(progn ,@EXPS)."
(if (cdr exps) `(progn ,@exps) (car exps)))
......@@ -164,6 +164,26 @@ like `(,a . ,(pred (< a))) or, with more checks:
;; FIXME: Could we add the FILE:LINE data in the error message?
exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
(defmacro pcase-lambda (lambda-list &rest body)
"Like `lambda' but allow each argument to be a pattern.
`&rest' argument is supported."
(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))))
(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 (car body))
(pcase ,args
(,(list '\` pats) . ,(cdr body))))))
(defun pcase--let* (bindings body)
((null bindings) (macroexp-progn body))
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