mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 01:00:20 +02:00
Code Activity

srfi-1 count: move from C to Scheme

Browse source 
* libguile/srfi-1.c (scm_srfi1_count): delete.
* libguile/srfi-1.h (scm_srfi1_count): delete.
* module/srfi/srfi-1.scm: add count.
This commit is contained in:
Rob Browning 2024-07-17 21:08:01 -05:00
parent 372a52e6aa
commit 58246aee24
3 changed files with 21 additions and 100 deletions
Download patch file Download diff file Expand all files Collapse all files

21
module/srfi/srfi-1.scm
View file

@ -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