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

fix R6RS template handling of consecutive ellipses

Browse Source 
svn: r10824
This commit is contained in:
Matthew Flatt 2008-07-17 17:55:52 +00:00
parent 04af3c8f01
commit 6e668cbb00
2 changed files with 16 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/rnrs/syntax-case-6.ss
View File

@ -227,7 +227,14 @@
(identifier? #'ellipses) (identifier? #'ellipses)
(free-identifier=? #'ellipses #'(... ...))) (free-identifier=? #'ellipses #'(... ...)))
(box (cons (loop #'expr #f #f) (box (cons (loop #'expr #f #f)
(loop #'rest #f #t)))] (let rloop ([rest #'rest])
(syntax-case rest ()
[(ellipses . rest)
(and (identifier? #'ellipses)
(free-identifier=? #'ellipses #'(... ...)))
;; keep going:
(rloop #'rest)]
[else (loop rest #f #t)]))))]
[(a . b) (let ([a (loop #'a in-ellipses? #f)] [(a . b) (let ([a (loop #'a in-ellipses? #f)]
[b (loop #'b in-ellipses? counting?)]) [b (loop #'b in-ellipses? counting?)])
(if (or a b counting?) (if (or a b counting?)

8
collects/tests/r6rs/syntax-case.ss
View File

@ -195,6 +195,14 @@
(test (syntax-case #'(1) () (test (syntax-case #'(1) ()
[(_) (syntax->datum #'_)]) [(_) (syntax->datum #'_)])
'_) '_)
(test (syntax-case '((a) (b c)) ()
[((x ...) ...)
#'(x ... ...)])
'(a b c))
(test (syntax-case #'((a) (b c)) ()
[((x ...) ...)
(map syntax->datum #'(x ... ...))])
'(a b c))
(test (identifier? 'x) #f) (test (identifier? 'x) #f)
(test (identifier? #'x) #t) (test (identifier? #'x) #t)