guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 01/04: Fix intmap bug for maps with only one element


From: Andy Wingo
Subject: [Guile-commits] 01/04: Fix intmap bug for maps with only one element
Date: Wed, 01 Apr 2015 08:27:45 +0000

wingo pushed a commit to branch master
in repository guile.

commit ef7a71b768c583d795b5de6b0c49177e7dfb0dbf
Author: Andy Wingo <address@hidden>
Date:   Fri Mar 27 13:40:23 2015 +0100

    Fix intmap bug for maps with only one element
    
    * module/language/cps/intmap.scm (intmap-ref): Fix bug referencing
      values when there is only one value in the map.
---
 module/language/cps/intmap.scm |   22 ++++++++++++----------
 1 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/module/language/cps/intmap.scm b/module/language/cps/intmap.scm
index 152985a..d6c017a 100644
--- a/module/language/cps/intmap.scm
+++ b/module/language/cps/intmap.scm
@@ -175,16 +175,18 @@
 (define (intmap-ref bs i)
   (match bs
     (($ <intmap> min shift root)
-     (and (<= min i) (< i (+ min (ash 1 shift)))
-          (let ((i (- i min)))
-            (let lp ((node root) (shift shift))
-              (and node
-                   (if (= shift *branch-bits*)
-                       (vector-ref node (logand i *branch-mask*))
-                       (let* ((shift (- shift *branch-bits*))
-                              (idx (logand (ash i (- shift))
-                                           *branch-mask*)))
-                         (lp (vector-ref node idx) shift))))))))))
+     (if (zero? shift)
+         (and (= i min) root)
+         (and (<= min i) (< i (+ min (ash 1 shift)))
+              (let ((i (- i min)))
+                (let lp ((node root) (shift shift))
+                  (and node
+                       (if (= shift *branch-bits*)
+                           (vector-ref node (logand i *branch-mask*))
+                           (let* ((shift (- shift *branch-bits*))
+                                  (idx (logand (ash i (- shift))
+                                               *branch-mask*)))
+                             (lp (vector-ref node idx) shift)))))))))))
 
 (define (intmap-next bs i)
   (define (visit-branch node shift i)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]