[PATCH] Fix and-let*.

[taylanbayirli@gmail.com (Taylan Ulrich Bayırlı/Kammer)]

[-- Attachment #1: Type: text/plain, Size: 211 bytes --]

Our and-let* wasn't entirely conformant to SRFI-2.  It would return #t
for a variety of forms where it should return the last evaluated
expression's value instead.

Here's a patch.  Is the copyright a problem?


[-- Attachment #2: 0001-Fix-and-let.patch --]
[-- Type: text/x-diff, Size: 2996 bytes --]

From e08e9a7e1048c8e0ad58e09585e4b6a071906db3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?=
 <taylanbayirli@gmail.com>
Date: Fri, 2 Oct 2015 22:56:04 +0200
Subject: [PATCH] Fix and-let*.

---
 module/ice-9/and-let-star.scm | 50 ++++++++++++++++++++++++++++++++-----------
 1 file changed, 38 insertions(+), 12 deletions(-)

diff --git a/module/ice-9/and-let-star.scm b/module/ice-9/and-let-star.scm
index ff15a7a..0c12f16 100644
--- a/module/ice-9/and-let-star.scm
+++ b/module/ice-9/and-let-star.scm
@@ -1,6 +1,7 @@
 ;;;; and-let-star.scm --- and-let* syntactic form (SRFI-2) for Guile
 ;;;;
 ;;;; Copyright (C) 1999, 2001, 2004, 2006, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -22,20 +23,45 @@
 (define-syntax %and-let*
   (lambda (form)
     (syntax-case form ()
-      ((_ orig-form ())
-       #'#t)
-      ((_ orig-form () body bodies ...)
-       #'(begin body bodies ...))
-      ((_ orig-form ((var exp) c ...) body ...)
+
+      ;; Handle zero-clauses special-case.
+      ((_ orig-form () . body)
+       #'(begin #t . body))
+
+      ;; Reduce clauses down to one regardless of body.
+      ((_ orig-form ((var expr) rest . rest*) . body)
+       (identifier? #'var)
+       #'(let ((var expr))
+           (and var (%and-let* (rest . rest*) . body))))
+      ((_ orig-form ((expr) rest . rest*) . body)
+       #'(and expr (%and-let* (rest . rest*) . body)))
+      ((_ orig-form (var rest . rest*) . body)
+       (identifier? #'var)
+       #'(and var (%and-let* (rest . rest*) . body)))
+
+      ;; Handle 1-clause cases without a body.
+      ((_ orig-form ((var expr)))
        (identifier? #'var)
-       #'(let ((var exp))
-           (and var (%and-let* orig-form (c ...) body ...))))
-      ((_ orig-form ((exp) c ...) body ...)
-       #'(and exp (%and-let* orig-form (c ...) body ...)))
-      ((_ orig-form (var c ...) body ...)
+       #'expr)
+      ((_ orig-form ((expr)))
+       #'expr)
+      ((_ orig-form (var))
        (identifier? #'var)
-       #'(and var (%and-let* orig-form (c ...) body ...)))
-      ((_ orig-form (bad-clause c ...) body ...)
+       #'var)
+
+      ;; Handle 1-clause cases with a body.
+      ((_ orig-form ((var expr)) . body)
+       (identifier? #'var)
+       #'(let ((var expr))
+           (and var (begin . body))))
+      ((_ orig-form ((expr)) . body)
+       #'(and expr (begin . body)))
+      ((_ orig-form (var) . body)
+       (identifier? #'var)
+       #'(and var (begin . body)))
+
+      ;; Handle bad clauses.
+      ((_ orig-form (bad-clause . rest) . body)
        (syntax-violation 'and-let* "Bad clause" #'orig-form #'bad-clause)))))
 
 (define-syntax and-let*
-- 
2.5.0