Commit 536cda1f authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/emacs-lisp/pcase.el (pcase-defmacro): New macro.

(pcase--macroexpand): New function.
(pcase--expand): Use it.
parent 13b1840d
......@@ -104,6 +104,7 @@ performance improvements when pasting large amounts of text.
** pcase
*** New UPatterns `quote' and `app'.
*** New UPatterns can be defined with `pcase-defmacro'.
** Lisp mode
*** Strings after `:documentation' are highlighted as docstrings.
2014-09-22 Stefan Monnier <>
* emacs-lisp/pcase.el (pcase-defmacro): New macro.
(pcase--macroexpand): New function.
(pcase--expand): Use it.
Add support for `quote' and `app'.
* emacs-lisp/pcase.el (pcase--app-subst-match, pcase--app-subst-rest):
New optimization functions.
......@@ -284,7 +284,7 @@ of the form (UPAT EXP)."
(mapcar (lambda (case)
`((match ,val . ,(car case))
`((match ,val . ,(pcase--macroexpand (car case)))
,(lambda (vars)
(unless (memq case used-cases)
;; Keep track of the cases that are used.
......@@ -303,6 +303,31 @@ of the form (UPAT EXP)."
(message "Redundant pcase pattern: %S" (car case))))
(macroexp-let* defs main))))
(defun pcase--macroexpand (pat)
"Expands all macro-patterns in PAT."
(let ((head (car-safe pat)))
((memq head '(nil pred guard quote)) pat)
((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat))))
((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
(let* ((expander (get head 'pcase-macroexpander))
(npat (if expander (apply expander (cdr pat)))))
(if (null npat)
(error (if expander
"Unexpandable %s pattern: %S"
"Unknown %s pattern: %S")
head pat)
(pcase--macroexpand npat)))))))
(defmacro pcase-defmacro (name args &rest body)
"Define a pcase UPattern macro."
(declare (indent 2) (debug (def-name sexp def-body)) (doc-string 3))
`(put ',name 'pcase-macroexpander
(lambda ,args ,@body)))
(defun pcase-codegen (code vars)
;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding
;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
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