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
|
interaction-environment
|
||||||
ellipsis-map)
|
ellipsis-map)
|
||||||
(import
|
(import
|
||||||
|
(only (ikarus) printf)
|
||||||
(except (rnrs)
|
(except (rnrs)
|
||||||
environment environment? identifier?
|
environment environment? identifier?
|
||||||
eval generate-temporaries free-identifier=?
|
eval generate-temporaries free-identifier=?
|
||||||
|
@ -1121,10 +1122,28 @@
|
||||||
(define with-syntax-macro
|
(define with-syntax-macro
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(syntax-match e ()
|
(syntax-match e ()
|
||||||
((_ ((fml* expr*) ...) b b* ...)
|
((_ ((pat* expr*) ...) b b* ...)
|
||||||
(bless
|
(let ([idn*
|
||||||
`(syntax-case (list . ,expr*) ()
|
(let f ([pat* pat*])
|
||||||
(,fml* (begin ,b . ,b*))))))))
|
(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)
|
(define (invalid-fmls-error stx fmls)
|
||||||
(syntax-match fmls ()
|
(syntax-match fmls ()
|
||||||
|
|
Loading…
Reference in New Issue