When an alternate syntax-rules ellipsis is specified, we must bind this

locally around the macro transformer.  Fixes issue #313.
This commit is contained in:
Alex Shinn 2016-03-02 23:34:39 +09:00
parent 38385c52eb
commit 97297221fa
2 changed files with 242 additions and 222 deletions

View file

@ -669,9 +669,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; syntax-rules ;; syntax-rules
(define-syntax syntax-rules (define (syntax-rules-transformer expr rename compare)
(er-macro-transformer
(lambda (expr rename compare)
(let ((ellipsis-specified? (identifier? (cadr expr))) (let ((ellipsis-specified? (identifier? (cadr expr)))
(count 0) (count 0)
(_er-macro-transformer (rename 'er-macro-transformer)) (_er-macro-transformer (rename 'er-macro-transformer))
@ -693,7 +691,7 @@
(_vector->list (rename 'vector->list)) (_vector->list (rename 'vector->list))
(_list->vector (rename 'list->vector)) (_list->vector (rename 'list->vector))
(_cons3 (rename 'cons-source))) (_cons3 (rename 'cons-source)))
(define ellipsis (if ellipsis-specified? (cadr expr) (rename '...))) (define ellipsis (if ellipsis-specified? (cadr expr) '...))
(define lits (if ellipsis-specified? (car (cddr expr)) (cadr expr))) (define lits (if ellipsis-specified? (car (cddr expr)) (cadr expr)))
(define forms (if ellipsis-specified? (cdr (cddr expr)) (cddr expr))) (define forms (if ellipsis-specified? (cdr (cddr expr)) (cddr expr)))
(define (next-symbol s) (define (next-symbol s)
@ -893,7 +891,18 @@
(list _cons (list _cons
(list _error "no expansion for" (list _error "no expansion for"
(list (rename 'strip-syntactic-closures) _expr)) (list (rename 'strip-syntactic-closures) _expr))
#f))))))))))) #f)))))))))
(define-syntax syntax-rules/aux
(er-macro-transformer syntax-rules-transformer))
(define-syntax syntax-rules
(er-macro-transformer
(lambda (expr rename compare)
(if (identifier? (cadr expr))
(list (rename 'let) (list (list (cadr expr) #t))
(cons (rename 'syntax-rules/aux) (cdr expr)))
(syntax-rules-transformer expr rename compare)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; additional syntax ;; additional syntax

View file

@ -57,4 +57,15 @@
((N y E2) (quote (y E2))))) ((N y E2) (quote (y E2)))))
(test '(1 2 3) (N 1 2 3))) (test '(1 2 3) (N 1 2 3)))
(define-syntax ell
(syntax-rules ()
((ell body)
(define-syntax emm
(syntax-rules ...1 ()
((emm) body))))))
(ell
(define-syntax enn
(syntax-rules ...1 () ((enn args ...1) (quote (args ...1))))))
(test-end) (test-end)