Fixes bug 181105: syntax pattern variable list length mismatch error

is obscure
This commit is contained in:
Abdulaziz Ghuloum 2008-01-09 08:47:48 -05:00
parent 62765c2885
commit 4444496609
4 changed files with 160 additions and 144 deletions

Binary file not shown.

View File

@ -1 +1 @@
1334 1335

View File

@ -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)

View File

@ -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