diff --git a/TODO b/TODO index 8cb51490..8c59ef19 100644 --- a/TODO +++ b/TODO @@ -30,7 +30,7 @@ ** TODO unsafe operations Possibly, don't want to make things too complicated or unstable. ** TODO plugin infrastructure -** TODO type inference with warning +** TODO type inference with warnings * macros ** DONE hygiene @@ -39,7 +39,8 @@ - State "DONE" [2009-12-08 Tue 14:41] ** DONE macroexpand utility - State "DONE" [2009-12-08 Tue 14:41] -** TODO SRFI-46 basic syntax-rules extensions +** DONE SRFI-46 basic syntax-rules extensions + - State "DONE" [2009-12-26 Sat 07:59] ** DONE (... ...) support - State "DONE" [2009-12-26 Sat 02:06] ** TODO compiler macros diff --git a/lib/config.scm b/lib/config.scm index 461a6351..0993a3e3 100644 --- a/lib/config.scm +++ b/lib/config.scm @@ -164,5 +164,8 @@ (list (cons '(scheme) (make-module #f (interaction-environment) '())) (cons '(srfi 0) (make-module (list 'cond-expand) (interaction-environment) - (list (list 'export 'cond-expand)))))) + (list (list 'export 'cond-expand)))) + (cons '(srfi 46) (make-module (list 'syntax-rules) + (interaction-environment) + (list (list 'export 'syntax-rules)))))) diff --git a/lib/init.scm b/lib/init.scm index 3c4f9491..8bcc7491 100644 --- a/lib/init.scm +++ b/lib/init.scm @@ -630,7 +630,9 @@ (_append (rename 'append)) (_map (rename 'map)) (_vector? (rename 'vector?)) (_list? (rename 'list?)) (_lp (rename 'lp)) (_reverse (rename 'reverse)) - (_error (rename 'error)) + (_len (rename'len)) (_length (rename 'length)) + (_- (rename '-)) (_>= (rename '>=)) (_error (rename 'error)) + (_ls (rename 'ls)) (_res (rename 'res)) (_i (rename 'i)) (_vector->list (rename 'vector->list)) (_list->vector (rename 'list->vector))) (define ellipse (rename (if ellipse-specified? (cadr expr) '...))) @@ -658,7 +660,28 @@ ((ellipse? p) (cond ((not (null? (cddr p))) - (error "non-trailing ellipse")) + (cond + ((not (list? (cddr p))) + (error "dotted ellipse" p)) + ((any (lambda (x) (and (identifier? x) (compare x ellipse))) + (cddr p)) + (error "multiple ellipses" p)) + (else + (let ((len (length (cdr (cdr p))))) + `(,_let ((,_len (,_length ,v))) + (,_and (,_>= ,_len ,len) + (,_let ,_lp ((,_ls ,v) + (,_i (,_- ,_len ,len)) + (,_res (,_quote ()))) + (,_if (,_>= 0 ,_i) + ,(lp `(,@(cdr (cdr p)) ,(car p) ,(car (cdr p))) + `(,_append ,_ls (,_reverse ,_res)) + dim + vars + k) + (,_lp (,_cdr ,_ls) + (,_- ,_i 1) + (,_cons (,_car ,_ls) ,_res)))))))))) ((identifier? (car p)) (list _and (list _list? v) (list _let (list (list (car p) v)) diff --git a/tests/r5rs-tests.scm b/tests/r5rs-tests.scm index c657be99..c35d71df 100644 --- a/tests/r5rs-tests.scm +++ b/tests/r5rs-tests.scm @@ -465,6 +465,13 @@ (args ::: ...))))) (foo 3 - 5))) +(test '(5 4 1 2 3) + (let-syntax + ((foo (syntax-rules () + ((foo args ... penultimate ultimate) + (list ultimate penultimate args ...))))) + (foo 1 2 3 4 5))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (test-report)