with-syntax now gives more informative error messages:
> (with-syntax ([(x y) #'(a 1)] [(q) #'(a b c)]) 12) Unhandled exception Condition components: 1. &assertion 2. &who: with-syntax 3. &message: "pattern does not match value" 4. &irritants: ((q) #<syntax (a b c)>) instead of the previous behavior: > (with-syntax ([(x y) #'(a 1)] [(q) #'(a b c)]) 12) Unhandled exception Condition components: 1. &message: "invalid syntax" 2. &syntax: form: ((a 1) (a b c)) subform: #f
This commit is contained in:
parent
373edfc969
commit
3f9b567a5b
|
@ -1 +1 @@
|
|||
1465
|
||||
1466
|
||||
|
|
|
@ -29,6 +29,7 @@
|
|||
interaction-environment
|
||||
ellipsis-map)
|
||||
(import
|
||||
(only (ikarus) printf)
|
||||
(except (rnrs)
|
||||
environment environment? identifier?
|
||||
eval generate-temporaries free-identifier=?
|
||||
|
@ -1121,11 +1122,29 @@
|
|||
(define with-syntax-macro
|
||||
(lambda (e)
|
||||
(syntax-match e ()
|
||||
((_ ((fml* expr*) ...) b b* ...)
|
||||
(bless
|
||||
`(syntax-case (list . ,expr*) ()
|
||||
(,fml* (begin ,b . ,b*))))))))
|
||||
|
||||
((_ ((pat* expr*) ...) b b* ...)
|
||||
(let ([idn*
|
||||
(let f ([pat* pat*])
|
||||
(cond
|
||||
[(null? pat*) '()]
|
||||
[else
|
||||
(let-values ([(pat idn*) (convert-pattern (car pat*) '())])
|
||||
(append idn* (f (cdr pat*))))]))])
|
||||
(verify-formals (map car idn*) e)
|
||||
(let ([t* (generate-temporaries expr*)])
|
||||
(bless
|
||||
`(let ,(map list t* expr*)
|
||||
,(let f ([pat* pat*] [t* t*])
|
||||
(cond
|
||||
[(null? pat*) `(begin #f ,b . ,b*)]
|
||||
[else
|
||||
`(syntax-case ,(car t*) ()
|
||||
[,(car pat*) ,(f (cdr pat*) (cdr t*))]
|
||||
[_ (assertion-violation 'with-syntax
|
||||
"pattern does not match value"
|
||||
',(car pat*)
|
||||
,(car t*))])]))))))))))
|
||||
|
||||
(define (invalid-fmls-error stx fmls)
|
||||
(syntax-match fmls ()
|
||||
[(id* ... . last)
|
||||
|
@ -3767,7 +3786,7 @@
|
|||
(assertion-violation 'bound-identifier=? "not an identifier" y))
|
||||
(assertion-violation 'bound-identifier=? "not an identifier" x))))
|
||||
|
||||
(define (extract-position-condition x)
|
||||
(define (extract-position-condition x)
|
||||
(define-condition-type &source-information &condition
|
||||
make-source-condition source-condition?
|
||||
(file-name source-filename)
|
||||
|
|
Loading…
Reference in New Issue