[Guile-commits] 01/03: Fix SRFI-2 (and-let*) implementation.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 8ffcd28fde2fab42f1497a33be047f6141bf9b0b
Author: Taylan Ulrich Bayırlı/Kammer <address@hidden>
Date:   Fri Oct 2 22:56:04 2015 +0200

    Fix SRFI-2 (and-let*) implementation.
    
    * module/ice-9/and-let-star.scm (%and-let*): Re-implemented this in a
      more verbose but accurate way.
---
 module/ice-9/and-let-star.scm |   52 ++++++++++++++++++++++++++++++-----------
 1 file changed, 39 insertions(+), 13 deletions(-)

diff --git a/module/ice-9/and-let-star.scm b/module/ice-9/and-let-star.scm
index ff15a7a..2d53ff3 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) 1999, 2001, 2004, 2006, 2013,
+;;;;   2015 Free Software Foundation, Inc.
 ;;;; 
 ;;;; 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* orig-form (rest . rest*) . body))))
+      ((_ orig-form ((expr) rest . rest*) . body)
+       #'(and expr (%and-let* orig-form (rest . rest*) . body)))
+      ((_ orig-form (var rest . rest*) . body)
+       (identifier? #'var)
+       #'(and var (%and-let* orig-form (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*