diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-22 18:49:57 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-22 18:49:57 -0800 |
| commit | 7af73f4d549a25b41e8278a3a26bed3603e31bc1 (patch) | |
| tree | 245b1c5823949754367bcc3edaf3416cf7eb4d09 | |
| parent | 3fb32c9a73d407844fb9f7c843f70f85bee5b60e (diff) | |
| download | txr-7af73f4d549a25b41e8278a3a26bed3603e31bc1.tar.gz txr-7af73f4d549a25b41e8278a3a26bed3603e31bc1.tar.bz2 txr-7af73f4d549a25b41e8278a3a26bed3603e31bc1.zip | |
matcher: match trivial patterns as atoms.
* share/txr/stdlib/match.tl (compile-atom-match): Test whether
a vector is really a non-trivial pattern, or a trivial
piece of datum. If it is trivial, then compile it
as an atom, which is matched by a simple call to equal,
which is way less code bloat, and implemented in C.
(compile-match): Similarly, check whether the cons structure
case is nontrivial and only then treat it as a cons
pattern, otherwise compile it as an atom, which will
just match it with equal.
| -rw-r--r-- | share/txr/stdlib/match.tl | 20 |
1 files changed, 13 insertions, 7 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 8873062b..8268f0a7 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -152,12 +152,16 @@ var-exprs (mappend .var-exprs elem-matches)))) (defun compile-atom-match (atom obj-var var-list) - (typecase atom - (vec (compile-vec-match atom obj-var var-list)) - (t (new compiled-match - pattern atom - obj-var obj-var - test-expr ^(equal ,obj-var ',atom))))) + (flet ((compile-as-atom () + (new compiled-match + pattern atom + obj-var obj-var + test-expr ^(equal ,obj-var ',atom)))) + (typecase atom + (vec (if (non-triv-pat-p atom) + (compile-vec-match atom obj-var var-list) + (compile-as-atom))) + (t (compile-as-atom))))) (defun compile-op-match (op-expr obj-var var-list) (let ((var-match (compile-var-match nil obj-var var-list))) @@ -399,7 +403,9 @@ (compile-error *match-form* "unrecognized pattern syntax ~s" pat)))) (sys:var (compile-var-match (cadr pat) obj-var var-list)) - (t (compile-cons-structure pat obj-var var-list)))) + (t (if (non-triv-pat-p pat) + (compile-cons-structure pat obj-var var-list) + (compile-atom-match pat obj-var var-list))))) (t (compile-atom-match pat obj-var var-list)))) (defmacro when-match (:form *match-form* pat obj . body) |