mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-16 09:50:25 +00:00
Code Issues Releases Activity

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

Browse Source 
(pcase--macroexpand): New function.
(pcase--expand): Use it.
This commit is contained in:
Stefan Monnier 2014-09-22 11:04:12 -04:00
parent 13b1840d23
commit 536cda1f84
3 changed files with 31 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
etc/NEWS
View File

@ -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.

4
lisp/ChangeLog
View File

@ -1,5 +1,9 @@
2014-09-22 Stefan Monnier <monnier@iro.umontreal.ca>
* 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.

27
lisp/emacs-lisp/pcase.el
View File

@ -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