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: [PATCH] Fix and-let*. Date: Fri, 02 Oct 2015 23:18:53 +0200 Message-ID: <87zj01ufya.fsf@T420.taylan> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1443820914 23768 80.91.229.3 (2 Oct 2015 21:21:54 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 2 Oct 2015 21:21:54 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Fri Oct 02 23:21:46 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 1Zi7lp-0006ZP-Tk for guile-devel@m.gmane.org; Fri, 02 Oct 2015 23:21:38 +0200 Original-Received: from localhost ([::1]:35252 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zi7lp-0004tI-3c for guile-devel@m.gmane.org; Fri, 02 Oct 2015 17:21:37 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:53371) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zi7jG-0004YD-GI for guile-devel@gnu.org; Fri, 02 Oct 2015 17:18:59 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Zi7jF-0002WC-9K for guile-devel@gnu.org; Fri, 02 Oct 2015 17:18:58 -0400 Original-Received: from mail-wi0-x233.google.com ([2a00:1450:400c:c05::233]:32979) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zi7jF-0002W4-2x for guile-devel@gnu.org; Fri, 02 Oct 2015 17:18:57 -0400 Original-Received: by wiclk2 with SMTP id lk2so50288461wic.0 for ; Fri, 02 Oct 2015 14:18:55 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:subject:date:message-id:user-agent:mime-version :content-type; bh=zut41ugZRoBAibQvY/nzfTfW0kM+bF3eIuXPOxro3YQ=; b=PALVO+uKm04/PPgyv8sNgJAOdSEjTnv9jVAwFroiv9DolqhX74UWSdb3rku674YSyy Vf1fU/gKMkOeq64tL+FmOAcflgLmYVcyV7ztxDTpiHkrNKuKXiqqswCHjL9A1BKMeqpF RggYyQyorzP29FK7lqIdXTk57eFn2PfjLX0FAuFYhAiqS/Y27Sr+rEqtcD9qyBt3hWby SqrAvpefGrIAR+8lIStsYXX17ZLgvTTTnXXyeJjzZgLCW6f8FPXyjAC4D6pDxj2IpF/U VcWB40iBZAKrYYs9jYzBpxuOD4shId4Sc4CzwG19ZskLpJlSSL6NFlk9it9F+q2n9hod 2nOA== X-Received: by 10.180.23.231 with SMTP id p7mr885779wif.30.1443820735742; Fri, 02 Oct 2015 14:18:55 -0700 (PDT) Original-Received: from T420.taylan ([2a02:908:c32:4740:221:ccff:fe66:68f0]) by smtp.gmail.com with ESMTPSA id he3sm13136793wjc.48.2015.10.02.14.18.53 for (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Fri, 02 Oct 2015 14:18:54 -0700 (PDT) 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:17887 Archived-At: --=-=-= Content-Type: text/plain 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? --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=0001-Fix-and-let.patch Content-Transfer-Encoding: quoted-printable >From e08e9a7e1048c8e0ad58e09585e4b6a071906db3 Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Taylan=3D20Ulrich=3D20Bay=3DC4=3DB1rl=3DC4=3DB1/Kammer?=3D 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=C4=B1rl=C4=B1/Kammer ;;;;=20 ;;;; 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))= ))) =20 (define-syntax and-let* --=20 2.5.0 --=-=-=--