mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-22 20:40:29 +02:00
Code Activity

Add intmap-fold.

Browse source 
* module/language/cps/intmap.scm (intmap-fold): New function.
This commit is contained in:
Andy Wingo 2015-04-01 10:45:31 +02:00
parent 2a24395a0f
commit b7668bd949
1 changed files with 28 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

28
module/language/cps/intmap.scm
View file

@ -40,6 +40,7 @@
intmap-ref
intmap-next
intmap-prev
intmap-fold
intmap-union
intmap-intersect))
@ -233,6 +234,33 @@
(let ((i (visit-node root shift i)))
(and i (+ min i))))))))
(define (intmap-fold f map seed)
(define (visit-branch node shift min seed)
(let ((shift (- shift *branch-bits*)))
(if (zero? shift)
(let lp ((i 0) (seed seed))
(if (< i *branch-size*)
(let ((elt (vector-ref node i)))
(lp (1+ i)
(if elt
(f (+ i min) elt seed)
seed)))
seed))
(let lp ((i 0) (seed seed))
(if (< i *branch-size*)
(let ((elt (vector-ref node i)))
(lp (1+ i)
(if elt
(visit-branch elt shift (+ min (ash i shift)) seed)
seed)))
seed)))))
(match map
(($ <intmap> min shift root)
(cond
((not root) seed)
((zero? shift) (f min root seed))
(else (visit-branch root shift min seed))))))
(define* (intmap-union a b #:optional (meet meet-error))
;; Union A and B from index I; the result will be fresh.
(define (union-branches/fresh shift a b i fresh)