~ chicken-core (chicken-5) d143e6eb7aa7fea4272cadec69b4b34ebbd521e0

commit d143e6eb7aa7fea4272cadec69b4b34ebbd521e0
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Fri Oct 17 20:46:15 2014 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sat Oct 18 10:57:28 2014 +1300

    Fix incorrect optimization in cond expansion.
    
    When a constant is used as the condition, the consequence would be
    simply taken as-is (or wrapped in a "begin" if it's multiple
    statements).  However, if there's a => following the constant, it should
    expand to a call of the procedure with the constant as argument.
    
    Reported by Michele La Monaca
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 70b68fa0..00b14751 100644
--- a/NEWS
+++ b/NEWS
@@ -49,6 +49,8 @@
 - Syntax expander
   - define-values, set!-values and letrec-values now support full lambda
     lists as binding forms
+  - cond expands correctly when a constant is used in combination with =>
+     (thanks to Michele La Monaca)
 
 - C API
   - Removed deprecated C_get_argument[_2] and
diff --git a/expand.scm b/expand.scm
index 16a13707..966d4ba1 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1174,9 +1174,12 @@
                          (and (pair? (car clause))
                               (c (r 'quote) (caar clause))))
 		     (expand rclauses (strip-syntax (car clause)))
-		     (if (null? (cdr clause))
-			 (car clause)
-			 `(##core#begin ,@(cdr clause))))
+		     (cond ((and (fx= (length clause) 3)
+				 (c %=> (cadr clause)))
+			    `(,(caddr clause) ,(car clause)))
+			   ((null? (cdr clause))
+			    (car clause))
+			   (else `(##core#begin ,@(cdr clause)))))
 		    ((null? (cdr clause)) 
 		     `(,%or ,(car clause) ,(expand rclauses #f)))
 		    ((and (fx= (length clause) 3)
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index df0f6074..ba9b3fcd 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -196,6 +196,11 @@
 (let ((baz 100))
   (t "no baz" (kw baz)))
 
+;; Optimisation to rewrite constants with =>, reported by Michele La Monaca
+(t 2 (cond (1 2)))
+(f (cond (1 => string-length)))
+(t #t (cond (1 => odd?)))
+
 (t 'ok
 (let ((=> #f))
   (cond (#t => 'ok)))