[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#17485: [PATCH 1/3] Let length+ return the length of dotted lists rat
From: |
David Kastrup |
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 |
* 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
<URL:http://srfi.schemers.org/srfi-1/srfi-1-reference.scm> 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 <address@hidden>
---
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
- bug#17485: [PATCH 1/3] Let length+ return the length of dotted lists rather than #f,
David Kastrup <=