aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJohan Bockgård2012-06-10 20:46:21 -0400
committerStefan Monnier2012-06-10 20:46:21 -0400
commita4712e11fe2e59c206406ba6bf600e8a3b5ca2fc (patch)
tree0078ad2b3a118e3ba9ea5186417e747ac3be1f98
parent82ad98e37d6b8ee164446b5229583a3064d58fa7 (diff)
downloademacs-a4712e11fe2e59c206406ba6bf600e8a3b5ca2fc.tar.gz
emacs-a4712e11fe2e59c206406ba6bf600e8a3b5ca2fc.zip
* lisp/emacs-lisp/pcase.el (pcase-UPAT, pcase-QPAT): New edebug specs.
(pcase, pcase-let*, pcase-dolist): Use them.
-rw-r--r--lisp/ChangeLog5
-rw-r--r--lisp/emacs-lisp/pcase.el27
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 @@
12012-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
12012-06-11 Stefan Monnier <monnier@iro.umontreal.ca> 62012-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.
98E.g. you can match pairs where the cdr is larger than the car with a pattern 119E.g. you can match pairs where the cdr is larger than the car with a pattern
99like `(,a . ,(pred (< a))) or, with more checks: 120like `(,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:
144BODY should be an expression, and BINDINGS should be a list of bindings 165BODY should be an expression, and BINDINGS should be a list of bindings
145of the form (UPAT EXP)." 166of 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")))