conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
scheme/ikarus.compiler.ss
View File

@ -2148,7 +2148,9 @@
(or v* (error 'name* "uninitialized label"))) ... (or v* (error 'name* "uninitialized label"))) ...
(define (refresh) (define (refresh)
(define-syntax name* (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** ...)]) (let* ([name* (let ([label (let () b* b** ...)])
(set! v* label) (set! v* label)

2
scheme/last-revision
View File

@ -1 +1 @@
1192 1193

2
scheme/makefile.ss
View File

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

32
scheme/psyntax.expander.ss
View File

@ -22,6 +22,7 @@
(export identifier? syntax-dispatch environment environment? (export identifier? syntax-dispatch environment environment?
eval expand generate-temporaries free-identifier=? eval expand generate-temporaries free-identifier=?
bound-identifier=? datum->syntax syntax-error bound-identifier=? datum->syntax syntax-error
syntax-violation
syntax->datum make-variable-transformer syntax->datum make-variable-transformer
eval-r6rs-top-level boot-library-expand eval-top-level eval-r6rs-top-level boot-library-expand eval-top-level
null-environment scheme-report-environment) null-environment scheme-report-environment)
@ -30,7 +31,7 @@
environment environment? identifier? environment environment? identifier?
eval generate-temporaries free-identifier=? eval generate-temporaries free-identifier=?
bound-identifier=? datum->syntax syntax-error bound-identifier=? datum->syntax syntax-error
syntax->datum make-variable-transformer syntax-violation syntax->datum make-variable-transformer
null-environment scheme-report-environment) null-environment scheme-report-environment)
(rnrs base) (rnrs base)
(rnrs lists) (rnrs lists)
@ -3427,7 +3428,6 @@
(error 'syntax-error "invalid argument" args)) (error 'syntax-error "invalid argument" args))
(raise (raise
(condition (condition
;(make-who-condition 'expander)
(make-message-condition (make-message-condition
(if (null? args) (if (null? args)
"invalid syntax" "invalid syntax"
@ -3436,6 +3436,34 @@
(stx->datum x) (stx->datum x)
'none))))) '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 identifier? (lambda (x) (id? x)))
(define datum->syntax (define datum->syntax