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

fix r6rs syntax->datum

Browse Source 
svn: r9640
This commit is contained in:
Matthew Flatt 2008-05-04 12:55:53 +00:00
parent 5d32becf1c
commit 7118de47c4
3 changed files with 24 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/r6rs/scribblings/r6rs.scrbl
View File

@ -163,6 +163,7 @@ Examples:
(rnrs io simple (6)) #, @elem{roughly means} rnrs/io/simple-6 (rnrs io simple (6)) #, @elem{roughly means} rnrs/io/simple-6
(rnrs) #, @elem{roughly means} rnrs (rnrs) #, @elem{roughly means} rnrs
(rnrs (6)) #, @elem{roughly means} rnrs/main-6 (rnrs (6)) #, @elem{roughly means} rnrs/main-6
(scheme base) #, @elem{roughly means} scheme/base
] ]
When an @|r6rs| library or top-level program refers to another When an @|r6rs| library or top-level program refers to another
@ -183,6 +184,7 @@ Examples (assuming a typical PLT Scheme installation):
(rnrs io simple (6)) #, @elem{really means} (lib "rnrs/io/simple-6.ss") (rnrs io simple (6)) #, @elem{really means} (lib "rnrs/io/simple-6.ss")
(rnrs) #, @elem{really means} (lib "rnrs/main-6.ss") (rnrs) #, @elem{really means} (lib "rnrs/main-6.ss")
(rnrs (6)) #, @elem{really means} (lib "rnrs/main-6.ss") (rnrs (6)) #, @elem{really means} (lib "rnrs/main-6.ss")
(scheme base) #, @elem{really means} (lib "scheme/base.ss")
] ]

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

@ -38,7 +38,17 @@
(datum->syntax id (convert-mpairs datum))) (datum->syntax id (convert-mpairs datum)))
(define (r6rs:syntax->datum stx) (define (r6rs:syntax->datum stx)
(convert-pairs (syntax->datum stx))) (cond
[(syntax? stx)
(convert-pairs (syntax->datum stx))]
[(mpair? stx) (mcons (r6rs:syntax->datum
(mcar stx))
(r6rs:syntax->datum
(mcdr stx)))]
[(vector? stx) (list->vector
(map r6rs:syntax->datum
(vector->list stx)))]
[else stx]))
(define (r6rs:generate-temporaries l) (define (r6rs:generate-temporaries l)
(list->mlist (list->mlist

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

@ -210,6 +210,13 @@
(test (syntax->datum #'(a b)) '(a b)) (test (syntax->datum #'(a b)) '(a b))
(test (syntax->datum #'(a . b)) '(a . b)) (test (syntax->datum #'(a . b)) '(a . b))
(test (syntax->datum '1) 1)
(test (syntax->datum '(a . b)) '(a . b))
(test (syntax->datum '(a b)) '(a b))
(test (syntax->datum (cons #'a #'b)) '(a . b))
(test (syntax->datum (vector #'a #'b)) '#(a b))
(test (syntax->datum '#(a b)) '#(a b))
(test (syntax->datum (datum->syntax #'x 1)) 1) (test (syntax->datum (datum->syntax #'x 1)) 1)
(test (syntax->datum (datum->syntax #'x 'a)) 'a) (test (syntax->datum (datum->syntax #'x 'a)) 'a)
(test (syntax->datum (datum->syntax #'x '(a b))) '(a b)) (test (syntax->datum (datum->syntax #'x '(a b))) '(a b))
@ -281,5 +288,8 @@
(test/exn (syntax-violation 'form "bad" 7 8) &syntax) (test/exn (syntax-violation 'form "bad" 7 8) &syntax)
;; ;;
)) )
(run-syntax-case-tests)
(report-test-results))