From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: taylanbayirli@gmail.com (Taylan Ulrich =?utf-8?Q?Bay=C4=B1rl=C4=B1?= =?utf-8?Q?=2FKammer?=) Newsgroups: gmane.lisp.guile.devel Subject: Re: [PATCH] Fix and-let*. Date: Sat, 03 Oct 2015 11:48:44 +0200 Message-ID: <87r3lcuvsz.fsf@T420.taylan> References: <87zj01ufya.fsf@T420.taylan> <87lhbkq4mp.fsf@netris.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1443865737 22502 80.91.229.3 (3 Oct 2015 09:48:57 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 3 Oct 2015 09:48:57 +0000 (UTC) Cc: guile-devel@gnu.org To: Mark H Weaver Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sat Oct 03 11:48:56 2015 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1ZiJR1-0004IS-Q9 for guile-devel@m.gmane.org; Sat, 03 Oct 2015 11:48:56 +0200 Original-Received: from localhost ([::1]:37610 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZiJR0-000184-Uy for guile-devel@m.gmane.org; Sat, 03 Oct 2015 05:48:54 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:58528) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZiJQu-00017t-Te for guile-devel@gnu.org; Sat, 03 Oct 2015 05:48:50 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZiJQt-0007kO-AG for guile-devel@gnu.org; Sat, 03 Oct 2015 05:48:48 -0400 Original-Received: from mail-wi0-x233.google.com ([2a00:1450:400c:c05::233]:33544) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZiJQt-0007kE-0e for guile-devel@gnu.org; Sat, 03 Oct 2015 05:48:47 -0400 Original-Received: by wiclk2 with SMTP id lk2so62059171wic.0 for ; Sat, 03 Oct 2015 02:48:46 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version:content-type; bh=9HgEjPRSOLNJcl4pb+BpbACp/J5Fe7jRqyZSxUMYvt0=; b=uG7AmjNEVcwgObwgpjKRzpeAHzoDVQIB6KbaWYR9JkxtDE86F5WufbtfaAN2scOJL1 FSbDKNUtMc7ou+8xQgHJ9XbWlen+h3DlMv6JJ7PGo8H7pmTUm7YmeUqPdxoMKK/HXRrj XmZp8w0o/RQQlJqhBUvysMYnEQzRlqhI7OC8U9sfX33xT2ldHzaEtbod5nXYKTVNMBXJ OzXlcTrxx7AGliHPnbnkjxM40VtG8LJoGO/Oz6biWQ6mIc7eQA4W86BSDpZQyjCY131W 0pY8af7W4CzLwCg5oKkXFXz1XEZmazrCoyXeuW2P2uHDohxOcLl+io4L1HjYax2eoqCI nXRw== X-Received: by 10.180.92.201 with SMTP id co9mr2041657wib.58.1443865726461; Sat, 03 Oct 2015 02:48:46 -0700 (PDT) Original-Received: from T420.taylan ([2a02:908:c32:4740:221:ccff:fe66:68f0]) by smtp.gmail.com with ESMTPSA id hk5sm15628960wjb.6.2015.10.03.02.48.44 (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Sat, 03 Oct 2015 02:48:45 -0700 (PDT) In-Reply-To: <87lhbkq4mp.fsf@netris.org> (Mark H. Weaver's message of "Fri, 02 Oct 2015 18:37:02 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2a00:1450:400c:c05::233 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:17891 Archived-At: --=-=-= Content-Type: text/plain Mark H Weaver 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: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Fix-SRFI-2-and-let-implementation.patch >From 7d484e076e237d6522ca53474fb9d180472a9f54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?= 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 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0002-Add-SRFI-2-and-let-test-suite.patch >From f8df7d91ee5ea110a03d7aa6c71f5954ebb74494 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?= 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 --=-=-=--