diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 27 |
1 files changed, 26 insertions, 1 deletions
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index fbe241b6fc8..2d5f19fe5f7 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -284,7 +284,7 @@ of the form (UPAT EXP)." (main (pcase--u (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))) + (cond + ((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)))) + (t + (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))))))) + +;;;###autoload +(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 |