~ chicken-core (chicken-5) 674bdc04476176c18a5525d30e1e0c6f01eb0df0
commit 674bdc04476176c18a5525d30e1e0c6f01eb0df0 Author: felix <felix@call-with-current-continuation.org> AuthorDate: Mon Mar 14 07:46:54 2011 +0100 Commit: felix <felix@call-with-current-continuation.org> CommitDate: Mon Mar 14 07:46:54 2011 +0100 matches for qq-simplification were broken - thanks to syn for providing testcase diff --git a/expand.scm b/expand.scm index 03d5c91d..cd3b823c 100644 --- a/expand.scm +++ b/expand.scm @@ -1406,20 +1406,20 @@ (else `(##sys#cons ,(walk head n) ,(walk tail n)) ) ) ) ) ) ) (define (simplify x) - (cond ((match-expression x '(##sys#cons a '()) '(a)) + (cond ((match-expression x '(##sys#cons a (##core#quote ())) '(a)) => (lambda (env) (simplify `(##sys#list ,(cdr (assq 'a env))))) ) ((match-expression x '(##sys#cons a (##sys#list . b)) '(a b)) => (lambda (env) - (let ([bxs (assq 'b env)]) + (let ((bxs (assq 'b env))) (if (fx< (length bxs) 32) - (simplify `(##sys#list ,(cdr(assq 'a env)) ,@(cdr bxs) ) ) + (simplify `(##sys#list ,(cdr (assq 'a env)) ,@(cdr bxs) ) ) x) ) ) ) ((match-expression x '(##sys#cons a b) '(a b)) => (lambda (env) `(##sys#cons - (simplify (cdr (assq 'a env))) - (simplify (cdr (assq 'b env)))))) - ((match-expression x '(##sys#append a '()) '(a)) + ,(simplify (cdr (assq 'a env))) + ,(simplify (cdr (assq 'b env)))))) + ((match-expression x '(##sys#append a (##core#quote ())) '(a)) => (lambda (env) (cdr (assq 'a env))) ) (else x) ) ) (##sys#check-syntax 'quasiquote form '(_ _))Trap