[PATCH] Fix and-let*.

[PATCH] Fix and-let*.

[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

Re: [PATCH] Fix and-let*.

[Mark H Weaver]

taylanbayirli@gmail.com (Taylan Ulrich "Bayırlı/Kammer") writes:

> 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.

Can you give some examples that demonstrate the problem?

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

Yes, our policy is to assign copyright to the FSF.

      Mark

Re: [PATCH] Fix and-let*.

[Mark H Weaver]

Mark H Weaver <mhw@netris.org> writes:

> taylanbayirli@gmail.com (Taylan Ulrich "Bayırlı/Kammer") writes:
>
>> 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.
>
> Can you give some examples that demonstrate the problem?

Nevermind, I see the problem.  We don't properly handle the case with
clauses but no body.  The bug was introduced in commit
0bf4a5fc2ea456ed74d45f52e2f1dd08d5e1fb9e.

taylanbayirli@gmail.com (Taylan Ulrich "Bayırlı/Kammer") writes:

> 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(-)

This needs a commit log in accordance with our conventions.

> 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))))

For improved error reporting, the '%and-let*' auxiliary macro accepts
the entire original form 'orig-form' as its first operand.  Here, and in
several other places, you forgot to pass 'orig-form' down to the
recursive use of '%and-let*'.  As a result, I guess this rewritten macro
is broken for all cases with more than one clause.

Anyway, are you willing to assign copyright to the FSF for your
contributions to Guile?  If so, we can get that process started.

     Thanks,
       Mark

Re: [PATCH] Fix and-let*.

[Taylan Ulrich Bayırlı/Kammer]

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

Mark H Weaver <mhw@netris.org> writes:

>> [...]
>
> For improved error reporting, the '%and-let*' auxiliary macro accepts
> the entire original form 'orig-form' as its first operand.  Here, and in
> several other places, you forgot to pass 'orig-form' down to the
> recursive use of '%and-let*'.  As a result, I guess this rewritten macro
> is broken for all cases with more than one clause.

Ouch, mistake during mechanic transformation from my syntax-rules
version.  Fixed patch attached.

I guess it would be best to port the test suite too.  The second
attached patch adds a Guile-adapted version of the test suite linked
from the SRFI page.

> Anyway, are you willing to assign copyright to the FSF for your
> contributions to Guile?  If so, we can get that process started.

Definitely. :-)

Tell me what's needed.

I guess they'll have to wait but here's the patches, with only FSF
copyright headers in the files:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-SRFI-2-and-let-implementation.patch --]
[-- Type: text/x-diff, Size: 2983 bytes --]

From 7d484e076e237d6522ca53474fb9d180472a9f54 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 1/3] Fix SRFI-2 (and-let*) implementation.

---
 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*
-- 
2.5.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Add-SRFI-2-and-let-test-suite.patch --]
[-- Type: text/x-diff, Size: 4458 bytes --]

From f8df7d91ee5ea110a03d7aa6c71f5954ebb74494 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?=
 <taylanbayirli@gmail.com>
Date: Sat, 3 Oct 2015 11:39:27 +0200
Subject: [PATCH 2/3] Add SRFI-2 (and-let*) test suite.

---
 test-suite/Makefile.am       |  1 +
 test-suite/tests/srfi-2.test | 77 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 78 insertions(+)
 create mode 100644 test-suite/tests/srfi-2.test

diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 3b10353..c0c79cb 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -125,6 +125,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/sort.test			\
 	    tests/srcprop.test			\
 	    tests/srfi-1.test			\
+	    tests/srfi-2.test			\
 	    tests/srfi-6.test			\
 	    tests/srfi-10.test			\
 	    tests/srfi-11.test			\
diff --git a/test-suite/tests/srfi-2.test b/test-suite/tests/srfi-2.test
new file mode 100644
index 0000000..b8de21d
--- /dev/null
+++ b/test-suite/tests/srfi-2.test
@@ -0,0 +1,77 @@
+;;;; srfi-2.test --- Test suite for Guile's and-let* macro. -*- scheme -*-
+;;;;
+;;;; Copyright (C) 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
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-srfi-2)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-2))
+
+(pass-if-equal 1 (and-let* () 1))
+(pass-if-equal 2 (and-let* () 1 2))
+(pass-if-equal #t (and-let* ()))
+
+(pass-if-equal #f (let ((x #f)) (and-let* (x))))
+(pass-if-equal 1 (let ((x 1)) (and-let* (x))))
+(pass-if-equal #f (and-let* ((x #f))))
+(pass-if-equal 1 (and-let* ((x 1))))
+(pass-if-exception "bad clause" '(syntax-error . "Bad clause")
+  (eval '(and-let* (#f (x 1))) (current-module)))
+(pass-if-equal #f (and-let* ((#f) (x 1))))
+(pass-if-exception "bad clause" '(syntax-error . "Bad clause")
+  (eval '(and-let* (2 (x 1))) (current-module)))
+(pass-if-equal 1 (and-let* ((2) (x 1))))
+(pass-if-equal 2 (and-let* ((x 1) (2))))
+(pass-if-equal #f (let ((x #f)) (and-let* (x) x)))
+(pass-if-equal "" (let ((x "")) (and-let* (x) x)))
+(pass-if-equal "" (let ((x "")) (and-let* (x))))
+(pass-if-equal 2 (let ((x 1)) (and-let* (x) (+ x 1))))
+(pass-if-equal #f (let ((x #f)) (and-let* (x) (+ x 1))))
+(pass-if-equal 2 (let ((x 1)) (and-let* (((positive? x))) (+ x 1))))
+(pass-if-equal #t (let ((x 1)) (and-let* (((positive? x))))))
+(pass-if-equal #f (let ((x 0)) (and-let* (((positive? x))) (+ x 1))))
+(pass-if-equal 3
+    (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1))) (+ x 1))))
+
+;; This is marked as must-be-error in the original test suite, but
+;; that's a mistake of the SRFI author who thinks that rebinding
+;; variables in let* is an error; in fact it's allowed in let*
+;; (explicitly since R6RS), so it should be allowed by and-let* too.
+(pass-if-equal 4
+    (let ((x 1))
+      (and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))
+
+(pass-if-equal 2
+    (let ((x 1)) (and-let* (x ((positive? x))) (+ x 1))))
+(pass-if-equal 2
+    (let ((x 1)) (and-let* (((begin x)) ((positive? x))) (+ x 1))))
+(pass-if-equal #f
+    (let ((x 0)) (and-let* (x ((positive? x))) (+ x 1))))
+(pass-if-equal #f
+    (let ((x #f)) (and-let* (x ((positive? x))) (+ x 1))))
+(pass-if-equal #f
+    (let ((x #f)) (and-let* (((begin x)) ((positive? x))) (+ x 1))))
+
+(pass-if-equal #f
+    (let ((x 1)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(pass-if-equal #f
+    (let ((x 0)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(pass-if-equal #f
+    (let ((x #f)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(pass-if-equal 3/2
+    (let ((x 3)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+
+;;; srfi-2.test ends here
-- 
2.5.0

Re: [PATCH] Fix and-let*.

[Taylan Ulrich Bayırlı/Kammer]

taylanbayirli@gmail.com (Taylan Ulrich "Bayırlı/Kammer") writes:

> Mark H Weaver <mhw@netris.org> writes:
>
>> Anyway, are you willing to assign copyright to the FSF for your
>> contributions to Guile?  If so, we can get that process started.
>
> Definitely. :-)
>
> Tell me what's needed.
>
> I guess they'll have to wait but here's the patches, with only FSF
> copyright headers in the files:
>
> [...]

Pinging this thread since my copyright assignment is now complete. :-)

Taylan

Re: [PATCH] Fix and-let*.

[Taylan Ulrich Bayırlı/Kammer]

taylanbayirli@gmail.com (Taylan Ulrich "Bayırlı/Kammer") writes:

> Pinging this thread since my copyright assignment is now complete. :-)

Gently pinging this again since it's been a while...

Re: [PATCH] Fix and-let*.

[Taylan Ulrich Bayırlı/Kammer]

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

Pinging this thread at Andy's request. :-)

Here's the two patches:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-SRFI-2-and-let-implementation.patch --]
[-- Type: text/x-diff, Size: 2983 bytes --]

From 8405987e86cd99772f81f98565e66f673e82d57e 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 1/2] Fix SRFI-2 (and-let*) implementation.

---
 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*
-- 
2.8.4


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Add-SRFI-2-and-let-test-suite.patch --]
[-- Type: text/x-diff, Size: 4458 bytes --]

From 65478567a67f89e88a8fe64136c34c3c95a214b4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?=
 <taylanbayirli@gmail.com>
Date: Sat, 3 Oct 2015 11:39:27 +0200
Subject: [PATCH 2/2] Add SRFI-2 (and-let*) test suite.

---
 test-suite/Makefile.am       |  1 +
 test-suite/tests/srfi-2.test | 77 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 78 insertions(+)
 create mode 100644 test-suite/tests/srfi-2.test

diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 3b10353..c0c79cb 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -125,6 +125,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/sort.test			\
 	    tests/srcprop.test			\
 	    tests/srfi-1.test			\
+	    tests/srfi-2.test			\
 	    tests/srfi-6.test			\
 	    tests/srfi-10.test			\
 	    tests/srfi-11.test			\
diff --git a/test-suite/tests/srfi-2.test b/test-suite/tests/srfi-2.test
new file mode 100644
index 0000000..b8de21d
--- /dev/null
+++ b/test-suite/tests/srfi-2.test
@@ -0,0 +1,77 @@
+;;;; srfi-2.test --- Test suite for Guile's and-let* macro. -*- scheme -*-
+;;;;
+;;;; Copyright (C) 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
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-srfi-2)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-2))
+
+(pass-if-equal 1 (and-let* () 1))
+(pass-if-equal 2 (and-let* () 1 2))
+(pass-if-equal #t (and-let* ()))
+
+(pass-if-equal #f (let ((x #f)) (and-let* (x))))
+(pass-if-equal 1 (let ((x 1)) (and-let* (x))))
+(pass-if-equal #f (and-let* ((x #f))))
+(pass-if-equal 1 (and-let* ((x 1))))
+(pass-if-exception "bad clause" '(syntax-error . "Bad clause")
+  (eval '(and-let* (#f (x 1))) (current-module)))
+(pass-if-equal #f (and-let* ((#f) (x 1))))
+(pass-if-exception "bad clause" '(syntax-error . "Bad clause")
+  (eval '(and-let* (2 (x 1))) (current-module)))
+(pass-if-equal 1 (and-let* ((2) (x 1))))
+(pass-if-equal 2 (and-let* ((x 1) (2))))
+(pass-if-equal #f (let ((x #f)) (and-let* (x) x)))
+(pass-if-equal "" (let ((x "")) (and-let* (x) x)))
+(pass-if-equal "" (let ((x "")) (and-let* (x))))
+(pass-if-equal 2 (let ((x 1)) (and-let* (x) (+ x 1))))
+(pass-if-equal #f (let ((x #f)) (and-let* (x) (+ x 1))))
+(pass-if-equal 2 (let ((x 1)) (and-let* (((positive? x))) (+ x 1))))
+(pass-if-equal #t (let ((x 1)) (and-let* (((positive? x))))))
+(pass-if-equal #f (let ((x 0)) (and-let* (((positive? x))) (+ x 1))))
+(pass-if-equal 3
+    (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1))) (+ x 1))))
+
+;; This is marked as must-be-error in the original test suite, but
+;; that's a mistake of the SRFI author who thinks that rebinding
+;; variables in let* is an error; in fact it's allowed in let*
+;; (explicitly since R6RS), so it should be allowed by and-let* too.
+(pass-if-equal 4
+    (let ((x 1))
+      (and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))
+
+(pass-if-equal 2
+    (let ((x 1)) (and-let* (x ((positive? x))) (+ x 1))))
+(pass-if-equal 2
+    (let ((x 1)) (and-let* (((begin x)) ((positive? x))) (+ x 1))))
+(pass-if-equal #f
+    (let ((x 0)) (and-let* (x ((positive? x))) (+ x 1))))
+(pass-if-equal #f
+    (let ((x #f)) (and-let* (x ((positive? x))) (+ x 1))))
+(pass-if-equal #f
+    (let ((x #f)) (and-let* (((begin x)) ((positive? x))) (+ x 1))))
+
+(pass-if-equal #f
+    (let ((x 1)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(pass-if-equal #f
+    (let ((x 0)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(pass-if-equal #f
+    (let ((x #f)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(pass-if-equal 3/2
+    (let ((x 3)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+
+;;; srfi-2.test ends here
-- 
2.8.4

Re: [PATCH] Fix and-let*.

[Andy Wingo]

On Tue 21 Jun 2016 00:38, taylanbayirli@gmail.com (Taylan Ulrich "Bayırlı/Kammer") writes:

> From 8405987e86cd99772f81f98565e66f673e82d57e 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 1/2] Fix SRFI-2 (and-let*) implementation.
>
> ---
>  module/ice-9/and-let-star.scm | 52 ++++++++++++++++++++++++++++++++-----------
>  1 file changed, 39 insertions(+), 13 deletions(-)

Please fix the commit log.  Thanks :)

Andy

Re: [PATCH] Fix and-let*.

[Taylan Ulrich Bayırlı/Kammer]

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

Andy Wingo <wingo@pobox.com> writes:

> Please fix the commit log.  Thanks :)

Whoops, here we go:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-SRFI-2-and-let-implementation.patch --]
[-- Type: text/x-diff, Size: 3086 bytes --]

From 232757c7f99d39beb16a09cd81a94670f6249ba2 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 1/2] 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*
-- 
2.8.4


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Add-SRFI-2-and-let-test-suite.patch --]
[-- Type: text/x-diff, Size: 4546 bytes --]

From 527bc1821a4ce1cd007c2f07355eebd196a753cc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?=
 <taylanbayirli@gmail.com>
Date: Sat, 3 Oct 2015 11:39:27 +0200
Subject: [PATCH 2/2] Add SRFI-2 (and-let*) test suite.

* test-suite/tests/srfi-2.test: New file.
* test-suite/Makefile.am (SCM_TESTS): Add it.
---
 test-suite/Makefile.am       |  1 +
 test-suite/tests/srfi-2.test | 77 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 78 insertions(+)
 create mode 100644 test-suite/tests/srfi-2.test

diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 3b10353..c0c79cb 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -125,6 +125,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/sort.test			\
 	    tests/srcprop.test			\
 	    tests/srfi-1.test			\
+	    tests/srfi-2.test			\
 	    tests/srfi-6.test			\
 	    tests/srfi-10.test			\
 	    tests/srfi-11.test			\
diff --git a/test-suite/tests/srfi-2.test b/test-suite/tests/srfi-2.test
new file mode 100644
index 0000000..b8de21d
--- /dev/null
+++ b/test-suite/tests/srfi-2.test
@@ -0,0 +1,77 @@
+;;;; srfi-2.test --- Test suite for Guile's and-let* macro. -*- scheme -*-
+;;;;
+;;;; Copyright (C) 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
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-srfi-2)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-2))
+
+(pass-if-equal 1 (and-let* () 1))
+(pass-if-equal 2 (and-let* () 1 2))
+(pass-if-equal #t (and-let* ()))
+
+(pass-if-equal #f (let ((x #f)) (and-let* (x))))
+(pass-if-equal 1 (let ((x 1)) (and-let* (x))))
+(pass-if-equal #f (and-let* ((x #f))))
+(pass-if-equal 1 (and-let* ((x 1))))
+(pass-if-exception "bad clause" '(syntax-error . "Bad clause")
+  (eval '(and-let* (#f (x 1))) (current-module)))
+(pass-if-equal #f (and-let* ((#f) (x 1))))
+(pass-if-exception "bad clause" '(syntax-error . "Bad clause")
+  (eval '(and-let* (2 (x 1))) (current-module)))
+(pass-if-equal 1 (and-let* ((2) (x 1))))
+(pass-if-equal 2 (and-let* ((x 1) (2))))
+(pass-if-equal #f (let ((x #f)) (and-let* (x) x)))
+(pass-if-equal "" (let ((x "")) (and-let* (x) x)))
+(pass-if-equal "" (let ((x "")) (and-let* (x))))
+(pass-if-equal 2 (let ((x 1)) (and-let* (x) (+ x 1))))
+(pass-if-equal #f (let ((x #f)) (and-let* (x) (+ x 1))))
+(pass-if-equal 2 (let ((x 1)) (and-let* (((positive? x))) (+ x 1))))
+(pass-if-equal #t (let ((x 1)) (and-let* (((positive? x))))))
+(pass-if-equal #f (let ((x 0)) (and-let* (((positive? x))) (+ x 1))))
+(pass-if-equal 3
+    (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1))) (+ x 1))))
+
+;; This is marked as must-be-error in the original test suite, but
+;; that's a mistake of the SRFI author who thinks that rebinding
+;; variables in let* is an error; in fact it's allowed in let*
+;; (explicitly since R6RS), so it should be allowed by and-let* too.
+(pass-if-equal 4
+    (let ((x 1))
+      (and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))
+
+(pass-if-equal 2
+    (let ((x 1)) (and-let* (x ((positive? x))) (+ x 1))))
+(pass-if-equal 2
+    (let ((x 1)) (and-let* (((begin x)) ((positive? x))) (+ x 1))))
+(pass-if-equal #f
+    (let ((x 0)) (and-let* (x ((positive? x))) (+ x 1))))
+(pass-if-equal #f
+    (let ((x #f)) (and-let* (x ((positive? x))) (+ x 1))))
+(pass-if-equal #f
+    (let ((x #f)) (and-let* (((begin x)) ((positive? x))) (+ x 1))))
+
+(pass-if-equal #f
+    (let ((x 1)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(pass-if-equal #f
+    (let ((x 0)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(pass-if-equal #f
+    (let ((x #f)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(pass-if-equal 3/2
+    (let ((x 3)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+
+;;; srfi-2.test ends here
-- 
2.8.4