diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-28 18:59:02 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-28 18:59:02 -0800 |
| commit | 8e887d2395466c4169faed88822165baa3b21614 (patch) | |
| tree | e6e21d0ecf777347370b2bf6b44b93d8063cf96b | |
| parent | 9da4f521318c011c5f3569e7bc36cb9af734c72a (diff) | |
| download | txr-8e887d2395466c4169faed88822165baa3b21614.tar.gz txr-8e887d2395466c4169faed88822165baa3b21614.tar.bz2 txr-8e887d2395466c4169faed88822165baa3b21614.zip | |
matcher: add test-expr to match-guard.
* share/txr/stdlib/match.tl (match-guard): New slot,
test-expr. This provides a bottom test, with all the variables
bound, allowing us to allocate just one match guard in a few
instances where we are allocating two. This will be important
in the upcoming refactoring.
(compiled-match :postinit): Allocate just one match-guard
with test-expr instead of a separate one with a guard-expr.
(wrap-guards): Wrap the test-expr to the code, if it is
not t.
(compile-hash-match): Reduce two match guards to one in two
instances.
| -rw-r--r-- | share/txr/stdlib/match.tl | 20 |
1 files changed, 10 insertions, 10 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 1a86cb9d..a12fb6e1 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -38,6 +38,7 @@ pure-temps pure-temp-exprs (guard-expr t) + (test-expr t) (:method lets (me) (mapcar (ret ^(,@1 ,@2)) me.pure-temps me.pure-temp-exprs))) @@ -59,9 +60,8 @@ (list (new match-guard vars me.vars - var-exprs me.var-exprs) - (new match-guard - guard-expr me.test-expr)))) + var-exprs me.var-exprs + test-expr me.test-expr)))) (set me.vars nil me.var-exprs nil me.test-expr t)) @@ -79,6 +79,8 @@ (match-guard (let ((lets g.(lets)) (temps g.temps)) + (if (neq t g.test-expr) + (set exp ^(if ,g.test-expr ,exp))) (cond ((and lets temps) (set exp ^(alet ,lets @@ -472,10 +474,9 @@ (new match-guard vars (list vm.obj-var) var-exprs ^((gethash ,obj-var ,key-var-sym - ,hash-alt-val))) - (new match-guard - guard-expr ^(neq ,vm.obj-var - ,hash-alt-val))) + ,hash-alt-val)) + test-expr ^(neq ,vm.obj-var + ,hash-alt-val))) vm)) ((and key-pat-p val-pat-p) (set need-alist-p t) @@ -496,9 +497,8 @@ (new match-guard pure-temps (list vm.obj-var) pure-temp-exprs ^((gethash ,obj-var ',key, - hash-alt-val))) - (new match-guard - guard-expr ^(neq ,vm.obj-var ,hash-alt-val))) + hash-alt-val)) + test-expr ^(neq ,vm.obj-var ,hash-alt-val))) vm))))))) (guard (new match-guard guard-expr ^(hashp ,obj-var) |