~ chicken-core (chicken-5) 26e69a72a9ee989e4136405d6480a424a25f4d14
commit 26e69a72a9ee989e4136405d6480a424a25f4d14
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Mar 14 07:35:23 2011 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Mar 14 07:35:23 2011 +0100
qq-simplification didn't recurse into uses of ##sys#cons
diff --git a/expand.scm b/expand.scm
index 8efd4460..03d5c91d 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1407,16 +1407,20 @@
`(##sys#cons ,(walk head n) ,(walk tail n)) ) ) ) ) ) )
(define (simplify x)
(cond ((match-expression x '(##sys#cons a '()) '(a))
- => (lambda (env) (simplify `(##sys#list ,(##sys#slot (assq 'a env) 1)))) )
+ => (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)])
(if (fx< (length bxs) 32)
- (simplify `(##sys#list ,(##sys#slot (assq 'a env) 1)
- ,@(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))
- => (lambda (env) (##sys#slot (assq 'a env) 1)) )
+ => (lambda (env) (cdr (assq 'a env))) )
(else x) ) )
(##sys#check-syntax 'quasiquote form '(_ _))
(walk (cadr form) 0) ) ) ) )
diff --git a/library.scm b/library.scm
index 2c64448b..386fcd8d 100644
--- a/library.scm
+++ b/library.scm
@@ -3920,7 +3920,9 @@ EOF
(define (make-composite-condition c1 . conds)
(let ([conds (cons c1 conds)])
- (for-each (lambda (c) (##sys#check-structure c 'condition 'make-composite-condition)) conds)
+ (for-each
+ (lambda (c) (##sys#check-structure c 'condition 'make-composite-condition))
+ conds)
(##sys#make-structure
'condition
(apply ##sys#append (map (lambda (c) (##sys#slot c 1)) conds))
Trap