mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-14 15:40:19 +02:00
Add intmap-prev
* module/language/cps/intmap.scm (intmap-next): Starting index is optional. (intmap-prev): New function.
This commit is contained in:
parent
33ab2838de
commit
2a24395a0f
1 changed files with 22 additions and 1 deletions
|
@ -39,6 +39,7 @@
|
||||||
intmap-remove
|
intmap-remove
|
||||||
intmap-ref
|
intmap-ref
|
||||||
intmap-next
|
intmap-next
|
||||||
|
intmap-prev
|
||||||
intmap-union
|
intmap-union
|
||||||
intmap-intersect))
|
intmap-intersect))
|
||||||
|
|
||||||
|
@ -191,7 +192,7 @@
|
||||||
*branch-mask*)))
|
*branch-mask*)))
|
||||||
(lp (vector-ref node idx) shift)))))))))))
|
(lp (vector-ref node idx) shift)))))))))))
|
||||||
|
|
||||||
(define (intmap-next bs i)
|
(define* (intmap-next bs #:optional i)
|
||||||
(define (visit-branch node shift i)
|
(define (visit-branch node shift i)
|
||||||
(let lp ((i i) (idx (logand (ash i (- shift)) *branch-mask*)))
|
(let lp ((i i) (idx (logand (ash i (- shift)) *branch-mask*)))
|
||||||
(and (< idx *branch-size*)
|
(and (< idx *branch-size*)
|
||||||
|
@ -212,6 +213,26 @@
|
||||||
(let ((i (visit-node root shift i)))
|
(let ((i (visit-node root shift i)))
|
||||||
(and i (+ min i))))))))
|
(and i (+ min i))))))))
|
||||||
|
|
||||||
|
(define* (intmap-prev bs #:optional i)
|
||||||
|
(define (visit-branch node shift i)
|
||||||
|
(let lp ((i i) (idx (logand (ash i (- shift)) *branch-mask*)))
|
||||||
|
(and (<= 0 idx)
|
||||||
|
(or (visit-node (vector-ref node idx) shift i)
|
||||||
|
(lp (1- (round-down i shift)) (1- idx))))))
|
||||||
|
(define (visit-node node shift i)
|
||||||
|
(and node
|
||||||
|
(if (zero? shift)
|
||||||
|
i
|
||||||
|
(visit-branch node (- shift *branch-bits*) i))))
|
||||||
|
(match bs
|
||||||
|
(($ <intmap> min shift root)
|
||||||
|
(let* ((i (if (and i (< i (+ min (ash 1 shift))))
|
||||||
|
(- i min)
|
||||||
|
(1- (ash 1 shift)))))
|
||||||
|
(and (<= 0 i)
|
||||||
|
(let ((i (visit-node root shift i)))
|
||||||
|
(and i (+ min i))))))))
|
||||||
|
|
||||||
(define* (intmap-union a b #:optional (meet meet-error))
|
(define* (intmap-union a b #:optional (meet meet-error))
|
||||||
;; Union A and B from index I; the result will be fresh.
|
;; Union A and B from index I; the result will be fresh.
|
||||||
(define (union-branches/fresh shift a b i fresh)
|
(define (union-branches/fresh shift a b i fresh)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue