summaryrefslogtreecommitdiff
path: root/module/srfi/srfi-1.scm
diff options
context:
space:
mode:
authorRob Browning <rlb@defaultvalue.org>2024-07-17 19:44:06 -0500
committerRob Browning <rlb@defaultvalue.org>2024-07-30 19:28:37 -0500
commit372a52e6aa22ac255d8607c9e4f4f43864218440 (patch)
treeb295d67459bbb2f6962da91ceed59b687c770f05 /module/srfi/srfi-1.scm
parent3cb6309f623ad9ab242a2397cac3ede2ee289f9e (diff)
downloadguile-372a52e6aa22ac255d8607c9e4f4f43864218440.tar.gz
srfi-1 length+: move from C to Scheme
* libguile/srfi-1.c (scm_srfi1_length_plus): delete. * libguile/srfi-1.h (scm_srfi1_length_plus): delete. * module/srfi/srfi-1.scm: add length+.
Diffstat (limited to 'module/srfi/srfi-1.scm')
-rw-r--r--module/srfi/srfi-1.scm24
1 files changed, 24 insertions, 0 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index f44b32909..31623cdc6 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -445,6 +445,30 @@ a list of those after."
;;; Miscelleneous: length, append, concatenate, reverse, zip & count
+(define (length+ lst)
+ "Return the length of @var{lst}, or @code{#f} if @var{lst} is circular."
+ (let lp ((tortoise lst)
+ (hare lst)
+ (i 0))
+ (if (not-pair? hare)
+ (if (null? hare)
+ i
+ (scm-error 'wrong-type-arg "length+"
+ "Argument not a proper or circular list: ~s"
+ (list lst) (list lst)))
+ (let ((hare (cdr hare)))
+ (if (not-pair? hare)
+ (if (null? hare)
+ (1+ i)
+ (scm-error 'wrong-type-arg "length+"
+ "Argument not a proper or circular list: ~s"
+ (list lst) (list lst)))
+ (let ((tortoise (cdr tortoise))
+ (hare (cdr hare)))
+ (if (eq? hare tortoise)
+ #f
+ (lp tortoise hare (+ i 2)))))))))
+
(define (concatenate lists)
"Construct a list by appending all lists in @var{lists}.