Fixes bug 181105: syntax pattern variable list length mismatch error
is obscure
This commit is contained in:
parent
62765c2885
commit
4444496609
Binary file not shown.
|
@ -1 +1 @@
|
||||||
1334
|
1335
|
||||||
|
|
|
@ -1382,6 +1382,7 @@
|
||||||
[make-i/o-would-block-condition i]
|
[make-i/o-would-block-condition i]
|
||||||
[i/o-would-block-condition? i]
|
[i/o-would-block-condition? i]
|
||||||
[i/o-would-block-port i]
|
[i/o-would-block-port i]
|
||||||
|
[ellipsis-map ]
|
||||||
))
|
))
|
||||||
|
|
||||||
(define (macro-identifier? x)
|
(define (macro-identifier? x)
|
||||||
|
|
|
@ -25,7 +25,7 @@
|
||||||
syntax-violation
|
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 ellipsis-map)
|
||||||
(import
|
(import
|
||||||
(except (rnrs)
|
(except (rnrs)
|
||||||
environment environment? identifier?
|
environment environment? identifier?
|
||||||
|
@ -2226,6 +2226,21 @@
|
||||||
(build-lambda no-source (list x) body)
|
(build-lambda no-source (list x) body)
|
||||||
(list (chi-expr expr r mr)))))))))))
|
(list (chi-expr expr r mr)))))))))))
|
||||||
|
|
||||||
|
(define (ellipsis-map proc ls . ls*)
|
||||||
|
(define who '...)
|
||||||
|
(unless (list? ls)
|
||||||
|
(assertion-violation who "not a list" ls))
|
||||||
|
(unless (null? ls*)
|
||||||
|
(let ([n (length ls)])
|
||||||
|
(for-each
|
||||||
|
(lambda (x)
|
||||||
|
(unless (list? x)
|
||||||
|
(assertion-violation who "not a list" x))
|
||||||
|
(unless (= (length x) n)
|
||||||
|
(assertion-violation who "length mismatch" ls x)))
|
||||||
|
ls*)))
|
||||||
|
(apply map proc ls ls*))
|
||||||
|
|
||||||
(define syntax-transformer
|
(define syntax-transformer
|
||||||
(let ()
|
(let ()
|
||||||
(define gen-syntax
|
(define gen-syntax
|
||||||
|
@ -2358,7 +2373,7 @@
|
||||||
((map)
|
((map)
|
||||||
(let ((ls (map regen (cdr x))))
|
(let ((ls (map regen (cdr x))))
|
||||||
(build-application no-source
|
(build-application no-source
|
||||||
(build-primref no-source 'map)
|
(build-primref no-source 'ellipsis-map)
|
||||||
ls)))
|
ls)))
|
||||||
(else
|
(else
|
||||||
(build-application no-source
|
(build-application no-source
|
||||||
|
|
Loading…
Reference in New Issue