[Guile-commits] 02/09: Add intmap-prev

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 2a24395a0fd25db69de71be4266aea6e3962139f
Author: Andy Wingo <address@hidden>
Date:   Fri Mar 27 10:34:40 2015 +0100

    Add intmap-prev
    
    * module/language/cps/intmap.scm (intmap-next): Starting index is
      optional.
      (intmap-prev): New function.
---
 module/language/cps/intmap.scm |   23 ++++++++++++++++++++++-
 1 files changed, 22 insertions(+), 1 deletions(-)

diff --git a/module/language/cps/intmap.scm b/module/language/cps/intmap.scm
index e3ed5da..abaf459 100644
--- a/module/language/cps/intmap.scm
+++ b/module/language/cps/intmap.scm
@@ -39,6 +39,7 @@
             intmap-remove
             intmap-ref
             intmap-next
+            intmap-prev
             intmap-union
             intmap-intersect))
 
@@ -191,7 +192,7 @@
                                                *branch-mask*)))
                              (lp (vector-ref node idx) shift)))))))))))
 
-(define (intmap-next bs i)
+(define* (intmap-next bs #:optional i)
   (define (visit-branch node shift i)
     (let lp ((i i) (idx (logand (ash i (- shift)) *branch-mask*)))
       (and (< idx *branch-size*)
@@ -212,6 +213,26 @@
             (let ((i (visit-node root shift 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))
   ;; Union A and B from index I; the result will be fresh.
   (define (union-branches/fresh shift a b i fresh)