diff options
author | Rob Browning <rlb@defaultvalue.org> | 2024-07-17 19:44:06 -0500 |
---|---|---|
committer | Rob Browning <rlb@defaultvalue.org> | 2024-07-30 19:28:37 -0500 |
commit | 372a52e6aa22ac255d8607c9e4f4f43864218440 (patch) | |
tree | b295d67459bbb2f6962da91ceed59b687c770f05 /module/srfi/srfi-1.scm | |
parent | 3cb6309f623ad9ab242a2397cac3ede2ee289f9e (diff) | |
download | guile-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.scm | 24 |
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}. |