summaryrefslogtreecommitdiffstats
path: root/share
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-27 07:52:50 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-27 07:52:50 -0800
commitb0adac41c9ed37fa2783cbbde7d243f5496ed954 (patch)
tree5fae88da22dc22d2bf59c1ef9c577c8feb1f92f4 /share
parent4b7e799c377d2c4608d1b03f056edd659424a29b (diff)
downloadtxr-b0adac41c9ed37fa2783cbbde7d243f5496ed954.tar.gz
txr-b0adac41c9ed37fa2783cbbde7d243f5496ed954.tar.bz2
txr-b0adac41c9ed37fa2783cbbde7d243f5496ed954.zip
matcher: clean up unclear vars situaton.
With this commit, the new broken test case passes. The main issue is not clearly separating temporary variables in mach-guards from public variables. * share/txr/stdlib/match.tl (match-vars): Remove pure-vars and pure-var-exprs from this inheritance base, as well as the related lets method. (match-guard): Add the "pure" slots here, under new names: pure-temps and pure-temp-exprs. This renaming is for clarity. Add the lets method here, based on these new variables. Add new slots temps, representing the impure temps. There is no temp-exprs because impure temps are bound to nil and later assigned. (compiled-match get-temps): Method removed. (compiled-match get-vars): Rewritten to avoid using get-temps which doesn't exist any more. This method has a clear purpose: to all the public variables coming from the patterns themselves, whether those variables are promoted into a guard-chain for early binding or whether they are attached on the compiled-match object. (compiled-match wrap-guards): Ensure that the new temps from the guard-chain objects are bound with let. (compile-struct-match, compile-vec-match, compile-range-match, compile-dwim-predicate-match, compile-cons-structure, compile-hash-match): pure-vars rename. (compile-loop-match): We no longer bind cm.(get-temps) here. That method doesn't exist. If we are not doing @(some), we bind cm-vars: the public vars collected from cm. We need local copies of them to catch their values and accumulate them into list. In the match-guard constructor, we move the collect-gens into temps; they are not public variables. (compile-parallel-match): Drop ^(let ,pm.(get-temps) ...) from the expansion.
Diffstat (limited to 'share')
-rw-r--r--share/txr/stdlib/match.tl76
1 files changed, 38 insertions, 38 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
index 6671a13f..8c7a245a 100644
--- a/share/txr/stdlib/match.tl
+++ b/share/txr/stdlib/match.tl
@@ -27,17 +27,19 @@
(defstruct match-vars ()
vars
var-exprs
- pure-vars
- pure-var-exprs
(:method assignments (me)
- (mapcar (ret ^(set ,@1 ,@2)) me.vars me.var-exprs))
+ (mapcar (ret ^(set ,@1 ,@2)) me.vars me.var-exprs)))
- (:method lets (me)
- (mapcar (ret ^(,@1 ,@2)) me.pure-vars me.pure-var-exprs)))
(defstruct match-guard (match-vars)
- (guard-expr t))
+ temps
+ pure-temps
+ pure-temp-exprs
+ (guard-expr t)
+
+ (:method lets (me)
+ (mapcar (ret ^(,@1 ,@2)) me.pure-temps me.pure-temp-exprs)))
(defstruct compiled-match (match-vars)
pattern
@@ -45,11 +47,8 @@
guard-chain
test-expr
- (:method get-temps (me)
- (mappend .vars me.guard-chain))
-
(:method get-vars (me)
- (append me.(get-temps) me.vars))
+ (append me.vars (mappend .vars me.guard-chain)))
(:method wrap-guards (me exp)
(let ((rev-guard-chain (reverse me.guard-chain))
@@ -57,8 +56,9 @@
(each ((g rev-guard-chain))
(set out ^(when ,g.guard-expr
(alet ,g.(lets)
- ,*g.(assignments)
- ,out))))
+ (let ,g.temps
+ ,*g.(assignments)
+ ,out)))))
out)))
(defstruct var-list ()
@@ -88,12 +88,12 @@
(slot-val-exprs [mapcar (ret ^(slot ,obj-var ',@1)) required-slots])
(guard0 (if loose-p
(new match-guard
- pure-vars (list type-gensym)
- pure-var-exprs (list ^(struct-type ,obj-var))
+ pure-temps (list type-gensym)
+ pure-temp-exprs (list ^(struct-type ,obj-var))
guard-expr ^(structp ,obj-var))))
(guard1 (new match-guard
- pure-vars slot-gensyms
- pure-var-exprs slot-val-exprs
+ pure-temps slot-gensyms
+ pure-temp-exprs slot-val-exprs
guard-expr (if loose-p
^(and ,*(mapcar
(ret ^(slotp ,type-gensym ',@1))
@@ -143,8 +143,8 @@
(elem-matches (list-vec [mapcar (lop compile-match var-list)
vec-pat elem-gensyms]))
(guard (new match-guard
- pure-vars elem-gensyms
- pure-var-exprs (mapcar (ret ^[,obj-var ,@1])
+ pure-temps elem-gensyms
+ pure-temp-exprs (mapcar (ret ^[,obj-var ,@1])
(range* 0 (len vec-pat)))
guard-expr ^(and (vectorp ,obj-var)
(eql (len ,obj-var) ,(len vec-pat))))))
@@ -163,8 +163,8 @@
(to-match (compile-match to (gensym "to") var-list))
(guard (new match-guard
guard-expr ^(rangep ,obj-var)
- pure-vars (list from-match.obj-var to-match.obj-var)
- pure-var-exprs (list ^(from ,obj-var) ^(to ,obj-var)))))
+ pure-temps (list from-match.obj-var to-match.obj-var)
+ pure-temp-exprs (list ^(from ,obj-var) ^(to ,obj-var)))))
(new compiled-match
pattern rcons-expr
obj-var obj-var
@@ -202,8 +202,8 @@
(compile-var-match pat (gensym) var-list)
(compile-match pat (gensym) var-list)))
(guard (new match-guard
- vars (list pat-match.obj-var)
- var-exprs (list ^[,fun ,obj-var]))))
+ pure-temps (list pat-match.obj-var)
+ pure-temp-exprs (list ^[,fun ,obj-var]))))
(new compiled-match
pattern pred-expr
obj-var obj-var
@@ -238,8 +238,8 @@
(t (compile-cons-structure cdr cdr-gensym var-list)))
(compile-atom-match cdr cdr-gensym var-list)))
(guard (new match-guard
- pure-vars ^(,car-gensym ,cdr-gensym)
- pure-var-exprs ^((car ,obj-var) (cdr ,obj-var))
+ pure-temps ^(,car-gensym ,cdr-gensym)
+ pure-temp-exprs ^((car ,obj-var) (cdr ,obj-var))
guard-expr ^(consp ,obj-var))))
(new compiled-match
pattern cons-pat
@@ -297,7 +297,7 @@
((set ,iter-var (iter-step ,iter-var)))
(let ((,cm.obj-var (iter-item ,iter-var))
,matched-p-var
- ,*(if some-p cm.(get-temps) cm-vars))
+ ,*(unless some-p cm-vars))
,cm.(wrap-guards
^(progn ,*cm.(assignments)
(if ,cm.test-expr
@@ -312,7 +312,8 @@
,(unless coll-p ^(,(if some-p 'when 'unless) ,matched-p-var
(set ,loop-continue-p-var nil))))))
(guard (new match-guard
- vars (append cm-vars (unless some-p collect-gens))
+ vars cm-vars
+ temps (unless some-p collect-gens)
guard-expr ^(seqp ,obj-var))))
(new compiled-match
pattern exp
@@ -334,14 +335,13 @@
pats var-lists))
(all-vars (uniq (mappend .(get-vars) par-matches))))
(flet ((submatch-fun (pm)
- ^(let ,pm.(get-temps)
- ,pm.(wrap-guards
- ^(progn ,*pm.(assignments)
- (when ,pm.test-expr
- ,*(if (eq op 'or)
- (mapcar (ret ^(set ,@1 nil))
- (diff all-vars pm.(get-vars))))
- t))))))
+ pm.(wrap-guards
+ ^(progn ,*pm.(assignments)
+ (when ,pm.test-expr
+ ,*(if (eq op 'or)
+ (mapcar (ret ^(set ,@1 nil))
+ (diff all-vars pm.(get-vars))))
+ t)))))
(let ((guard (new match-guard
vars all-vars)))
(new compiled-match
@@ -400,8 +400,8 @@
var-list)))
(push
(new match-guard
- pure-vars (list km.obj-var)
- pure-var-exprs ^((hash-keys-of ,obj-var ',val)))
+ pure-temps (list km.obj-var)
+ pure-temp-exprs ^((hash-keys-of ,obj-var ',val)))
km.guard-chain)
km))
(t
@@ -412,8 +412,8 @@
vm.guard-chain)
(push
(new match-guard
- pure-vars (list vm.obj-var)
- pure-var-exprs ^((gethash ,obj-var ',key, hash-alt-val)))
+ pure-temps (list vm.obj-var)
+ pure-temp-exprs ^((gethash ,obj-var ',key, hash-alt-val)))
vm.guard-chain)
vm)))))))
(guard (new match-guard