diff --git a/collects/rnrs/syntax-case-6.ss b/collects/rnrs/syntax-case-6.ss index 1061c33a99..6a91a4cd5b 100644 --- a/collects/rnrs/syntax-case-6.ss +++ b/collects/rnrs/syntax-case-6.ss @@ -72,18 +72,20 @@ [(vector? d) (for-each loop (vector->list d))])) (datum->syntax id (convert-mpairs datum))) -(define (r6rs: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:syntax->datum orig-stx) + (let loop ([stx orig-stx]) + (cond + [(syntax? stx) + (convert-pairs (syntax->datum stx))] + [(mpair? stx) (mcons (loop (mcar stx)) + (loop (mcdr stx)))] + [(vector? stx) (list->vector + (map loop (vector->list stx)))] + [(symbol? stx) (raise-type-error + 'syntax->datum + (format "syntax (symbol '~s disallowed)" stx) + orig-stx)] + [else stx]))) (define (r6rs:generate-temporaries l) (list->mlist diff --git a/collects/tests/r6rs/syntax-case.sls b/collects/tests/r6rs/syntax-case.sls index e2498a0ad6..04daf5e6ea 100644 --- a/collects/tests/r6rs/syntax-case.sls +++ b/collects/tests/r6rs/syntax-case.sls @@ -228,7 +228,7 @@ (test (syntax->datum '(1 2)) '(1 2)) (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 '#(1 2)) '#(1 2)) (test (syntax->datum (datum->syntax #'x 1)) 1) (test (syntax->datum (datum->syntax #'x 'a)) 'a)