diff options
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 27 |
2 files changed, 29 insertions, 3 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 606e2430a81..026e84058ef 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2012-06-11 Johan Bockgård <bojohan@gnu.org> | ||
| 2 | |||
| 3 | * emacs-lisp/pcase.el (pcase-UPAT, pcase-QPAT): New edebug specs. | ||
| 4 | (pcase, pcase-let*, pcase-dolist): Use them. | ||
| 5 | |||
| 1 | 2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca> | 6 | 2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 7 | ||
| 3 | * emacs-lisp/pcase.el (pcase--let*): New function. | 8 | * emacs-lisp/pcase.el (pcase--let*): New function. |
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 61c3aef5b21..81cffae04bf 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el | |||
| @@ -66,6 +66,27 @@ | |||
| 66 | 66 | ||
| 67 | (defconst pcase--dontcare-upats '(t _ dontcare)) | 67 | (defconst pcase--dontcare-upats '(t _ dontcare)) |
| 68 | 68 | ||
| 69 | (def-edebug-spec | ||
| 70 | pcase-UPAT | ||
| 71 | (&or symbolp | ||
| 72 | ("or" &rest pcase-UPAT) | ||
| 73 | ("and" &rest pcase-UPAT) | ||
| 74 | ("`" pcase-QPAT) | ||
| 75 | ("guard" form) | ||
| 76 | ("let" pcase-UPAT form) | ||
| 77 | ("pred" | ||
| 78 | &or lambda-expr | ||
| 79 | ;; Punt on macros/special forms. | ||
| 80 | (functionp &rest form) | ||
| 81 | sexp) | ||
| 82 | sexp)) | ||
| 83 | |||
| 84 | (def-edebug-spec | ||
| 85 | pcase-QPAT | ||
| 86 | (&or ("," pcase-UPAT) | ||
| 87 | (pcase-QPAT . pcase-QPAT) | ||
| 88 | sexp)) | ||
| 89 | |||
| 69 | ;;;###autoload | 90 | ;;;###autoload |
| 70 | (defmacro pcase (exp &rest cases) | 91 | (defmacro pcase (exp &rest cases) |
| 71 | "Perform ML-style pattern matching on EXP. | 92 | "Perform ML-style pattern matching on EXP. |
| @@ -98,7 +119,7 @@ PRED patterns can refer to variables bound earlier in the pattern. | |||
| 98 | E.g. you can match pairs where the cdr is larger than the car with a pattern | 119 | E.g. you can match pairs where the cdr is larger than the car with a pattern |
| 99 | like `(,a . ,(pred (< a))) or, with more checks: | 120 | like `(,a . ,(pred (< a))) or, with more checks: |
| 100 | `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))" | 121 | `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))" |
| 101 | (declare (indent 1) (debug cl-case)) ;FIXME: edebug `guard' and vars. | 122 | (declare (indent 1) (debug (form &rest (pcase-UPAT body)))) |
| 102 | ;; We want to use a weak hash table as a cache, but the key will unavoidably | 123 | ;; We want to use a weak hash table as a cache, but the key will unavoidably |
| 103 | ;; be based on `exp' and `cases', yet `cases' is a fresh new list each time | 124 | ;; be based on `exp' and `cases', yet `cases' is a fresh new list each time |
| 104 | ;; we're called so it'll be immediately GC'd. So we use (car cases) as key | 125 | ;; we're called so it'll be immediately GC'd. So we use (car cases) as key |
| @@ -144,7 +165,7 @@ like `(,a . ,(pred (< a))) or, with more checks: | |||
| 144 | BODY should be an expression, and BINDINGS should be a list of bindings | 165 | BODY should be an expression, and BINDINGS should be a list of bindings |
| 145 | of the form (UPAT EXP)." | 166 | of the form (UPAT EXP)." |
| 146 | (declare (indent 1) | 167 | (declare (indent 1) |
| 147 | (debug ((&rest (sexp &optional form)) body))) | 168 | (debug ((&rest (pcase-UPAT &optional form)) body))) |
| 148 | (let ((cached (gethash bindings pcase--memoize))) | 169 | (let ((cached (gethash bindings pcase--memoize))) |
| 149 | ;; cached = (BODY . EXPANSION) | 170 | ;; cached = (BODY . EXPANSION) |
| 150 | (if (equal (car cached) body) | 171 | (if (equal (car cached) body) |
| @@ -174,7 +195,7 @@ of the form (UPAT EXP)." | |||
| 174 | `(let ,(nreverse bindings) (pcase-let* ,matches ,@body))))) | 195 | `(let ,(nreverse bindings) (pcase-let* ,matches ,@body))))) |
| 175 | 196 | ||
| 176 | (defmacro pcase-dolist (spec &rest body) | 197 | (defmacro pcase-dolist (spec &rest body) |
| 177 | (declare (indent 1)) | 198 | (declare (indent 1) (debug ((pcase-UPAT form) body))) |
| 178 | (if (pcase--trivial-upat-p (car spec)) | 199 | (if (pcase--trivial-upat-p (car spec)) |
| 179 | `(dolist ,spec ,@body) | 200 | `(dolist ,spec ,@body) |
| 180 | (let ((tmpvar (make-symbol "x"))) | 201 | (let ((tmpvar (make-symbol "x"))) |