Mercurial > emacs
annotate lisp/emacs-lisp/pcase.el @ 111706:aa78024b0867
shr.el (shr-get-background): Fix argument name.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Thu, 25 Nov 2010 01:13:37 +0000 |
parents | 31c8556ccad8 |
children | 6378d1b57038 |
rev | line source |
---|---|
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
1 ;;; pcase.el --- ML-style pattern-matching macro for Elisp |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
2 |
109743
d40bac543314
* lisp/emacs-lisp/pcase.el: Fix copyright header.
Glenn Morris <rgm@gnu.org>
parents:
109739
diff
changeset
|
3 ;; Copyright (C) 2010 Free Software Foundation, Inc. |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
4 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
6 ;; Keywords: |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
7 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
8 ;; This file is part of GNU Emacs. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
9 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
11 ;; it under the terms of the GNU General Public License as published by |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
12 ;; the Free Software Foundation, either version 3 of the License, or |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
13 ;; (at your option) any later version. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
14 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
15 ;; GNU Emacs is distributed in the hope that it will be useful, |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
18 ;; GNU General Public License for more details. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
19 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
20 ;; You should have received a copy of the GNU General Public License |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
22 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
23 ;;; Commentary: |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
24 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
25 ;; ML-style pattern matching. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
26 ;; The entry points are autoloaded. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
27 |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
28 ;; Todo: |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
29 |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
30 ;; - provide ways to extend the set of primitives, with some kind of |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
31 ;; define-pcase-matcher. We could easily make it so that (guard BOOLEXP) |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
32 ;; could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)). |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
33 ;; But better would be if we could define new ways to match by having the |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
34 ;; extension provide its own `pcase--split-<foo>' thingy. |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
35 ;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
36 ;; generate a lex-style DFA to decide whether to run E1 or E2. |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
37 |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
38 ;;; Code: |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
39 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
40 (eval-when-compile (require 'cl)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
41 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
42 ;; Macro-expansion of pcase is reasonably fast, so it's not a problem |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
43 ;; when byte-compiling a file, but when interpreting the code, if the pcase |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
44 ;; is in a loop, the repeated macro-expansion becomes terribly costly, so we |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
45 ;; memoize previous macro expansions to try and avoid recomputing them |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
46 ;; over and over again. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
47 (defconst pcase-memoize (make-hash-table :weakness t :test 'equal)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
48 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
49 (defconst pcase--dontcare-upats '(t _ dontcare)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
50 |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
51 ;;;###autoload |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
52 (defmacro pcase (exp &rest cases) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
53 "Perform ML-style pattern matching on EXP. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
54 CASES is a list of elements of the form (UPATTERN CODE...). |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
55 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
56 UPatterns can take the following forms: |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
57 _ matches anything. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
58 SYMBOL matches anything and binds it to SYMBOL. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
59 (or UPAT...) matches if any of the patterns matches. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
60 (and UPAT...) matches if all the patterns match. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
61 `QPAT matches if the QPattern QPAT matches. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
62 (pred PRED) matches if PRED applied to the object returns non-nil. |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
63 (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
64 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
65 QPatterns can take the following forms: |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
66 (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
67 ,UPAT matches if the UPattern UPAT matches. |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
68 STRING matches if the object is `equal' to STRING. |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
69 ATOM matches if the object is `eq' to ATOM. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
70 QPatterns for vectors are not implemented yet. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
71 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
72 PRED can take the form |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
73 FUNCTION in which case it gets called with one argument. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
74 (FUN ARG1 .. ARGN) in which case it gets called with N+1 arguments. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
75 A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION). |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
76 PRED patterns can refer to variables bound earlier in the pattern. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
77 E.g. you can match pairs where the cdr is larger than the car with a pattern |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
78 like `(,a . ,(pred (< a))) or, with more checks: |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
79 `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))" |
111502
df6573cbdd34
* lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Add debug and
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111221
diff
changeset
|
80 (declare (indent 1) (debug case)) ;FIXME: edebug `guard' and vars. |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
81 (or (gethash (cons exp cases) pcase-memoize) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
82 (puthash (cons exp cases) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
83 (pcase--expand exp cases) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
84 pcase-memoize))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
85 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
86 ;;;###autoload |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
87 (defmacro pcase-let* (bindings &rest body) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
88 "Like `let*' but where you can use `pcase' patterns for bindings. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
89 BODY should be an expression, and BINDINGS should be a list of bindings |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
90 of the form (UPAT EXP)." |
111502
df6573cbdd34
* lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Add debug and
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111221
diff
changeset
|
91 (declare (indent 1) (debug let)) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
92 (cond |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
93 ((null bindings) (if (> (length body) 1) `(progn ,@body) (car body))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
94 ((pcase--trivial-upat-p (caar bindings)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
95 `(let (,(car bindings)) (pcase-let* ,(cdr bindings) ,@body))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
96 (t |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
97 `(pcase ,(cadr (car bindings)) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
98 (,(caar bindings) (pcase-let* ,(cdr bindings) ,@body)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
99 ;; We can either signal an error here, or just use `dontcare' which |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
100 ;; generates more efficient code. In practice, if we use `dontcare' we |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
101 ;; will still often get an error and the few cases where we don't do not |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
102 ;; matter that much, so it's a better choice. |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
103 (dontcare nil))))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
104 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
105 ;;;###autoload |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
106 (defmacro pcase-let (bindings &rest body) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
107 "Like `let' but where you can use `pcase' patterns for bindings. |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
108 BODY should be a list of expressions, and BINDINGS should be a list of bindings |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
109 of the form (UPAT EXP)." |
111502
df6573cbdd34
* lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Add debug and
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111221
diff
changeset
|
110 (declare (indent 1) (debug let)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
111 (if (null (cdr bindings)) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
112 `(pcase-let* ,bindings ,@body) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
113 (let ((matches '())) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
114 (dolist (binding (prog1 bindings (setq bindings nil))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
115 (cond |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
116 ((memq (car binding) pcase--dontcare-upats) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
117 (push (cons (make-symbol "_") (cdr binding)) bindings)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
118 ((pcase--trivial-upat-p (car binding)) (push binding bindings)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
119 (t |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
120 (let ((tmpvar (make-symbol (format "x%d" (length bindings))))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
121 (push (cons tmpvar (cdr binding)) bindings) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
122 (push (list (car binding) tmpvar) matches))))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
123 `(let ,(nreverse bindings) (pcase-let* ,matches ,@body))))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
124 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
125 (defmacro pcase-dolist (spec &rest body) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
126 (if (pcase--trivial-upat-p (car spec)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
127 `(dolist ,spec ,@body) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
128 (let ((tmpvar (make-symbol "x"))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
129 `(dolist (,tmpvar ,@(cdr spec)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
130 (pcase-let* ((,(car spec) ,tmpvar)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
131 ,@body))))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
132 |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
133 |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
134 (defun pcase--trivial-upat-p (upat) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
135 (and (symbolp upat) (not (memq upat pcase--dontcare-upats)))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
136 |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
137 (defun pcase--expand (exp cases) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
138 (let* ((defs (if (symbolp exp) '() |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
139 (let ((sym (make-symbol "x"))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
140 (prog1 `((,sym ,exp)) (setq exp sym))))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
141 (seen '()) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
142 (codegen |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
143 (lambda (code vars) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
144 (let ((prev (assq code seen))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
145 (if (not prev) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
146 (let ((res (pcase-codegen code vars))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
147 (push (list code vars res) seen) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
148 res) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
149 ;; Since we use a tree-based pattern matching |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
150 ;; technique, the leaves (the places that contain the |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
151 ;; code to run once a pattern is matched) can get |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
152 ;; copied a very large number of times, so to avoid |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
153 ;; code explosion, we need to keep track of how many |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
154 ;; times we've used each leaf and move it |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
155 ;; to a separate function if that number is too high. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
156 ;; |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
157 ;; We've already used this branch. So it is shared. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
158 (destructuring-bind (code prevvars res) prev |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
159 (unless (symbolp res) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
160 ;; This is the first repeat, so we have to move |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
161 ;; the branch to a separate function. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
162 (let ((bsym |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
163 (make-symbol (format "pcase-%d" (length defs))))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
164 (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) defs) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
165 (setcar res 'funcall) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
166 (setcdr res (cons bsym (mapcar #'cdr prevvars))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
167 (setcar (cddr prev) bsym) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
168 (setq res bsym))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
169 (setq vars (copy-sequence vars)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
170 (let ((args (mapcar (lambda (pa) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
171 (let ((v (assq (car pa) vars))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
172 (setq vars (delq v vars)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
173 (cdr v))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
174 prevvars))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
175 (when vars ;New additional vars. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
176 (error "The vars %s are only bound in some paths" |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
177 (mapcar #'car vars))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
178 `(funcall ,res ,@args))))))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
179 (main |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
180 (pcase--u |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
181 (mapcar (lambda (case) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
182 `((match ,exp . ,(car case)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
183 ,(apply-partially |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
184 (if (pcase--small-branch-p (cdr case)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
185 ;; Don't bother sharing multiple |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
186 ;; occurrences of this leaf since it's small. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
187 #'pcase-codegen codegen) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
188 (cdr case)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
189 cases)))) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
190 (if (null defs) main |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
191 `(let ,defs ,main)))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
192 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
193 (defun pcase-codegen (code vars) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
194 `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
195 ,@code)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
196 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
197 (defun pcase--small-branch-p (code) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
198 (and (= 1 (length code)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
199 (or (not (consp (car code))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
200 (let ((small t)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
201 (dolist (e (car code)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
202 (if (consp e) (setq small nil))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
203 small)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
204 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
205 ;; Try to use `cond' rather than a sequence of `if's, so as to reduce |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
206 ;; the depth of the generated tree. |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
207 (defun pcase--if (test then else) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
208 (cond |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
209 ((eq else :pcase--dontcare) then) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
210 ((eq (car-safe else) 'if) |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
211 (if (equal test (nth 1 else)) |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
212 ;; Doing a test a second time: get rid of the redundancy. |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
213 ;; FIXME: ideally, this should never happen because the pcase--split-* |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
214 ;; funs should have eliminated such things, but pcase--split-member |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
215 ;; is imprecise, so in practice it can happen occasionally. |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
216 `(if ,test ,then ,@(nthcdr 3 else)) |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
217 `(cond (,test ,then) |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
218 (,(nth 1 else) ,(nth 2 else)) |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
219 (t ,@(nthcdr 3 else))))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
220 ((eq (car-safe else) 'cond) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
221 `(cond (,test ,then) |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
222 ;; Doing a test a second time: get rid of the redundancy, as above. |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
223 ,@(remove (assoc test else) (cdr else)))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
224 (t `(if ,test ,then ,else)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
225 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
226 (defun pcase--upat (qpattern) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
227 (cond |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
228 ((eq (car-safe qpattern) '\,) (cadr qpattern)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
229 (t (list '\` qpattern)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
230 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
231 ;; Note about MATCH: |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
232 ;; When we have patterns like `(PAT1 . PAT2), after performing the `consp' |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
233 ;; check, we want to turn all the similar patterns into ones of the form |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
234 ;; (and (match car PAT1) (match cdr PAT2)), so you naturally need conjunction. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
235 ;; Earlier code hence used branches of the form (MATCHES . CODE) where |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
236 ;; MATCHES was a list (implicitly a conjunction) of (SYM . PAT). |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
237 ;; But if we have a pattern of the form (or `(PAT1 . PAT2) PAT3), there is |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
238 ;; no easy way to eliminate the `consp' check in such a representation. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
239 ;; So we replaced the MATCHES by the MATCH below which can be made up |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
240 ;; of conjunctions and disjunctions, so if we know `foo' is a cons, we can |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
241 ;; turn (match foo . (or `(PAT1 . PAT2) PAT3)) into |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
242 ;; (or (and (match car . `PAT1) (match cdr . `PAT2)) (match foo . PAT3)). |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
243 ;; The downside is that we now have `or' and `and' both in MATCH and |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
244 ;; in PAT, so there are different equivalent representations and we |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
245 ;; need to handle them all. We do not try to systematically |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
246 ;; canonicalize them to one form over another, but we do occasionally |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
247 ;; turn one into the other. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
248 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
249 (defun pcase--u (branches) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
250 "Expand matcher for rules BRANCHES. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
251 Each BRANCH has the form (MATCH CODE . VARS) where |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
252 CODE is the code generator for that branch. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
253 VARS is the set of vars already bound by earlier matches. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
254 MATCH is the pattern that needs to be matched, of the form: |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
255 (match VAR . UPAT) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
256 (and MATCH ...) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
257 (or MATCH ...)" |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
258 (when (setq branches (delq nil branches)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
259 (destructuring-bind (match code &rest vars) (car branches) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
260 (pcase--u1 (list match) code vars (cdr branches))))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
261 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
262 (defun pcase--and (match matches) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
263 (if matches `(and ,match ,@matches) match)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
264 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
265 (defun pcase--split-match (sym splitter match) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
266 (case (car match) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
267 ((match) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
268 (if (not (eq sym (cadr match))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
269 (cons match match) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
270 (let ((pat (cddr match))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
271 (cond |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
272 ;; Hoist `or' and `and' patterns to `or' and `and' matches. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
273 ((memq (car-safe pat) '(or and)) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
274 (pcase--split-match sym splitter |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
275 (cons (car pat) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
276 (mapcar (lambda (alt) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
277 `(match ,sym . ,alt)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
278 (cdr pat))))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
279 (t (let ((res (funcall splitter (cddr match)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
280 (cons (or (car res) match) (or (cdr res) match)))))))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
281 ((or and) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
282 (let ((then-alts '()) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
283 (else-alts '()) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
284 (neutral-elem (if (eq 'or (car match)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
285 :pcase--fail :pcase--succeed)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
286 (zero-elem (if (eq 'or (car match)) :pcase--succeed :pcase--fail))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
287 (dolist (alt (cdr match)) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
288 (let ((split (pcase--split-match sym splitter alt))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
289 (unless (eq (car split) neutral-elem) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
290 (push (car split) then-alts)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
291 (unless (eq (cdr split) neutral-elem) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
292 (push (cdr split) else-alts)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
293 (cons (cond ((memq zero-elem then-alts) zero-elem) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
294 ((null then-alts) neutral-elem) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
295 ((null (cdr then-alts)) (car then-alts)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
296 (t (cons (car match) (nreverse then-alts)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
297 (cond ((memq zero-elem else-alts) zero-elem) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
298 ((null else-alts) neutral-elem) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
299 ((null (cdr else-alts)) (car else-alts)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
300 (t (cons (car match) (nreverse else-alts))))))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
301 (t (error "Uknown MATCH %s" match)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
302 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
303 (defun pcase--split-rest (sym splitter rest) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
304 (let ((then-rest '()) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
305 (else-rest '())) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
306 (dolist (branch rest) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
307 (let* ((match (car branch)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
308 (code&vars (cdr branch)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
309 (splitted |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
310 (pcase--split-match sym splitter match))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
311 (unless (eq (car splitted) :pcase--fail) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
312 (push (cons (car splitted) code&vars) then-rest)) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
313 (unless (eq (cdr splitted) :pcase--fail) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
314 (push (cons (cdr splitted) code&vars) else-rest)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
315 (cons (nreverse then-rest) (nreverse else-rest)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
316 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
317 (defun pcase--split-consp (syma symd pat) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
318 (cond |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
319 ;; A QPattern for a cons, can only go the `then' side. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
320 ((and (eq (car-safe pat) '\`) (consp (cadr pat))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
321 (let ((qpat (cadr pat))) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
322 (cons `(and (match ,syma . ,(pcase--upat (car qpat))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
323 (match ,symd . ,(pcase--upat (cdr qpat)))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
324 :pcase--fail))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
325 ;; A QPattern but not for a cons, can only go the `else' side. |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
326 ((eq (car-safe pat) '\`) (cons :pcase--fail nil)))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
327 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
328 (defun pcase--split-equal (elem pat) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
329 (cond |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
330 ;; The same match will give the same result. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
331 ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem)) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
332 (cons :pcase--succeed :pcase--fail)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
333 ;; A different match will fail if this one succeeds. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
334 ((and (eq (car-safe pat) '\`) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
335 ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
336 ;; (consp (cadr pat))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
337 ) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
338 (cons :pcase--fail nil)))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
339 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
340 (defun pcase--split-member (elems pat) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
341 ;; Based on pcase--split-equal. |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
342 (cond |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
343 ;; The same match (or a match of membership in a superset) will |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
344 ;; give the same result, but we don't know how to check it. |
110087
b84898221ef1
* lisp/emacs-lisp/pcase.el (pcase-split-memq): Overenthusiastic optimisation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109743
diff
changeset
|
345 ;; (??? |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
346 ;; (cons :pcase--succeed nil)) |
110087
b84898221ef1
* lisp/emacs-lisp/pcase.el (pcase-split-memq): Overenthusiastic optimisation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109743
diff
changeset
|
347 ;; A match for one of the elements may succeed or fail. |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
348 ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) |
110087
b84898221ef1
* lisp/emacs-lisp/pcase.el (pcase-split-memq): Overenthusiastic optimisation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109743
diff
changeset
|
349 nil) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
350 ;; A different match will fail if this one succeeds. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
351 ((and (eq (car-safe pat) '\`) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
352 ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
353 ;; (consp (cadr pat))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
354 ) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
355 (cons :pcase--fail nil)))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
356 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
357 (defun pcase--split-pred (upat pat) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
358 ;; FIXME: For predicates like (pred (> a)), two such predicates may |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
359 ;; actually refer to different variables `a'. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
360 (if (equal upat pat) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
361 (cons :pcase--succeed :pcase--fail))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
362 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
363 (defun pcase--fgrep (vars sexp) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
364 "Check which of the symbols VARS appear in SEXP." |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
365 (let ((res '())) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
366 (while (consp sexp) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
367 (dolist (var (pcase--fgrep vars (pop sexp))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
368 (unless (memq var res) (push var res)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
369 (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
370 res)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
371 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
372 ;; It's very tempting to use `pcase' below, tho obviously, it'd create |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
373 ;; bootstrapping problems. |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
374 (defun pcase--u1 (matches code vars rest) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
375 "Return code that runs CODE (with VARS) if MATCHES match. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
376 and otherwise defers to REST which is a list of branches of the form |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
377 \(ELSE-MATCH ELSE-CODE . ELSE-VARS)." |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
378 ;; Depending on the order in which we choose to check each of the MATCHES, |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
379 ;; the resulting tree may be smaller or bigger. So in general, we'd want |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
380 ;; to be careful to chose the "optimal" order. But predicate |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
381 ;; patterns make this harder because they create dependencies |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
382 ;; between matches. So we don't bother trying to reorder anything. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
383 (cond |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
384 ((null matches) (funcall code vars)) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
385 ((eq :pcase--fail (car matches)) (pcase--u rest)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
386 ((eq :pcase--succeed (car matches)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
387 (pcase--u1 (cdr matches) code vars rest)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
388 ((eq 'and (caar matches)) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
389 (pcase--u1 (append (cdar matches) (cdr matches)) code vars rest)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
390 ((eq 'or (caar matches)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
391 (let* ((alts (cdar matches)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
392 (var (if (eq (caar alts) 'match) (cadr (car alts)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
393 (simples '()) (others '())) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
394 (when var |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
395 (dolist (alt alts) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
396 (if (and (eq (car alt) 'match) (eq var (cadr alt)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
397 (let ((upat (cddr alt))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
398 (and (eq (car-safe upat) '\`) |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
399 (or (integerp (cadr upat)) (symbolp (cadr upat)) |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
400 (stringp (cadr upat)))))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
401 (push (cddr alt) simples) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
402 (push alt others)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
403 (cond |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
404 ((null alts) (error "Please avoid it") (pcase--u rest)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
405 ((> (length simples) 1) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
406 ;; De-hoist the `or' MATCH into an `or' pattern that will be |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
407 ;; turned into a `memq' below. |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
408 (pcase--u1 (cons `(match ,var or . ,(nreverse simples)) (cdr matches)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
409 code vars |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
410 (if (null others) rest |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
411 (cons (list* |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
412 (pcase--and (if (cdr others) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
413 (cons 'or (nreverse others)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
414 (car others)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
415 (cdr matches)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
416 code vars) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
417 rest)))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
418 (t |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
419 (pcase--u1 (cons (pop alts) (cdr matches)) code vars |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
420 (if (null alts) (progn (error "Please avoid it") rest) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
421 (cons (list* |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
422 (pcase--and (if (cdr alts) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
423 (cons 'or alts) (car alts)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
424 (cdr matches)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
425 code vars) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
426 rest))))))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
427 ((eq 'match (caar matches)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
428 (destructuring-bind (op sym &rest upat) (pop matches) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
429 (cond |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
430 ((memq upat '(t _)) (pcase--u1 matches code vars rest)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
431 ((eq upat 'dontcare) :pcase--dontcare) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
432 ((functionp upat) (error "Feature removed, use (pred %s)" upat)) |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
433 ((memq (car-safe upat) '(guard pred)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
434 (destructuring-bind (then-rest &rest else-rest) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
435 (pcase--split-rest |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
436 sym (apply-partially #'pcase--split-pred upat) rest) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
437 (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
438 `(,(cadr upat) ,sym) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
439 (let* ((exp (cadr upat)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
440 ;; `vs' is an upper bound on the vars we need. |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
441 (vs (pcase--fgrep (mapcar #'car vars) exp)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
442 (call (cond |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
443 ((eq 'guard (car upat)) exp) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
444 ((functionp exp) `(,exp ,sym)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
445 (t `(,@exp ,sym))))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
446 (if (null vs) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
447 call |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
448 ;; Let's not replace `vars' in `exp' since it's |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
449 ;; too difficult to do it right, instead just |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
450 ;; let-bind `vars' around `exp'. |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
451 `(let ,(mapcar (lambda (var) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
452 (list var (cdr (assq var vars)))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
453 vs) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
454 ;; FIXME: `vars' can capture `sym'. E.g. |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
455 ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
456 ,call)))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
457 (pcase--u1 matches code vars then-rest) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
458 (pcase--u else-rest)))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
459 ((symbolp upat) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
460 (pcase--u1 matches code (cons (cons upat sym) vars) rest)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
461 ((eq (car-safe upat) '\`) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
462 (pcase--q1 sym (cadr upat) matches code vars rest)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
463 ((eq (car-safe upat) 'or) |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
464 (let ((all (> (length (cdr upat)) 1)) |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
465 (memq-fine t)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
466 (when all |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
467 (dolist (alt (cdr upat)) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
468 (unless (and (eq (car-safe alt) '\`) |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
469 (or (symbolp (cadr alt)) (integerp (cadr alt)) |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
470 (setq memq-fine nil) |
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
471 (stringp (cadr alt)))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
472 (setq all nil)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
473 (if all |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
474 ;; Use memq for (or `a `b `c `d) rather than a big tree. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
475 (let ((elems (mapcar 'cadr (cdr upat)))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
476 (destructuring-bind (then-rest &rest else-rest) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
477 (pcase--split-rest |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
478 sym (apply-partially #'pcase--split-member elems) rest) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
479 (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
480 (pcase--u1 matches code vars then-rest) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
481 (pcase--u else-rest)))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
482 (pcase--u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
483 (append (mapcar (lambda (upat) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
484 `((and (match ,sym . ,upat) ,@matches) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
485 ,code ,@vars)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
486 (cddr upat)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
487 rest))))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
488 ((eq (car-safe upat) 'and) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
489 (pcase--u1 (append (mapcar (lambda (upat) `(match ,sym ,@upat)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
490 (cdr upat)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
491 matches) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
492 code vars rest)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
493 ((eq (car-safe upat) 'not) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
494 ;; FIXME: The implementation below is naive and results in |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
495 ;; inefficient code. |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
496 ;; To make it work right, we would need to turn pcase--u1's |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
497 ;; `code' and `vars' into a single argument of the same form as |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
498 ;; `rest'. We would also need to split this new `then-rest' argument |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
499 ;; for every test (currently we don't bother to do it since |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
500 ;; it's only useful for odd patterns like (and `(PAT1 . PAT2) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
501 ;; `(PAT3 . PAT4)) which the programmer can easily rewrite |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
502 ;; to the more efficient `(,(and PAT1 PAT3) . ,(and PAT2 PAT4))). |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
503 (pcase--u1 `((match ,sym . ,(cadr upat))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
504 (lexical-let ((rest rest)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
505 ;; FIXME: This codegen is not careful to share its |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
506 ;; code if used several times: code blow up is likely. |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
507 (lambda (vars) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
508 ;; `vars' will likely contain bindings which are |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
509 ;; not always available in other paths to |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
510 ;; `rest', so there' no point trying to pass |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
511 ;; them down. |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
512 (pcase--u rest))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
513 vars |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
514 (list `((and . ,matches) ,code . ,vars)))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
515 (t (error "Unknown upattern `%s'" upat))))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
516 (t (error "Incorrect MATCH %s" (car matches))))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
517 |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
518 (defun pcase--q1 (sym qpat matches code vars rest) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
519 "Return code that runs CODE if SYM matches QPAT and if MATCHES match. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
520 and if not, defers to REST which is a list of branches of the form |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
521 \(OTHER_MATCH OTHER-CODE . OTHER-VARS)." |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
522 (cond |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
523 ((eq (car-safe qpat) '\,) (error "Can't use `,UPATTERN")) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
524 ((floatp qpat) (error "Floating point patterns not supported")) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
525 ((vectorp qpat) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
526 ;; FIXME. |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
527 (error "Vector QPatterns not implemented yet")) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
528 ((consp qpat) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
529 (let ((syma (make-symbol "xcar")) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
530 (symd (make-symbol "xcdr"))) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
531 (destructuring-bind (then-rest &rest else-rest) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
532 (pcase--split-rest sym |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
533 (apply-partially #'pcase--split-consp syma symd) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
534 rest) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
535 (pcase--if `(consp ,sym) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
536 `(let ((,syma (car ,sym)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
537 (,symd (cdr ,sym))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
538 ,(pcase--u1 `((match ,syma . ,(pcase--upat (car qpat))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
539 (match ,symd . ,(pcase--upat (cdr qpat))) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
540 ,@matches) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
541 code vars then-rest)) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
542 (pcase--u else-rest))))) |
111221
e2284aa4cad3
* lisp/emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110595
diff
changeset
|
543 ((or (integerp qpat) (symbolp qpat) (stringp qpat)) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
544 (destructuring-bind (then-rest &rest else-rest) |
111704
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
545 (pcase--split-rest sym (apply-partially 'pcase--split-equal qpat) rest) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
546 (pcase--if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
547 (pcase--u1 matches code vars then-rest) |
31c8556ccad8
* lisp/emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111502
diff
changeset
|
548 (pcase--u else-rest)))) |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
549 (t (error "Unkown QPattern %s" qpat)))) |
109743
d40bac543314
* lisp/emacs-lisp/pcase.el: Fix copyright header.
Glenn Morris <rgm@gnu.org>
parents:
109739
diff
changeset
|
550 |
109739
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
551 |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
552 (provide 'pcase) |
405e0ceb00e2
* lisp/emacs-lisp/pcase.el: New file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
553 ;;; pcase.el ends here |