suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixes matching of ..._x and ..._!_x inside ellipses

Browse Source
This commit is contained in:
Casey Klein 2011-03-30 10:01:07 -05:00
parent d265231452
commit d97a2b505c
2 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/redex/private/matcher.rkt
View File

@ -1466,7 +1466,14 @@ before the pattern compiler is invoked.
[else (let ([r-exp (car r-exps)])
(cond
[(repeat? r-exp)
(append (repeat-empty-bindings r-exp)
(append (if (repeat-suffix r-exp)
(list ((if (repeat-mismatch? r-exp)
make-mismatch-bind
make-bind)
(repeat-suffix r-exp)
'()))
null)
(repeat-empty-bindings r-exp)
(i-loop (cdr r-exps) ribs))]
[else
(loop (car r-exps) (i-loop (cdr r-exps) ribs))]))])))]

10
collects/redex/tests/matcher-test.rkt
View File

@ -203,6 +203,16 @@
(test-empty '(a ..._1 a ..._1)
'(a a)
(list (make-test-mtch (make-bindings (list (make-bind '..._1 1))) '(a a) none)))
(test-empty '((a ..._1 a ..._1) ...)
'((a a a a))
(list (make-test-mtch (make-bindings (list (make-bind '..._1 '(2)))) '((a a a a)) none)))
(test-empty '((a ..._!_1 a ..._!_1) ...)
'((a a a a))
(list (make-test-mtch (make-bindings '()) '((a a a a)) none)
(make-test-mtch (make-bindings '()) '((a a a a)) none)
(make-test-mtch (make-bindings '()) '((a a a a)) none)
(make-test-mtch (make-bindings '()) '((a a a a)) none)))
(test-empty '((name x a) ..._!_1 (name y a) ..._!_1)
'(a a)