* [PATCH] Fix and-let*. @ 2015-10-02 21:18 Taylan Ulrich Bayırlı/Kammer 2015-10-02 22:03 ` Mark H Weaver 2015-10-02 22:37 ` Mark H Weaver 0 siblings, 2 replies; 9+ messages in thread From: Taylan Ulrich Bayırlı/Kammer @ 2015-10-02 21:18 UTC (permalink / raw) To: guile-devel [-- 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 ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] Fix and-let*. 2015-10-02 21:18 [PATCH] Fix and-let* Taylan Ulrich Bayırlı/Kammer @ 2015-10-02 22:03 ` Mark H Weaver 2015-10-02 22:37 ` Mark H Weaver 1 sibling, 0 replies; 9+ messages in thread From: Mark H Weaver @ 2015-10-02 22:03 UTC (permalink / raw) To: Taylan Ulrich "Bayırlı/Kammer"; +Cc: guile-devel 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 ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] Fix and-let*. 2015-10-02 21:18 [PATCH] Fix and-let* Taylan Ulrich Bayırlı/Kammer 2015-10-02 22:03 ` Mark H Weaver @ 2015-10-02 22:37 ` Mark H Weaver 2015-10-03 9:48 ` Taylan Ulrich Bayırlı/Kammer 1 sibling, 1 reply; 9+ messages in thread From: Mark H Weaver @ 2015-10-02 22:37 UTC (permalink / raw) To: Taylan Ulrich "Bayırlı/Kammer"; +Cc: guile-devel 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 ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] Fix and-let*. 2015-10-02 22:37 ` Mark H Weaver @ 2015-10-03 9:48 ` Taylan Ulrich Bayırlı/Kammer 2015-10-17 12:37 ` Taylan Ulrich Bayırlı/Kammer 0 siblings, 1 reply; 9+ messages in thread From: Taylan Ulrich Bayırlı/Kammer @ 2015-10-03 9:48 UTC (permalink / raw) To: Mark H Weaver; +Cc: guile-devel [-- 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 ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] Fix and-let*. 2015-10-03 9:48 ` Taylan Ulrich Bayırlı/Kammer @ 2015-10-17 12:37 ` Taylan Ulrich Bayırlı/Kammer 2015-12-03 9:01 ` Taylan Ulrich Bayırlı/Kammer 0 siblings, 1 reply; 9+ messages in thread From: Taylan Ulrich Bayırlı/Kammer @ 2015-10-17 12:37 UTC (permalink / raw) To: Mark H Weaver; +Cc: guile-devel 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 ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] Fix and-let*. 2015-10-17 12:37 ` Taylan Ulrich Bayırlı/Kammer @ 2015-12-03 9:01 ` Taylan Ulrich Bayırlı/Kammer 2016-06-20 22:38 ` Taylan Ulrich Bayırlı/Kammer 0 siblings, 1 reply; 9+ messages in thread From: Taylan Ulrich Bayırlı/Kammer @ 2015-12-03 9:01 UTC (permalink / raw) To: Mark H Weaver; +Cc: guile-devel 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... ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] Fix and-let*. 2015-12-03 9:01 ` Taylan Ulrich Bayırlı/Kammer @ 2016-06-20 22:38 ` Taylan Ulrich Bayırlı/Kammer 2016-06-21 7:49 ` Andy Wingo 0 siblings, 1 reply; 9+ messages in thread From: Taylan Ulrich Bayırlı/Kammer @ 2016-06-20 22:38 UTC (permalink / raw) To: wingo; +Cc: guile-devel [-- 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 ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] Fix and-let*. 2016-06-20 22:38 ` Taylan Ulrich Bayırlı/Kammer @ 2016-06-21 7:49 ` Andy Wingo 2016-06-21 8:38 ` Taylan Ulrich Bayırlı/Kammer 0 siblings, 1 reply; 9+ messages in thread From: Andy Wingo @ 2016-06-21 7:49 UTC (permalink / raw) To: Taylan Ulrich "Bayırlı/Kammer"; +Cc: guile-devel 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 ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] Fix and-let*. 2016-06-21 7:49 ` Andy Wingo @ 2016-06-21 8:38 ` Taylan Ulrich Bayırlı/Kammer 0 siblings, 0 replies; 9+ messages in thread From: Taylan Ulrich Bayırlı/Kammer @ 2016-06-21 8:38 UTC (permalink / raw) To: Andy Wingo; +Cc: guile-devel [-- 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 ^ permalink raw reply related [flat|nested] 9+ messages in thread
end of thread, other threads:[~2016-06-21 8:38 UTC | newest] Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2015-10-02 21:18 [PATCH] Fix and-let* Taylan Ulrich Bayırlı/Kammer 2015-10-02 22:03 ` Mark H Weaver 2015-10-02 22:37 ` Mark H Weaver 2015-10-03 9:48 ` Taylan Ulrich Bayırlı/Kammer 2015-10-17 12:37 ` Taylan Ulrich Bayırlı/Kammer 2015-12-03 9:01 ` Taylan Ulrich Bayırlı/Kammer 2016-06-20 22:38 ` Taylan Ulrich Bayırlı/Kammer 2016-06-21 7:49 ` Andy Wingo 2016-06-21 8:38 ` Taylan Ulrich Bayırlı/Kammer
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).