~ 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