summaryrefslogtreecommitdiff
path: root/module/srfi/srfi-1.scm
diff options
context:
space:
mode:
authorRob Browning <rlb@defaultvalue.org>2024-07-17 21:08:01 -0500
committerRob Browning <rlb@defaultvalue.org>2024-07-30 19:28:37 -0500
commit58246aee24be908307117b3f8ae8040460f86ce7 (patch)
tree1c731b1b7cc27feddf4ba5156042da647525846c /module/srfi/srfi-1.scm
parent372a52e6aa22ac255d8607c9e4f4f43864218440 (diff)
downloadguile-58246aee24be908307117b3f8ae8040460f86ce7.tar.gz
srfi-1 count: move from C to Scheme
* libguile/srfi-1.c (scm_srfi1_count): delete. * libguile/srfi-1.h (scm_srfi1_count): delete. * module/srfi/srfi-1.scm: add count.
Diffstat (limited to 'module/srfi/srfi-1.scm')
-rw-r--r--module/srfi/srfi-1.scm21
1 files changed, 21 insertions, 0 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 31623cdc6..2ecdcd7ff 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -546,6 +546,27 @@ result. This is equivalent to @code{(append! (reverse! @var{rev-head})
(values (map first l) (map second l) (map third l) (map fourth l)
(map fifth l)))
+(define count
+ (case-lambda
+ ((pred lst)
+ (let lp ((lst lst) (c 0))
+ (if (null? lst)
+ c
+ (lp (cdr lst) (if (pred (car lst)) (1+ c) c)))))
+ ((pred l1 l2)
+ (let lp ((l1 l1) (l2 l2) (c 0))
+ (if (or (null? l1) (null? l2))
+ c
+ (lp (cdr l1) (cdr l2)
+ (if (pred (car l1) (car l2)) (1+ c) c)))))
+ ((pred lst . lists)
+ (let lp ((lst lst) (lists lists) (c 0))
+ (if (or (null? lst) (any null? lists))
+ c
+ (lp (cdr lst)
+ (map cdr lists)
+ (if (apply pred (car lst) (map car lists)) (1+ c) c)))))))
+
;;; Fold, unfold & map
(define fold