From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: David Kastrup Newsgroups: gmane.lisp.guile.bugs Subject: bug#17485: [PATCH 1/3] Let length+ return the length of dotted lists rather than #f Date: Tue, 3 Jun 2014 20:56:16 +0200 Message-ID: <1401821778-19972-1-git-send-email-dak@gnu.org> References: <87y4y6t0or.fsf@fencepost.gnu.org> NNTP-Posting-Host: plane.gmane.org X-Trace: ger.gmane.org 1401821844 29759 80.91.229.3 (3 Jun 2014 18:57:24 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 3 Jun 2014 18:57:24 +0000 (UTC) Cc: David Kastrup To: 17485@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Tue Jun 03 20:57:16 2014 Return-path: Envelope-to: guile-bugs@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 1WrttZ-0000Pd-5l for guile-bugs@m.gmane.org; Tue, 03 Jun 2014 20:57:13 +0200 Original-Received: from localhost ([::1]:55233 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WrttY-0007PO-SU for guile-bugs@m.gmane.org; Tue, 03 Jun 2014 14:57:12 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:50215) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WrttT-0007ME-KD for bug-guile@gnu.org; Tue, 03 Jun 2014 14:57:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1WrttP-0008Qh-Ih for bug-guile@gnu.org; Tue, 03 Jun 2014 14:57:07 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:43652) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WrttP-0008Qd-Eh for bug-guile@gnu.org; Tue, 03 Jun 2014 14:57:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1WrttP-0007Cr-9G for bug-guile@gnu.org; Tue, 03 Jun 2014 14:57:03 -0400 X-Loop: help-debbugs@gnu.org In-Reply-To: <87y4y6t0or.fsf@fencepost.gnu.org> Resent-From: David Kastrup Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Tue, 03 Jun 2014 18:57:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 17485 X-GNU-PR-Package: guile X-GNU-PR-Keywords: Original-Received: via spool by 17485-submit@debbugs.gnu.org id=B17485.140182180427641 (code B ref 17485); Tue, 03 Jun 2014 18:57:03 +0000 Original-Received: (at 17485) by debbugs.gnu.org; 3 Jun 2014 18:56:44 +0000 Original-Received: from localhost ([127.0.0.1]:42525 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Wrtt5-0007Bj-Ae for submit@debbugs.gnu.org; Tue, 03 Jun 2014 14:56:43 -0400 Original-Received: from fencepost.gnu.org ([208.118.235.10]:54715 ident=Debian-exim) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Wrtt2-0007Bb-6C for 17485@debbugs.gnu.org; Tue, 03 Jun 2014 14:56:40 -0400 Original-Received: from localhost ([127.0.0.1]:33782 helo=lola) by fencepost.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Wrtst-0001m5-69; Tue, 03 Jun 2014 14:56:31 -0400 Original-Received: by lola (Postfix, from userid 1000) id A634DE0885; Tue, 3 Jun 2014 20:56:30 +0200 (CEST) X-Mailer: git-send-email 1.9.1 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.bugs:7482 Archived-At: * libguile/srfi-1.c (scm_srfi1_length_plus): Previously, length+ returned #f for dotted lists. This leaves the user with no efficient means for determining the length of dotted lists. While the Scheme standard does not prescribe a behavior here, the reference implementation at indeed returns the spine length (number of successive pairs in the cdr-chain) of dotted lists rather than #f, providing a good endorsement of this behavior. As one consequence, the multi-list implementations for map, fold, and for-each will happen to accept dotted lists as the shortest list. Previously, this caused an error late during processing. Signed-off-by: David Kastrup --- libguile/srfi-1.c | 28 ++++++++++++++++++++++++++-- module/srfi/srfi-1.scm | 10 +++++----- test-suite/tests/srfi-1.test | 28 +++++++++++++++------------- 3 files changed, 46 insertions(+), 20 deletions(-) diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c index aaa3efe..0db6388 100644 --- a/libguile/srfi-1.c +++ b/libguile/srfi-1.c @@ -614,8 +614,32 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0, "circular.") #define FUNC_NAME s_scm_srfi1_length_plus { - long len = scm_ilength (lst); - return (len >= 0 ? SCM_I_MAKINUM (len) : SCM_BOOL_F); + /* This uses the "tortoise and hare" algorithm to detect "infinitely + long" lists (i.e. lists with cycles in their cdrs), and returns #f + if it does find one. + + Dotted lists are treated just like regular lists, returning the + length of the spine. This is in conformance with the reference + implementation though not explicitly defined in the standard. */ + long i = 0; + SCM tortoise = lst; + SCM hare = lst; + + do { + if (!scm_is_pair (hare)) return scm_from_long (i); + hare = SCM_CDR(hare); + i++; + if (!scm_is_pair (hare)) return scm_from_long (i); + hare = SCM_CDR(hare); + i++; + /* For every two steps the hare takes, the tortoise takes one. */ + tortoise = SCM_CDR(tortoise); + } + while (!scm_is_eq (hare, tortoise)); + + /* If the tortoise ever catches the hare, then the list must contain + a cycle. */ + return SCM_BOOL_F; } #undef FUNC_NAME diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index 0806e73..bc72048 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -474,7 +474,7 @@ that result. See the manual for details." (or len1 len2)))) (unless len (scm-error 'wrong-type-arg "fold" - "Args do not contain a proper (finite) list: ~S" + "Args do not contain a finite list: ~S" (list (list list1 list2)) #f)) (let fold2 ((knil knil) (list1 list1) (list2 list2) (len len)) (if (zero? len) @@ -601,7 +601,7 @@ has just one element then that's the return value." (or len1 len2)))) (unless len (scm-error 'wrong-type-arg "map" - "Args do not contain a proper (finite) list: ~S" + "Args do not contain a finite list: ~S" (list (list l1 l2)) #f)) (let map2 ((l1 l1) (l2 l2) (len len)) (if (zero? len) @@ -620,7 +620,7 @@ has just one element then that's the return value." rest))) (if (not len) (scm-error 'wrong-type-arg "map" - "Args do not contain a proper (finite) list: ~S" + "Args do not contain a finite list: ~S" (list (cons l1 rest)) #f)) (let mapn ((l1 l1) (rest rest) (len len)) (if (zero? len) @@ -649,7 +649,7 @@ has just one element then that's the return value." (or len1 len2)))) (unless len (scm-error 'wrong-type-arg "for-each" - "Args do not contain a proper (finite) list: ~S" + "Args do not contain a finite list: ~S" (list (list l1 l2)) #f)) (let for-each2 ((l1 l1) (l2 l2) (len len)) (unless (zero? len) @@ -667,7 +667,7 @@ has just one element then that's the return value." rest))) (if (not len) (scm-error 'wrong-type-arg "for-each" - "Args do not contain a proper (finite) list: ~S" + "Args do not contain a finite list: ~S" (list (cons l1 rest)) #f)) (let for-eachn ((l1 l1) (rest rest) (len len)) (if (> len 0) diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test index d40f8e1..9364ea2 100644 --- a/test-suite/tests/srfi-1.test +++ b/test-suite/tests/srfi-1.test @@ -1187,19 +1187,21 @@ (pass-if-exception "proc arg count 4" exception:wrong-num-args (fold (lambda (x y z prev) x) 1 '(1 2 3) '(1 2 3))) - (pass-if-exception "improper first 1" exception:wrong-type-arg - (fold + 1 1 '(1 2 3))) - (pass-if-exception "improper first 2" exception:wrong-type-arg - (fold + 1 '(1 . 2) '(1 2 3))) - (pass-if-exception "improper first 3" exception:wrong-type-arg - (fold + 1 '(1 2 . 3) '(1 2 3))) - - (pass-if-exception "improper second 1" exception:wrong-type-arg - (fold + 1 '(1 2 3) 1)) - (pass-if-exception "improper second 2" exception:wrong-type-arg - (fold + 1 '(1 2 3) '(1 . 2))) - (pass-if-exception "improper second 3" exception:wrong-type-arg - (fold + 1 '(1 2 3) '(1 2 . 3))) + ;; For multiple list arguments, dotted lists are permitted by this + ;; implementation and a non-list is a zero-length dotted list + (pass-if "improper first 1" + (= 1 (fold + 1 1 '(1 2 3)))) + (pass-if "improper first 2" + (= 3 (fold + 1 '(1 . 2) '(1 2 3)))) + (pass-if "improper first 3" + (= 7 (fold + 1 '(1 2 . 3) '(1 2 3)))) + + (pass-if "improper second 1" + (= 1 (fold + 1 '(1 2 3) 1))) + (pass-if "improper second 2" + (= 3 (fold + 1 '(1 2 3) '(1 . 2)))) + (pass-if "improper second 3" + (= 7 (fold + 1 '(1 2 3) '(1 2 . 3)))) (pass-if (= 6 (fold + 1 '(2) '(3)))) (pass-if (= 15 (fold + 1 '(2 3) '(4 5)))) -- 1.9.1