| blob | 4706be5e57c9dce108d3e3e376952212629143aa |
1 ;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t; coding: utf-8 -*-
3 ;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6 ;; Keywords:
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;; ML-style pattern matching.
26 ;; The entry points are autoloaded.
28 ;; Todo:
30 ;; - (pcase e (`(,x . ,x) foo)) signals an "x unused" warning if `foo' doesn't
31 ;; use x, because x is bound separately for the equality constraint
32 ;; (as well as any pred/guard) and for the body, so uses at one place don't
33 ;; count for the other.
34 ;; - provide ways to extend the set of primitives, with some kind of
35 ;; define-pcase-matcher. We could easily make it so that (guard BOOLEXP)
36 ;; could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)).
37 ;; But better would be if we could define new ways to match by having the
38 ;; extension provide its own `pcase--split-<foo>' thingy.
39 ;; - along these lines, provide patterns to match CL structs.
40 ;; - provide something like (setq VAR) so a var can be set rather than
41 ;; let-bound.
42 ;; - provide a way to fallthrough to subsequent cases (not sure what I meant by
43 ;; this :-()
44 ;; - try and be more clever to reduce the size of the decision tree, and
45 ;; to reduce the number of leaves that need to be turned into function:
46 ;; - first, do the tests shared by all remaining branches (it will have
47 ;; to be performed anyway, so better do it first so it's shared).
48 ;; - then choose the test that discriminates more (?).
49 ;; - provide Agda's `with' (along with its `...' companion).
50 ;; - implement (not UPAT). This might require a significant redesign.
51 ;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to
52 ;; generate a lex-style DFA to decide whether to run E1 or E2.
54 ;;; Code:
58 ;; Macro-expansion of pcase is reasonably fast, so it's not a problem
59 ;; when byte-compiling a file, but when interpreting the code, if the pcase
60 ;; is in a loop, the repeated macro-expansion becomes terribly costly, so we
61 ;; memoize previous macro expansions to try and avoid recomputing them
62 ;; over and over again.
63 ;; FIXME: Now that macroexpansion is also performed when loading an interpreted
64 ;; file, this is not a real problem any more.
66 ;; (defconst pcase--memoize-1 (make-hash-table :test 'eq))
67 ;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal))
74 pcase-UPAT
75 (&or symbolp
82 &or lambda-expr
83 ;; Punt on macros/special forms.
85 sexp)
86 sexp))
89 pcase-QPAT
92 sexp))
94 ;;;###autoload
96 "Perform ML-style pattern matching on EXP.
97 CASES is a list of elements of the form (UPATTERN CODE...).
99 UPatterns can take the following forms:
100 _ matches anything.
101 SELFQUOTING matches itself. This includes keywords, numbers, and strings.
102 SYMBOL matches anything and binds it to SYMBOL.
103 (or UPAT...) matches if any of the patterns matches.
104 (and UPAT...) matches if all the patterns match.
105 'VAL matches if the object is `equal' to VAL
106 `QPAT matches if the QPattern QPAT matches.
107 (pred FUN) matches if FUN applied to the object returns non-nil.
108 (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
109 (let UPAT EXP) matches if EXP matches UPAT.
110 (app FUN UPAT) matches if FUN applied to the object matches UPAT.
111 If a SYMBOL is used twice in the same pattern (i.e. the pattern is
114 QPatterns can take the following forms:
115 (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
116 [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
117 its 0..(n-1)th elements, respectively.
118 ,UPAT matches if the UPattern UPAT matches.
119 STRING matches if the object is `equal' to STRING.
120 ATOM matches if the object is `eq' to ATOM.
122 FUN can take the form
123 SYMBOL or (lambda ARGS BODY) in which case it's called with one argument.
124 (F ARG1 .. ARGn) in which case F gets called with an n+1'th argument
125 which is the value being matched.
126 So a FUN of the form SYMBOL is equivalent to one of the form (FUN).
127 FUN can refer to variables bound earlier in the pattern.
128 FUN is assumed to be pure, i.e. it can be dropped if its result is not used,
129 and two identical calls can be merged into one.
130 E.g. you can match pairs where the cdr is larger than the car with a pattern
131 like `(,a . ,(pred (< a))) or, with more checks:
132 `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))"
134 ;; We want to use a weak hash table as a cache, but the key will unavoidably
135 ;; be based on `exp' and `cases', yet `cases' is a fresh new list each time
136 ;; we're called so it'll be immediately GC'd. So we use (car cases) as key
137 ;; which does come straight from the source code and should hence not be GC'd
138 ;; so easily.
140 ;; data = (EXP CASES . EXPANSION)
142 ;; We have the right expansion.
144 ;; (when (gethash (car cases) pcase--memoize-1)
145 ;; (message "pcase-memoize failed because of weak key!!"))
146 ;; (when (gethash (car cases) pcase--memoize-2)
147 ;; (message "pcase-memoize failed because of eq test on %S"
148 ;; (car cases)))
153 ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-1)
154 ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
155 expansion))))
157 ;;;###autoload
159 "The exhaustive version of `pcase' (which see)."
164 ;; FIXME: Could we add the FILE:LINE data in the error message?
167 ;;;###autoload
169 "Like `lambda' but allow each argument to be a pattern.
170 `&rest' argument is supported."
177 lambda-list))
179 ;; Handle &rest
197 ;; We can either signal an error here, or just use `pcase--dontcare'
198 ;; which generates more efficient code. In practice, if we use
199 ;; `pcase--dontcare' we will still often get an error and the few
200 ;; cases where we don't do not matter that much, so
201 ;; it's a better choice.
204 ;;;###autoload
206 "Like `let*' but where you can use `pcase' patterns for bindings.
207 BODY should be an expression, and BINDINGS should be a list of bindings
208 of the form (UPAT EXP)."
212 ;; cached = (BODY . EXPANSION)
217 expansion))))
219 ;;;###autoload
221 "Like `let' but where you can use `pcase' patterns for bindings.
222 BODY should be a list of expressions, and BINDINGS should be a list of bindings
223 of the form (UPAT EXP)."
253 ;; (message "pid=%S (pcase--expand %S ...hash=%S)"
254 ;; (emacs-pid) exp (sxhash cases))
264 res)
265 ;; Since we use a tree-based pattern matching
266 ;; technique, the leaves (the places that contain the
267 ;; code to run once a pattern is matched) can get
268 ;; copied a very large number of times, so to avoid
269 ;; code explosion, we need to keep track of how many
270 ;; times we've used each leaf and move it
271 ;; to a separate function if that number is too high.
272 ;;
273 ;; We've already used this branch. So it is shared.
278 ;; This is the first repeat, so we have to move
279 ;; the branch to a separate function.
283 defs)
293 prevvars)))
294 ;; If some of `vars' were not found in `prevvars', that's
295 ;; OK it just means those vars aren't present in all
296 ;; branches, so they can be used within the pattern
297 ;; (e.g. by a `guard/let/pred') but not in the branch.
298 ;; FIXME: But if some of `prevvars' are not in `vars' we
299 ;; should remove them from `prevvars'!
308 ;; Keep track of the cases that are used.
312 ;; Don't bother sharing multiple
313 ;; occurrences of this leaf since it's small.
316 vars))))
317 cases))))
325 "Expands all macro-patterns in PAT."
339 "Unexpandable %s pattern: %S"
341 head pat)
344 ;;;###autoload
346 "Define a pcase UPattern macro."
352 "Build a MATCH structure, hoisting all `or's and `and's outside."
354 ;; Hoist or/and patterns into or/and matches.
364 ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding
365 ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
366 ;; codegen from later metamorphosing this let into a funcall.
376 small))))
378 ;; Try to use `cond' rather than a sequence of `if's, so as to reduce
379 ;; the depth of the generated tree.
386 ;; Note about MATCH:
387 ;; When we have patterns like `(PAT1 . PAT2), after performing the `consp'
388 ;; check, we want to turn all the similar patterns into ones of the form
389 ;; (and (match car PAT1) (match cdr PAT2)), so you naturally need conjunction.
390 ;; Earlier code hence used branches of the form (MATCHES . CODE) where
391 ;; MATCHES was a list (implicitly a conjunction) of (SYM . PAT).
392 ;; But if we have a pattern of the form (or `(PAT1 . PAT2) PAT3), there is
393 ;; no easy way to eliminate the `consp' check in such a representation.
394 ;; So we replaced the MATCHES by the MATCH below which can be made up
395 ;; of conjunctions and disjunctions, so if we know `foo' is a cons, we can
396 ;; turn (match foo . (or `(PAT1 . PAT2) PAT3)) into
397 ;; (or (and (match car . `PAT1) (match cdr . `PAT2)) (match foo . PAT3)).
398 ;; The downside is that we now have `or' and `and' both in MATCH and
399 ;; in PAT, so there are different equivalent representations and we
400 ;; need to handle them all. We do not try to systematically
401 ;; canonicalize them to one form over another, but we do occasionally
402 ;; turn one into the other.
405 "Expand matcher for rules BRANCHES.
406 Each BRANCH has the form (MATCH CODE . VARS) where
407 CODE is the code generator for that branch.
408 VARS is the set of vars already bound by earlier matches.
409 MATCH is the pattern that needs to be matched, of the form:
410 (match VAR . UPAT)
411 (and MATCH ...)
412 (or MATCH ...)"
452 pcase-mutually-exclusive-predicates)
454 pcase-mutually-exclusive-predicates)))
502 ;; The same match will give the same result.
505 ;; A different match will fail if this one succeeds.
507 ;; (or (integerp (cadr pat)) (symbolp (cadr pat))
508 ;; (consp (cadr pat)))
509 )
520 ;; FIXME: The new pred-based member code doesn't do these optimizations!
521 ;; Based on pcase--split-equal.
523 ;; The same match (or a match of membership in a superset) will
524 ;; give the same result, but we don't know how to check it.
525 ;; (???
526 ;; '(:pcase--succeed . nil))
527 ;; A match for one of the elements may succeed or fail.
529 nil)
530 ;; A different match will fail if this one succeeds.
532 ;; (or (integerp (cadr pat)) (symbolp (cadr pat))
533 ;; (consp (cadr pat)))
534 )
543 all)))
550 ;; For predicates like (pred (> a)), two such predicates may
551 ;; actually refer to different variables `a'.
553 ;; FIXME: `vars' gives us the environment in which `upat' will
554 ;; run, but we don't have the environment in which `pat' will
555 ;; run, so we can't do a reliable verification. But let's try
556 ;; and catch at least the easy cases such as (bug#14773).
581 "Check which of the symbols VARS appear in SEXP."
587 res))
599 match))
612 rest))
615 ;; Exceptionally, `sym' may be a constant expression rather than a symbol.
619 "Helper function, used internally to avoid (funcall (lambda ...) ...)."
624 "Build a function call to FUN with arg ARG."
631 vs))
634 ;; `arg' is shadowed by `env'.
642 call
643 ;; Let's not replace `vars' in `fun' since it's
644 ;; too difficult to do it right, instead just
645 ;; let-bind `vars' around `fun'.
649 "Build an expression that will evaluate EXP."
654 vs)))
657 ;; It's very tempting to use `pcase' below, tho obviously, it'd create
658 ;; bootstrapping problems.
660 "Return code that runs CODE (with VARS) if MATCHES match.
661 Otherwise, it defers to REST which is a list of branches of the form
662 \(ELSE-MATCH ELSE-CODE . ELSE-VARS)."
663 ;; Depending on the order in which we choose to check each of the MATCHES,
664 ;; the resulting tree may be smaller or bigger. So in general, we'd want
665 ;; to be careful to chose the "optimal" order. But predicate
666 ;; patterns make this harder because they create dependencies
667 ;; between matches. So we don't bother trying to reorder anything.
691 ;; Yes, we can use `memq' (or `member')!
698 code vars
706 rest))))
715 rest)))))))
740 ;; Non-linear pattern. Turn it into an `eq' test.
742 matches)
743 code vars rest)))
745 ;; A upat of the form (let VAR EXP).
746 ;; (pcase--u1 matches code
747 ;; (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest)
749 macroexp-copyable-p sym
752 code vars rest)))
754 ;; A upat of the form (app FUN UPAT)
759 ;; We don't change `matches' to reuse the newly computed value,
760 ;; because we assume there shouldn't be such redundancy in there.
762 code vars
765 body
768 body))))
786 ;; FIXME: The implementation below is naive and results in
787 ;; inefficient code.
788 ;; To make it work right, we would need to turn pcase--u1's
789 ;; `code' and `vars' into a single argument of the same form as
790 ;; `rest'. We would also need to split this new `then-rest' argument
791 ;; for every test (currently we don't bother to do it since
792 ;; it's only useful for odd patterns like (and `(PAT1 . PAT2)
793 ;; `(PAT3 . PAT4)) which the programmer can easily rewrite
794 ;; to the more efficient `(,(and PAT1 PAT3) . ,(and PAT2 PAT4))).
796 ;; FIXME: This codegen is not careful to share its
797 ;; code if used several times: code blow up is likely.
799 ;; `vars' will likely contain bindings which are
800 ;; not always available in other paths to
801 ;; `rest', so there' no point trying to pass
802 ;; them down.
804 vars
818 upats))
828 ;;; pcase.el ends here