mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00
Code Activity

Add intmap-replace.

Browse source 
* module/language/cps/intmap.scm (intmap-replace): New interface.
This commit is contained in:
Andy Wingo 2015-05-24 16:50:36 +02:00
parent 10d11e6537
commit 8f578af0bb
1 changed files with 37 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -42,6 +42,7 @@
transient-intmap
intmap-add
intmap-add!
intmap-replace
intmap-remove
intmap-ref
intmap-next
@ -284,6 +285,42 @@
(($ <transient-intmap>)
(intmap-add (persistent-intmap map) i val meet))))
(define* (intmap-replace map i val #:optional (meet (lambda (old new) new)))
"Like intmap-add, but requires that @var{i} was present in the map
already, and always calls the meet procedure."
(define (not-found i)
(error "not found" i))
(define (adjoin i shift root)
(if (zero? shift)
(if (absent? root)
(not-found i)
(meet root val))
(let* ((shift (- shift *branch-bits*))
(idx (logand (ash i (- shift)) *branch-mask*)))
(if (absent? root)
(not-found i)
(let* ((node (vector-ref root idx))
(node* (adjoin i shift node)))
(if (eq? node node*)
root
(clone-branch-and-set root idx node*)))))))
(match map
(($ <intmap> min shift root)
(cond
((< i 0)
;; The power-of-two spanning trick doesn't work across 0.
(error "Intmaps can only map non-negative integers." i))
((and (present? root) (<= min i) (< i (+ min (ash 1 shift))))
(let ((old-root root)
(root (adjoin (- i min) shift root)))
(if (eq? root old-root)
map
(make-intmap min shift root))))
(else
(not-found i))))
(($ <transient-intmap>)
(intmap-replace (persistent-intmap map) i val meet))))
(define (intmap-remove map i)
(define (remove i shift root)
(cond