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

fix r6rs template problem with quoting ellipses

Browse Source 
svn: r14780
This commit is contained in:
Matthew Flatt 2009-05-12 13:44:04 +00:00
parent 5df29ea906
commit 1809d9286e
3 changed files with 33 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/syntax/private/template-runtime.ss
View File

@ -4,6 +4,7 @@
(provide template-map-apply)
(define-struct ellipses (elem count rest) #:prefab #:omit-define-syntaxes)
(define-struct ellipses-quote (rest) #:prefab #:omit-define-syntaxes)
(define-struct prefab (key fields) #:prefab #:omit-define-syntaxes)
(define (stx-list->vector l)
@ -74,6 +75,8 @@
stx
appended)
appended)))]
[(ellipses-quote? tmap)
(loop (ellipses-quote-rest tmap) data stx local-pcons)]
[(prefab? tmap)
(d->s (car data)
stx

14
collects/syntax/template.ss
View File

@ -19,10 +19,12 @@
;; - (vector map) => template portion is a vector,
;; contents like the list in map
;; - (box map) => template portion is a box with substition
;; - #s(ellipses count map) => template portion is an ellipses-generated list
;; - #s(prefab v map) => templat portion is a prefab
;; - #s(ellipses elem count map) => template portion is an ellipses-generated list
;; - #s(ellipses-quote map) => template has a quoting ellipses
;; - #s(prefab v map) => template portion is a prefab
(define-struct ellipses (elem count rest) #:prefab #:omit-define-syntaxes)
(define-struct ellipses-quote (rest) #:prefab #:omit-define-syntaxes)
(define-struct prefab (key fields) #:prefab #:omit-define-syntaxes)
(define (datum->syntax* stx d)
@ -36,7 +38,7 @@
(and (not in-ellipses?)
(identifier? #'ellipses)
(free-identifier=? #'ellipses #'(... ...)))
(loop #'expr #t)]
(make-ellipses-quote (loop #'expr #t))]
[(expr ellipses . rest)
(and (not in-ellipses?)
(identifier? #'ellipses)
@ -108,6 +110,8 @@
(loop (ellipses-rest tmap) rest))
(cons (loop (ellipses-elem tmap) (stx-car template))
(loop (ellipses-rest tmap) rest))))]
[(ellipses-quote? tmap)
(loop (ellipses-quote-rest tmap) (stx-car (stx-cdr template)))]
[(prefab? tmap)
(cons (s->d template)
(loop (prefab-fields tmap)
@ -149,6 +153,10 @@
(if (syntax? template)
(datum->syntax* template new)
new)))]
[(ellipses-quote? tmap)
(datum->syntax* template
(list (stx-car template)
(loop (ellipses-quote-rest tmap) (stx-car (stx-cdr template)))))]
[(prefab? tmap)
(datum->syntax*
template

19
collects/tests/r6rs/syntax-case.sls
View File

@ -209,6 +209,25 @@
(map syntax->datum #'(x ... ...))])
'(a b c))
(test (syntax-case #'(... x) ()
[a (syntax->datum #'a)])
'x)
(test (syntax-case #'(... ...) ()
[a (syntax->datum #'a)])
'...)
(test (syntax-case #'(... (other ...)) ()
[a (syntax->datum #'a)])
'(other ...))
(test (syntax-case #'(1 2 3) ()
[(a ...) (syntax->datum #'((a (... ...)) ...))])
'((1 ...) (2 ...) (3 ...)))
(test (syntax-case #'(1 2 3) ()
[(a b c) (syntax->datum #'(... (a ...)))])
'(1 ...))
(test (syntax-case #'(1 2 3) ()
[(a b c) (syntax->datum #'(... (... (a) b)))])
'(... (1) 2))
(test (identifier? 'x) #f)
(test (identifier? #'x) #t)
(test (bound-identifier=? #'x #'x) #t)