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

Fixes bug in `cross' pattern handling

Browse Source
This commit is contained in:
Casey Klein 2011-04-05 13:48:26 -05:00
parent 6494bf863e
commit e8130a2fd1
2 changed files with 8 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/redex/private/rewrite-side-conditions.rkt
View File

@ -127,7 +127,7 @@
(let loop ([stx orig-stx] (let loop ([stx orig-stx]
[names null] [names null]
[depth 0]) [depth 0])
(syntax-case stx (name in-hole side-condition) (syntax-case stx (name in-hole side-condition cross)
[(name sym pat) [(name sym pat)
(identifier? (syntax sym)) (identifier? (syntax sym))
(loop (syntax pat) (loop (syntax pat)
@ -139,6 +139,7 @@
depth)] depth)]
[(side-condition pat . rest) [(side-condition pat . rest)
(loop (syntax pat) names depth)] (loop (syntax pat) names depth)]
[(cross _) names]
[(pat ...) [(pat ...)
(let i-loop ([pats (syntax->list (syntax (pat ...)))] (let i-loop ([pats (syntax->list (syntax (pat ...)))]
[names names]) [names names])

7
collects/redex/tests/tl-test.rkt
View File

@ -280,6 +280,12 @@
#:key (compose symbol->string bind-name))) #:key (compose symbol->string bind-name)))
'()) '())
'(1 4 3 2 5 "s" t s))) '(1 4 3 2 5 "s" t s)))
(let ()
(define-language L
(e (e e) number))
;; not a syntax error since first e is not a binder
(test (pair? (redex-match L ((cross e) e ...) (term ((hole 2) 1)))) #t))
;; test caching ;; test caching
(let () (let ()
@ -1489,7 +1495,6 @@
(e ((name x any) (name x any_2) ...))) (e ((name x any) (name x any_2) ...)))
#rx"different depths" #rx"different depths"
2) 2)
(test-syn-err (reduction-relation (test-syn-err (reduction-relation
grammar grammar