Fixes bug 174497: syntax-error should not be in (rnrs) and

syntax-violation not completed
This commit is contained in:
Abdulaziz Ghuloum 2007-12-07 03:00:25 -05:00
parent c0191a8283
commit cf82981383
4 changed files with 35 additions and 5 deletions

View File

@ -2148,7 +2148,9 @@
(or v* (error 'name* "uninitialized label"))) ...
(define (refresh)
(define-syntax name*
(lambda (stx) (syntax-error stx "cannot use label before it is defined")))
(lambda (stx)
(syntax-error stx
"cannot use label before it is defined")))
...
(let* ([name* (let ([label (let () b* b** ...)])
(set! v* label)

View File

@ -1 +1 @@
1192
1193

View File

@ -1298,7 +1298,7 @@
[module i cm]
[library i]
[syntax-dispatch ]
[syntax-error i r sc]
[syntax-error i]
[$transcoder->data $transc]
[$data->transcoder $transc]
[file-options-spec i]

View File

@ -22,6 +22,7 @@
(export identifier? syntax-dispatch environment environment?
eval expand generate-temporaries free-identifier=?
bound-identifier=? datum->syntax syntax-error
syntax-violation
syntax->datum make-variable-transformer
eval-r6rs-top-level boot-library-expand eval-top-level
null-environment scheme-report-environment)
@ -30,7 +31,7 @@
environment environment? identifier?
eval generate-temporaries free-identifier=?
bound-identifier=? datum->syntax syntax-error
syntax->datum make-variable-transformer
syntax-violation syntax->datum make-variable-transformer
null-environment scheme-report-environment)
(rnrs base)
(rnrs lists)
@ -3427,7 +3428,6 @@
(error 'syntax-error "invalid argument" args))
(raise
(condition
;(make-who-condition 'expander)
(make-message-condition
(if (null? args)
"invalid syntax"
@ -3436,6 +3436,34 @@
(stx->datum x)
'none)))))
(define syntax-violation
(case-lambda
[(who msg form)
(syntax-violation who msg form #f)]
[(who msg form subform)
(unless (string? msg)
(error 'syntax-violation "message is not a string" msg))
(let ([who
(cond
[(or (string? who) (symbol? who)) who]
[(not who)
(syntax-match form ()
[id (id? id) (syntax->datum id)]
[(id . rest) (id? id) (syntax->datum id)]
[_ #f])]
[else
(error 'syntax-violation
"invalid who argument" who)])])
(raise
(condition
(if who
(make-who-condition who)
(condition))
(make-message-condition msg)
(make-syntax-violation
(syntax->datum form)
(syntax->datum subform)))))]))
(define identifier? (lambda (x) (id? x)))
(define datum->syntax