From unknown Fri Aug 15 21:25:29 2025 X-Loop: help-debbugs@gnu.org Subject: bug#9883: R6RS fold-left Resent-From: Ian Price Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-guile@gnu.org Resent-Date: Wed, 26 Oct 2011 20:48:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 9883 X-GNU-PR-Package: guile X-GNU-PR-Keywords: To: 9883@debbugs.gnu.org X-Debbugs-Original-To: bug-guile@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.131966204024462 (code B ref -1); Wed, 26 Oct 2011 20:48:02 +0000 Received: (at submit) by debbugs.gnu.org; 26 Oct 2011 20:47:20 +0000 Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RJANb-0006MU-4Y for submit@debbugs.gnu.org; Wed, 26 Oct 2011 16:47:19 -0400 Received: from eggs.gnu.org ([140.186.70.92]) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RJANV-0006ME-Pr for submit@debbugs.gnu.org; Wed, 26 Oct 2011 16:47:17 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RJALi-0006IR-Jj for submit@debbugs.gnu.org; Wed, 26 Oct 2011 16:45:24 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.1 (2010-03-16) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-4.7 required=5.0 tests=BAYES_00,FREEMAIL_FROM, RCVD_IN_DNSWL_MED,RP_MATCHES_RCVD,T_TO_NO_BRKTS_FREEMAIL, T_TVD_MIME_NO_HEADERS autolearn=unavailable version=3.3.1 Received: from lists.gnu.org ([140.186.70.17]:41647) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RJALi-0006IN-HS for submit@debbugs.gnu.org; Wed, 26 Oct 2011 16:45:22 -0400 Received: from eggs.gnu.org ([140.186.70.92]:34968) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RJALh-0004qG-At for bug-guile@gnu.org; Wed, 26 Oct 2011 16:45:22 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RJALf-0006I2-Vd for bug-guile@gnu.org; Wed, 26 Oct 2011 16:45:21 -0400 Received: from lo.gmane.org ([80.91.229.12]:53496) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RJALf-0006Hj-EM for bug-guile@gnu.org; Wed, 26 Oct 2011 16:45:19 -0400 Received: from list by lo.gmane.org with local (Exim 4.69) (envelope-from ) id 1RJALa-0003CY-6B for bug-guile@gnu.org; Wed, 26 Oct 2011 22:45:14 +0200 Received: from host31-53-23-37.range31-53.btcentralplus.com ([31.53.23.37]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 26 Oct 2011 22:45:14 +0200 Received: from ianprice90 by host31-53-23-37.range31-53.btcentralplus.com with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 26 Oct 2011 22:45:14 +0200 X-Injected-Via-Gmane: http://gmane.org/ From: Ian Price Date: Wed, 26 Oct 2011 21:43:16 +0100 Lines: 144 Message-ID: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Complaints-To: usenet@dough.gmane.org X-Gmane-NNTP-Posting-Host: host31-53-23-37.range31-53.btcentralplus.com User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (gnu/linux) Cancel-Lock: sha1:08xH9JUEOD7XWYadVsbs3nkhKb0= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 140.186.70.17 X-Spam-Score: -5.9 (-----) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: debbugs-submit-bounces@debbugs.gnu.org Errors-To: debbugs-submit-bounces@debbugs.gnu.org X-Spam-Score: -5.9 (-----) --=-=-= Hi guilers, According to the R6RS the accumulator should be the first argument of the combiner[0], not the last as in SRFI 1[1]. I've attached a patch to fix this, and the use of fold-left in define-record-type. Currently, it terminates on the first null (as in SRFI 1). If you would prefer, I can change it to check the lengths of the lists before-hand, and do the same for fold-right. Cheers. 0. http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-4.html#node_idx_212 1. http://srfi.schemers.org/srfi-1/srfi-1.html#fold -- Ian Price "Programming is like pinball. The reward for doing it well is the opportunity to do it again" - from "The Wizardy Compiled" --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Fix-R6RS-fold-left.patch Content-Description: fold-left fix >From 31b964c85ba45d72e4ec047e7d0420146a12941c Mon Sep 17 00:00:00 2001 From: Ian Price Date: Wed, 26 Oct 2011 20:24:05 +0100 Subject: [PATCH] Fix R6RS `fold-left' * module/rnrs/lists.scm (fold-left) : Wrote R6RS compliant version with accumulator as first argument to the combiner. * module/rnrs/records/syntactic.scm (define-record-type): Fix to use corrected fold-left. * test-suite/tests/r6rs-lists.test: Add tests. --- module/rnrs/lists.scm | 12 +++++++++--- module/rnrs/records/syntactic.scm | 4 ++-- test-suite/tests/r6rs-lists.test | 26 ++++++++++++++++++++++++++ 3 files changed, 37 insertions(+), 5 deletions(-) diff --git a/module/rnrs/lists.scm b/module/rnrs/lists.scm index 812ce5f..0671e77 100644 --- a/module/rnrs/lists.scm +++ b/module/rnrs/lists.scm @@ -22,8 +22,7 @@ remv remq memp member memv memq assp assoc assv assq cons*) (import (rnrs base (6)) (only (guile) filter member memv memq assoc assv assq cons*) - (rename (only (srfi srfi-1) fold - any + (rename (only (srfi srfi-1) any every remove member @@ -32,7 +31,6 @@ partition fold-right filter-map) - (fold fold-left) (any exists) (every for-all) (remove remp) @@ -40,6 +38,14 @@ (member memp-internal) (assoc assp-internal))) + (define (fold-left combine nil list . lists) + (define (fold nil lists) + (if (exists null? lists) + nil + (fold (apply combine nil (map car lists)) + (map cdr lists)))) + (fold nil (cons list lists))) + (define (remove obj list) (remp (lambda (elt) (equal? obj elt)) list)) (define (remv obj list) (remp (lambda (elt) (eqv? obj elt)) list)) (define (remq obj list) (remp (lambda (elt) (eq? obj elt)) list)) diff --git a/module/rnrs/records/syntactic.scm b/module/rnrs/records/syntactic.scm index a497b90..bde6f93 100644 --- a/module/rnrs/records/syntactic.scm +++ b/module/rnrs/records/syntactic.scm @@ -134,13 +134,13 @@ (let* ((fields (if (unspecified? _fields) '() _fields)) (field-names (list->vector (map car fields))) (field-accessors - (fold-left (lambda (x c lst) + (fold-left (lambda (lst x c) (cons #`(define #,(cadr x) (record-accessor record-name #,c)) lst)) '() fields (sequence (length fields)))) (field-mutators - (fold-left (lambda (x c lst) + (fold-left (lambda (lst x c) (if (caddr x) (cons #`(define #,(caddr x) (record-mutator record-name diff --git a/test-suite/tests/r6rs-lists.test b/test-suite/tests/r6rs-lists.test index ba645ed..030091f 100644 --- a/test-suite/tests/r6rs-lists.test +++ b/test-suite/tests/r6rs-lists.test @@ -30,3 +30,29 @@ (let ((d '((3 a) (1 b) (4 c)))) (equal? (assp even? d) '(4 c))))) +(with-test-prefix "fold-left" + (pass-if "fold-left sum" + (equal? (fold-left + 0 '(1 2 3 4 5)) + 15)) + (pass-if "fold-left reverse" + (equal? (fold-left (lambda (a e) (cons e a)) '() '(1 2 3 4 5)) + '(5 4 3 2 1))) + (pass-if "fold-left max-length" + (equal? (fold-left (lambda (max-len s) + (max max-len (string-length s))) + 0 + '("longest" "long" "longer")) + 7)) + (pass-if "fold-left with-cons" + (equal? (fold-left cons '(q) '(a b c)) + '((((q) . a) . b) . c))) + (pass-if "fold-left sum-multiple" + (equal? (fold-left + 0 '(1 2 3) '(4 5 6)) + 21)) + (pass-if "fold-left pairlis" + (equal? (fold-left (lambda (accum e1 e2) + (cons (cons e1 e2) accum)) + '((d . 4)) + '(a b c) + '(1 2 3)) + '((c . 3) (b . 2) (a . 1) (d . 4))))) -- 1.7.6.4 --=-=-=-- From unknown Fri Aug 15 21:25:29 2025 MIME-Version: 1.0 X-Mailer: MIME-tools 5.427 (Entity 5.427) X-Loop: help-debbugs@gnu.org From: help-debbugs@gnu.org (GNU bug Tracking System) To: Ian Price Subject: bug#9883: closed (Re: bug#9883: R6RS fold-left) Message-ID: References: <877h3khf7x.fsf@gnu.org> X-Gnu-PR-Message: they-closed 9883 X-Gnu-PR-Package: guile Reply-To: 9883@debbugs.gnu.org Date: Tue, 01 Nov 2011 00:16:02 +0000 Content-Type: multipart/mixed; boundary="----------=_1320106562-16164-1" This is a multi-part message in MIME format... ------------=_1320106562-16164-1 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset="utf-8" Your bug report #9883: R6RS fold-left which was filed against the guile package, has been closed. The explanation is attached below, along with your original report. If you require more details, please reply to 9883@debbugs.gnu.org. --=20 9883: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D9883 GNU Bug Tracking System Contact help-debbugs@gnu.org with problems ------------=_1320106562-16164-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at 9883-done) by debbugs.gnu.org; 1 Nov 2011 00:16:01 +0000 Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RL21I-0004CW-3U for submit@debbugs.gnu.org; Mon, 31 Oct 2011 20:16:01 -0400 Received: from mail4-relais-sop.national.inria.fr ([192.134.164.105]) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RL21F-0004CN-KL for 9883-done@debbugs.gnu.org; Mon, 31 Oct 2011 20:15:58 -0400 X-IronPort-AV: E=Sophos;i="4.69,435,1315173600"; d="scan'208";a="115925277" Received: from reverse-83.fdn.fr (HELO pluto) ([80.67.176.83]) by mail4-relais-sop.national.inria.fr with ESMTP/TLS/DHE-RSA-AES128-SHA; 01 Nov 2011 01:13:41 +0100 From: ludo@gnu.org (Ludovic =?iso-8859-1?Q?Court=E8s?=) To: Ian Price Subject: Re: bug#9883: R6RS fold-left References: X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 11 Brumaire an 220 de la =?iso-8859-1?Q?R=E9volution?= X-PGP-Key-ID: 0xEA52ECF4 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 83C4 F8E5 10A3 3B4C 5BEA D15D 77DD 95E2 EA52 ECF4 X-OS: x86_64-unknown-linux-gnu Date: Tue, 01 Nov 2011 01:13:38 +0100 In-Reply-To: (Ian Price's message of "Wed, 26 Oct 2011 21:43:16 +0100") Message-ID: <877h3khf7x.fsf@gnu.org> User-Agent: Gnus/5.110018 (No Gnus v0.18) Emacs/24.0.90 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -8.9 (--------) X-Debbugs-Envelope-To: 9883-done Cc: 9883-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: debbugs-submit-bounces@debbugs.gnu.org Errors-To: debbugs-submit-bounces@debbugs.gnu.org X-Spam-Score: -8.9 (--------) Hi Ian, Ian Price skribis: > According to the R6RS the accumulator should be the first argument of > the combiner[0], not the last as in SRFI 1[1]. > > I've attached a patch to fix this, and the use of fold-left in > define-record-type. Applied with minor changes in the commit log. Thanks! Ludo=E2=80=99. ------------=_1320106562-16164-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at submit) by debbugs.gnu.org; 26 Oct 2011 20:47:20 +0000 Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RJANb-0006MU-4Y for submit@debbugs.gnu.org; Wed, 26 Oct 2011 16:47:19 -0400 Received: from eggs.gnu.org ([140.186.70.92]) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RJANV-0006ME-Pr for submit@debbugs.gnu.org; Wed, 26 Oct 2011 16:47:17 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RJALi-0006IR-Jj for submit@debbugs.gnu.org; Wed, 26 Oct 2011 16:45:24 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.1 (2010-03-16) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-4.7 required=5.0 tests=BAYES_00,FREEMAIL_FROM, RCVD_IN_DNSWL_MED,RP_MATCHES_RCVD,T_TO_NO_BRKTS_FREEMAIL, T_TVD_MIME_NO_HEADERS autolearn=unavailable version=3.3.1 Received: from lists.gnu.org ([140.186.70.17]:41647) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RJALi-0006IN-HS for submit@debbugs.gnu.org; Wed, 26 Oct 2011 16:45:22 -0400 Received: from eggs.gnu.org ([140.186.70.92]:34968) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RJALh-0004qG-At for bug-guile@gnu.org; Wed, 26 Oct 2011 16:45:22 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RJALf-0006I2-Vd for bug-guile@gnu.org; Wed, 26 Oct 2011 16:45:21 -0400 Received: from lo.gmane.org ([80.91.229.12]:53496) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RJALf-0006Hj-EM for bug-guile@gnu.org; Wed, 26 Oct 2011 16:45:19 -0400 Received: from list by lo.gmane.org with local (Exim 4.69) (envelope-from ) id 1RJALa-0003CY-6B for bug-guile@gnu.org; Wed, 26 Oct 2011 22:45:14 +0200 Received: from host31-53-23-37.range31-53.btcentralplus.com ([31.53.23.37]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 26 Oct 2011 22:45:14 +0200 Received: from ianprice90 by host31-53-23-37.range31-53.btcentralplus.com with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 26 Oct 2011 22:45:14 +0200 X-Injected-Via-Gmane: http://gmane.org/ To: bug-guile@gnu.org From: Ian Price Subject: R6RS fold-left Date: Wed, 26 Oct 2011 21:43:16 +0100 Lines: 144 Message-ID: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Complaints-To: usenet@dough.gmane.org X-Gmane-NNTP-Posting-Host: host31-53-23-37.range31-53.btcentralplus.com User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (gnu/linux) Cancel-Lock: sha1:08xH9JUEOD7XWYadVsbs3nkhKb0= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 140.186.70.17 X-Spam-Score: -5.9 (-----) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: debbugs-submit-bounces@debbugs.gnu.org Errors-To: debbugs-submit-bounces@debbugs.gnu.org X-Spam-Score: -5.9 (-----) --=-=-= Hi guilers, According to the R6RS the accumulator should be the first argument of the combiner[0], not the last as in SRFI 1[1]. I've attached a patch to fix this, and the use of fold-left in define-record-type. Currently, it terminates on the first null (as in SRFI 1). If you would prefer, I can change it to check the lengths of the lists before-hand, and do the same for fold-right. Cheers. 0. http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-4.html#node_idx_212 1. http://srfi.schemers.org/srfi-1/srfi-1.html#fold -- Ian Price "Programming is like pinball. The reward for doing it well is the opportunity to do it again" - from "The Wizardy Compiled" --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Fix-R6RS-fold-left.patch Content-Description: fold-left fix >From 31b964c85ba45d72e4ec047e7d0420146a12941c Mon Sep 17 00:00:00 2001 From: Ian Price Date: Wed, 26 Oct 2011 20:24:05 +0100 Subject: [PATCH] Fix R6RS `fold-left' * module/rnrs/lists.scm (fold-left) : Wrote R6RS compliant version with accumulator as first argument to the combiner. * module/rnrs/records/syntactic.scm (define-record-type): Fix to use corrected fold-left. * test-suite/tests/r6rs-lists.test: Add tests. --- module/rnrs/lists.scm | 12 +++++++++--- module/rnrs/records/syntactic.scm | 4 ++-- test-suite/tests/r6rs-lists.test | 26 ++++++++++++++++++++++++++ 3 files changed, 37 insertions(+), 5 deletions(-) diff --git a/module/rnrs/lists.scm b/module/rnrs/lists.scm index 812ce5f..0671e77 100644 --- a/module/rnrs/lists.scm +++ b/module/rnrs/lists.scm @@ -22,8 +22,7 @@ remv remq memp member memv memq assp assoc assv assq cons*) (import (rnrs base (6)) (only (guile) filter member memv memq assoc assv assq cons*) - (rename (only (srfi srfi-1) fold - any + (rename (only (srfi srfi-1) any every remove member @@ -32,7 +31,6 @@ partition fold-right filter-map) - (fold fold-left) (any exists) (every for-all) (remove remp) @@ -40,6 +38,14 @@ (member memp-internal) (assoc assp-internal))) + (define (fold-left combine nil list . lists) + (define (fold nil lists) + (if (exists null? lists) + nil + (fold (apply combine nil (map car lists)) + (map cdr lists)))) + (fold nil (cons list lists))) + (define (remove obj list) (remp (lambda (elt) (equal? obj elt)) list)) (define (remv obj list) (remp (lambda (elt) (eqv? obj elt)) list)) (define (remq obj list) (remp (lambda (elt) (eq? obj elt)) list)) diff --git a/module/rnrs/records/syntactic.scm b/module/rnrs/records/syntactic.scm index a497b90..bde6f93 100644 --- a/module/rnrs/records/syntactic.scm +++ b/module/rnrs/records/syntactic.scm @@ -134,13 +134,13 @@ (let* ((fields (if (unspecified? _fields) '() _fields)) (field-names (list->vector (map car fields))) (field-accessors - (fold-left (lambda (x c lst) + (fold-left (lambda (lst x c) (cons #`(define #,(cadr x) (record-accessor record-name #,c)) lst)) '() fields (sequence (length fields)))) (field-mutators - (fold-left (lambda (x c lst) + (fold-left (lambda (lst x c) (if (caddr x) (cons #`(define #,(caddr x) (record-mutator record-name diff --git a/test-suite/tests/r6rs-lists.test b/test-suite/tests/r6rs-lists.test index ba645ed..030091f 100644 --- a/test-suite/tests/r6rs-lists.test +++ b/test-suite/tests/r6rs-lists.test @@ -30,3 +30,29 @@ (let ((d '((3 a) (1 b) (4 c)))) (equal? (assp even? d) '(4 c))))) +(with-test-prefix "fold-left" + (pass-if "fold-left sum" + (equal? (fold-left + 0 '(1 2 3 4 5)) + 15)) + (pass-if "fold-left reverse" + (equal? (fold-left (lambda (a e) (cons e a)) '() '(1 2 3 4 5)) + '(5 4 3 2 1))) + (pass-if "fold-left max-length" + (equal? (fold-left (lambda (max-len s) + (max max-len (string-length s))) + 0 + '("longest" "long" "longer")) + 7)) + (pass-if "fold-left with-cons" + (equal? (fold-left cons '(q) '(a b c)) + '((((q) . a) . b) . c))) + (pass-if "fold-left sum-multiple" + (equal? (fold-left + 0 '(1 2 3) '(4 5 6)) + 21)) + (pass-if "fold-left pairlis" + (equal? (fold-left (lambda (accum e1 e2) + (cons (cons e1 e2) accum)) + '((d . 4)) + '(a b c) + '(1 2 3)) + '((c . 3) (b . 2) (a . 1) (d . 4))))) -- 1.7.6.4 --=-=-=-- ------------=_1320106562-16164-1--