[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)
- [Guile-commits] branch master updated (dfa11aa -> 50fcdfe), Andy Wingo, 2015/04/01
- [Guile-commits] 02/04: Precise range inference on <, <=, >=, > branches, Andy Wingo, 2015/04/01
- [Guile-commits] 01/04: Fix intmap bug for maps with only one element,
Andy Wingo <=
- [Guile-commits] 04/04: Remove "free" field of $fun, Andy Wingo, 2015/04/01
- [Guile-commits] 03/04: Replace $letrec with $rec, Andy Wingo, 2015/04/01