diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-05 19:30:28 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-05 19:30:28 -0800 |
| commit | d02854155e915e28740605a7302faaaff1128622 (patch) | |
| tree | cf078bfe40a321df8450b6b9c2ab512f35ae6d86 /share | |
| parent | 00a793530e0386cfbe29670a8224f5e82897b283 (diff) | |
| download | txr-d02854155e915e28740605a7302faaaff1128622.tar.gz txr-d02854155e915e28740605a7302faaaff1128622.tar.bz2 txr-d02854155e915e28740605a7302faaaff1128622.zip | |
matcher: rearrange match order of @(with).
The @(with side-pat expr main-pat) syntax becomes
@(with main-pat side-pat expr), which is more useful.
Also, the main-pat can be omitted.
* share/txr/stdlib/match.tl (compile-with-match): Recognize
two forms of the syntax: two argument form with main-pat
omitted and the full form. In the full form, main-pat is
on the left now and processed first, so we have to rearrange
the compilation and integration order.
* tests/011/patmatch.tl: Existing tests updated. Two-argument
test added.
* txr.1: Updated.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/match.tl | 36 |
1 files changed, 20 insertions, 16 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 38d0b821..e269ecc1 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -331,22 +331,26 @@ pat-match.guard-chain))))) (defun compile-with-match (exp obj-var var-list) - (mac-param-bind *match-form* (op side-pat-var side-expr main-pat) exp - (let* ((side-var (gensym)) - (side-pat (if (or (null side-pat-var) (bindable side-pat-var)) - ^(sys:var ,side-pat-var) - side-pat-var)) - (side-match (compile-match side-pat side-var var-list)) - (main-match (compile-match main-pat obj-var var-list)) - (guard (new match-guard - pure-temps (list side-var) - pure-temp-exprs (list side-expr)))) - (new compiled-match - pattern exp - obj-var obj-var - guard-chain (append (list guard) - side-match.guard-chain - main-match.guard-chain))))) + (tree-case exp + ((op main-pat side-pat-var side-expr) + (let* ((side-var (gensym)) + (side-pat (if (or (null side-pat-var) (bindable side-pat-var)) + ^(sys:var ,side-pat-var) + side-pat-var)) + (main-match (compile-match main-pat obj-var var-list)) + (side-match (compile-match side-pat side-var var-list)) + (guard (new match-guard + pure-temps (list side-var) + pure-temp-exprs (list side-expr)))) + (new compiled-match + pattern exp + obj-var obj-var + guard-chain (append main-match.guard-chain + (list guard) + side-match.guard-chain)))) + ((op side-pat-var side-expr) + (compile-with-match ^(,op @nil ,side-pat-var ,side-expr) obj-var var-list)) + (x (compile-error *match-form* "bad syntax: ~s" exp)))) (defun compile-loop-match (exp obj-var var-list) (mac-param-bind *match-form* (op match) exp |