[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 03/12: Add intmap-replace.
From: |
Andy Wingo |
Subject: |
[Guile-commits] 03/12: Add intmap-replace. |
Date: |
Tue, 02 Jun 2015 08:33:49 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 8f578af0bbfc2edf0bbb23da8df1578afd6659a4
Author: Andy Wingo <address@hidden>
Date: Sun May 24 16:50:36 2015 +0200
Add intmap-replace.
* module/language/cps/intmap.scm (intmap-replace): New interface.
---
module/language/cps/intmap.scm | 37 +++++++++++++++++++++++++++++++++++++
1 files changed, 37 insertions(+), 0 deletions(-)
diff --git a/module/language/cps/intmap.scm b/module/language/cps/intmap.scm
index cb56cb3..d96801c 100644
--- a/module/language/cps/intmap.scm
+++ b/module/language/cps/intmap.scm
@@ -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
- [Guile-commits] branch master updated (48b2f19 -> 6e725df), Andy Wingo, 2015/06/02
- [Guile-commits] 01/12: Fix regression in compute-idoms, Andy Wingo, 2015/06/02
- [Guile-commits] 03/12: Add intmap-replace.,
Andy Wingo <=
- [Guile-commits] 04/12: intset-next starting point is optional, Andy Wingo, 2015/06/02
- [Guile-commits] 02/12: Fix type-fold on multiplying exact numbers, Andy Wingo, 2015/06/02
- [Guile-commits] 06/12: DCE uses type analysis to find dead code, Andy Wingo, 2015/06/02
- [Guile-commits] 08/12: Fix compute-defining-expressions (and thereby compute-constant-values), Andy Wingo, 2015/06/02
- [Guile-commits] 07/12: Add intmap-replace!., Andy Wingo, 2015/06/02
- [Guile-commits] 09/12: Port prune-top-level-scopes pass to CPS2, Andy Wingo, 2015/06/02
- [Guile-commits] 10/12: Add intmap-fold-right, Andy Wingo, 2015/06/02
- [Guile-commits] 11/12: Add "intset" syntax to construct intsets., Andy Wingo, 2015/06/02
- [Guile-commits] 05/12: Port type inference module to CPS2, Andy Wingo, 2015/06/02
- [Guile-commits] 12/12: Port contification pass to CPS2., Andy Wingo, 2015/06/02