diff --git a/init.scm b/init.scm index a1038829..0a93458b 100644 --- a/init.scm +++ b/init.scm @@ -124,11 +124,11 @@ (if (null? (cdr expr)) #f ((lambda (cl) - (if (compare 'else (car cl)) + (if (compare (rename 'else) (car cl)) (if (pair? (cddr expr)) (error "non-final else in cond" expr) (cons (rename 'begin) (cdr cl))) - (if (if (null? (cdr cl)) #t (compare '=> (cadr cl))) + (if (if (null? (cdr cl)) #t (compare (rename '=>) (cadr cl))) (list (list (rename 'lambda) (list (rename 'tmp)) (list (rename 'if) (rename 'tmp) (if (null? (cdr cl)) @@ -169,20 +169,20 @@ (cond ((pair? x) (cond - ((eq? 'unquote (car x)) + ((compare (rename 'unquote) (car x)) (if (<= d 0) (cadr x) (list (rename 'list) (list (rename 'quote) 'unquote) (qq (cadr x) (- d 1))))) - ((eq? 'unquote-splicing (car x)) + ((compare (rename 'unquote-splicing) (car x)) (if (<= d 0) (list (rename 'cons) (qq (car x) d) (qq (cdr x) d)) (list (rename 'list) (list (rename 'quote) 'unquote-splicing) (qq (cadr x) (- d 1))))) - ((eq? 'quasiquote (car x)) + ((compare (rename 'quasiquote) (car x)) (list (rename 'list) (list (rename 'quote) 'quasiquote) (qq (cadr x) (+ d 1)))) - ((and (<= d 0) (pair? (car x)) (eq? 'unquote-splicing (caar x))) + ((and (<= d 0) (pair? (car x)) (compare (rename 'unquote-splicing) (caar x))) (if (null? (cdr x)) (cadar x) (list (rename 'append) (cadar x) (qq (cdr x) d)))) @@ -243,7 +243,7 @@ (define (clause ls) (cond ((null? ls) #f) - ((compare 'else (caar ls)) + ((compare (rename 'else) (caar ls)) `(,(rename 'begin) ,@(cdar ls))) (else (if (and (pair? (caar ls)) (null? (cdaar ls))) @@ -669,7 +669,7 @@ ((null? p) (list _and (list _null? v) (k vars))) (else (list _and (list _equal? v p) (k vars)))))))) (define (ellipse? x) - (and (pair? x) (pair? (cdr x)) (compare '... (cadr x)))) + (and (pair? x) (pair? (cdr x)) (compare (rename '...) (cadr x)))) (define (ellipse-depth x) (if (ellipse? x) (+ 1 (ellipse-depth (cdr x))) diff --git a/lib/chibi/loop/loop.scm b/lib/chibi/loop/loop.scm index 0c7cc4a5..06326d84 100644 --- a/lib/chibi/loop/loop.scm +++ b/lib/chibi/loop/loop.scm @@ -69,7 +69,7 @@ ;; (er-macro-transformer ;; (lambda (expr rename compare) ;; (receive (named posns) -;; (partition (lambda (x) (and (list? x) (compare (car x) '=>))) +;; (partition (lambda (x) (and (list? x) (compare (car x) (rename '=>)))) ;; (cdr expr)) ;; (let lp ((ls '((arg default) ...)) (posns posns) (args '())) ;; (cond diff --git a/tests/r5rs-tests.scm b/tests/r5rs-tests.scm index 7b881b9d..e6017417 100644 --- a/tests/r5rs-tests.scm +++ b/tests/r5rs-tests.scm @@ -386,6 +386,21 @@ (test '(3 3) (let ((p (delay (+ 1 2)))) (list (force p) (force p)))) +(test 'ok (let ((else 1)) (cond (else 'ok) (#t 'bad)))) + +(test 'ok (let ((=> 1)) (cond (#t => 'ok)))) + +(test '(,foo) (let ((unquote 1)) `(,foo))) + +(test '(,@foo) (let ((unquote-splicing 1)) `(,@foo))) + +(test 'ok + (let ((... 2)) + (let-syntax ((s (syntax-rules () + ((_ x ...) 'bad) + ((_ . r) 'ok)))) + (s a b c)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (test-report)