diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-09 07:36:25 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-09 07:36:25 -0800 |
| commit | a824ded1de5099e860e119bec1d3a2ed5e12a1ba (patch) | |
| tree | a1784d41af85abc46b8f5d1c08c84b631d051d5c | |
| parent | 9f34bd9798550af88893ad165f9792198c48163d (diff) | |
| download | txr-a824ded1de5099e860e119bec1d3a2ed5e12a1ba.tar.gz txr-a824ded1de5099e860e119bec1d3a2ed5e12a1ba.tar.bz2 txr-a824ded1de5099e860e119bec1d3a2ed5e12a1ba.zip | |
matcher: replace wrg function with reduce-right.
* share/txr/stdlib/match.tl (wrap-expr): Remove wrg local
function. Replace call with simple reduce-right,
which doesn't require a reversal of the original list.
(compiled-match): Likewise.
| -rw-r--r-- | share/txr/stdlib/match.tl | 37 |
1 files changed, 14 insertions, 23 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index b90666e3..d31b0fdb 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -73,23 +73,19 @@ all-vars (:method wrap-expr (g exp) - (labels ((wrg (rgc exp) - (each ((g rgc)) - (set exp g.(wrap-expr exp))) - exp)) - (let* ((vars [mapcar get-vars g.guard-chains]) - (back-vars (cons nil - (reverse - [mapcar (ap append) (conses (reverse vars))]))) - (branches (collect-each ((gc g.guard-chains) - (v vars) - (bv back-vars)) - ^(progn - (set ,*(mappend (ret ^(,@1 nil)) (diff bv v))) - ,(wrg (reverse gc) t))))) - (set exp ^(when (or ,*branches) - ,exp)) - exp)))) + (let* ((vars [mapcar get-vars g.guard-chains]) + (back-vars (cons nil + (reverse + [mapcar (ap append) (conses (reverse vars))]))) + (branches (collect-each ((gc g.guard-chains) + (v vars) + (bv back-vars)) + ^(progn + (set ,*(mappend (ret ^(,@1 nil)) (diff bv v))) + ,(reduce-right (umeth wrap-expr) gc t))))) + (set exp ^(when (or ,*branches) + ,exp)) + exp))) (defstruct compiled-match () pattern @@ -100,12 +96,7 @@ (uniq (get-vars me.guard-chain))) (:method wrap-guards (me . forms) - (labels ((wrg (rgc exp) - (each ((g rgc)) - (set exp g.(wrap-expr exp))) - exp)) - (wrg (reverse me.guard-chain) - ^(progn ,*forms)))) + (reduce-right (umeth wrap-expr) me.guard-chain ^(progn ,*forms))) (:method add-guard-pre (me guard) (push guard me.guard-chain)) |