summaryrefslogtreecommitdiffstats
path: root/share
diff options
context:
space:
mode:
Diffstat (limited to 'share')
-rw-r--r--share/txr/stdlib/match.tl19
1 files changed, 19 insertions, 0 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index 6c57e0b9..06f028c7 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -329,6 +329,24 @@
guard-chain (append var-match.guard-chain
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)))))
+
(defun compile-loop-match (exp obj-var var-list)
(mac-param-bind *match-form* (op match) exp
(let* ((no-vac-p (memq op '(coll usr:all*)))
@@ -489,6 +507,7 @@
(struct (compile-struct-match exp obj-var var-list))
(require (compile-require-match exp obj-var var-list))
(usr:as (compile-as-match exp obj-var var-list))
+ (usr:with (compile-with-match exp obj-var var-list))
(all (compile-loop-match exp obj-var var-list))
(usr:all* (compile-loop-match exp obj-var var-list))
(some (compile-loop-match exp obj-var var-list))