syndicate-lang
/
minimart-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Simplify matcher-recurse by using internal recursion.

This commit is contained in:
Tony Garnock-Jones 2014-08-21 16:51:12 -07:00
parent b380c9ca64
commit 234ba0d417
1 changed files with 11 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
minimart/route.rkt
View File

@ -350,7 +350,6 @@
(define (matcher-union re1 re2) (define (matcher-union re1 re2)
(matcher-recurse re1 (matcher-recurse re1
re2 re2
matcher-union
(matcher-union-successes) (matcher-union-successes)
values values
values values
@ -365,7 +364,6 @@
(define (matcher-intersect re1 re2) (define (matcher-intersect re1 re2)
(matcher-recurse re1 (matcher-recurse re1
re2 re2
matcher-intersect
(matcher-intersect-successes) (matcher-intersect-successes)
(lambda (r) #f) (lambda (r) #f)
(lambda (r) #f) (lambda (r) #f)
@ -378,23 +376,23 @@
(define (matcher-subtract re1 re2) (define (matcher-subtract re1 re2)
(matcher-recurse re1 (matcher-recurse re1
re2 re2
matcher-subtract
(matcher-subtract-successes) (matcher-subtract-successes)
(lambda (r) #f) (lambda (r) #f)
values values
(lambda (h) #f) (lambda (h) #f)
values)) values))
(define (matcher-recurse re1 re2 f vf left-false right-false right-base left-base) (define (matcher-recurse re1 re2 vf left-false right-false right-base left-base)
(match* (re1 re2) (let f ((re1 re1) (re2 re2))
[(#f r) (left-false r)] (match* (re1 re2)
[(r #f) (right-false r)] [(#f r) (left-false r)]
[((wildcard-sequence r1) (wildcard-sequence r2)) (rwildseq (f r1 r2))] [(r #f) (right-false r)]
[((wildcard-sequence r1) r2) (f (expand-wildseq r1) r2)] [((wildcard-sequence r1) (wildcard-sequence r2)) (rwildseq (f r1 r2))]
[(r1 (wildcard-sequence r2)) (f r1 (expand-wildseq r2))] [((wildcard-sequence r1) r2) (f (expand-wildseq r1) r2)]
[((success v1) (success v2)) (rsuccess (vf v1 v2))] [(r1 (wildcard-sequence r2)) (f r1 (expand-wildseq r2))]
[((? treap? h1) (? treap? h2)) [((success v1) (success v2)) (rsuccess (vf v1 v2))]
(fold-over-keys h1 h2 f (left-base h1) (right-base h2))])) [((? treap? h1) (? treap? h2))
(fold-over-keys h1 h2 f (left-base h1) (right-base h2))])))
(define (fold-over-keys h1 h2 f left-base right-base) (define (fold-over-keys h1 h2 f left-base right-base)
(define w1 (rlookup h1 ? #f)) (define w1 (rlookup h1 ? #f))