~ chicken-core (chicken-5) b504261ea6f46680661d296b2a42f52aa39b820f
commit b504261ea6f46680661d296b2a42f52aa39b820f
Author: Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Fri Dec 13 21:50:25 2013 +0100
Commit: Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Sat Dec 14 17:12:24 2013 +0100
Fix #1080
We now simply check whether an "else"-clause was generated before we
generate a catchall else-clause. It's a bit dirty, but it works...
Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 112a0782..5e88bba4 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -884,23 +884,26 @@
(%memv (r 'memv))
(%else (r 'else)))
(define (parse-clause c)
- (let* ([var (and (symbol? (car c)) (car c))]
- [kinds (if var (cadr c) (car c))]
- [body (if var (cddr c) (cdr c))] )
+ (let* ((var (and (symbol? (car c)) (car c)))
+ (kinds (if var (cadr c) (car c)))
+ (body (if var
+ `(##core#let ((,var ,exvar)) ,@(cddr c))
+ `(##core#let () ,@(cdr c)))))
(if (null? kinds)
- `(,%else
- ,(if var
- `(##core#let ([,var ,exvar]) ,@body)
- `(##core#let () ,@body) ) )
- `((,%and ,kvar ,@(map (lambda (k) `(,%memv (##core#quote ,k) ,kvar)) kinds))
- ,(if var
- `(##core#let ([,var ,exvar]) ,@body)
- `(##core#let () ,@body) ) ) ) ) )
+ `(,%else ,body)
+ `((,%and ,kvar ,@(map (lambda (k)
+ `(,%memv (##core#quote ,k) ,kvar)) kinds))
+ ,body ) ) ) )
`(,(r 'handle-exceptions) ,exvar
- (##core#let ([,kvar (,%and (##sys#structure? ,exvar (##core#quote condition) )
- (##sys#slot ,exvar 1))])
- (,(r 'cond) ,@(map parse-clause (cddr form))
- (,%else (##sys#signal ,exvar)) ) )
+ (##core#let ((,kvar (,%and (##sys#structure? ,exvar
+ (##core#quote condition))
+ (##sys#slot ,exvar 1))))
+ ,(let ((clauses (map parse-clause (cddr form))))
+ `(,(r 'cond)
+ ,@clauses
+ ,@(if (assq %else clauses)
+ `() ; Don't generate two else clauses
+ `((,%else (##sys#signal ,exvar)))) )) )
,(cadr form))))))
Trap