From d02854155e915e28740605a7302faaaff1128622 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 5 Feb 2021 19:30:28 -0800
Subject: 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.
---
share/txr/stdlib/match.tl | 36 ++++++++++++++++++++----------------
1 file changed, 20 insertions(+), 16 deletions(-)
(limited to 'share')
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
--
cgit v1.2.3