~ chicken-core (chicken-5) 7152bdbe5e26d20a98941078b12dce5db8f27892

commit 7152bdbe5e26d20a98941078b12dce5db8f27892
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Jan 25 22:03:05 2015 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Jan 25 22:03:05 2015 +0100

    mini-srfi-1.scm: length+

diff --git a/mini-srfi-1.scm b/mini-srfi-1.scm
index da82d6cd..16ffc33a 100644
--- a/mini-srfi-1.scm
+++ b/mini-srfi-1.scm
@@ -29,7 +29,7 @@
   (hide take span drop partition split-at append-map every any cons* concatenate delete
 	first second third fourth alist-cons delete-duplicates fifth
 	filter filter-map unzip1 last list-index lset-adjoin lset-difference
-	lset-union lset-intersection list-tabulate lset<= lset=))
+	lset-union lset-intersection list-tabulate lset<= lset= length+))
 
 
 (define (partition pred lst)
@@ -184,3 +184,18 @@
 (define (lset= s1 s2)
   (and (eq? (length s1) (length s2))
        (every (lambda (s) (memq s s2)) s1)))
+
+;; from SRFI-1 ref. impl.
+(define (length+ x)			; Returns #f if X is circular.
+  (let lp ((x x) (lag x) (len 0))
+    (if (pair? x)
+	(let ((x (cdr x))
+	      (len (fx+ len 1)))
+	  (if (pair? x)
+	      (let ((x   (cdr x))
+		    (lag (cdr lag))
+		    (len (fx+ len 1)))
+		(and (not (eq? x lag)) (lp x lag len)))
+	      len))
+	len)))
+