[Guile-commits] 03/10: Fix intmap-ref bug

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 1850497a5c6f7526c5129637c2e25f44a52c8cb7
Author: Andy Wingo <address@hidden>
Date:   Wed Jun 3 17:42:58 2015 +0200

    Fix intmap-ref bug
    
    * module/language/cps/intmap.scm (intmap-ref): Fix a case in which the
      not-found procedure could be called with an incorrect value.
---
 module/language/cps/intmap.scm |    9 +++++----
 1 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/module/language/cps/intmap.scm b/module/language/cps/intmap.scm
index e3fdc2f..ba9d1c0 100644
--- a/module/language/cps/intmap.scm
+++ b/module/language/cps/intmap.scm
@@ -393,11 +393,12 @@ already, and always calls the meet procedure."
 
 (define* (intmap-ref map i #:optional (not-found (lambda (i)
                                                    (error "not found" i))))
+  (define (absent) (not-found i))
   (define (ref min shift root)
     (if (zero? shift)
         (if (and min (= i min) (present? root))
             root
-            (not-found i))
+            (absent))
         (if (and (<= min i) (< i (+ min (ash 1 shift))))
             (let ((i (- i min)))
               (let lp ((node root) (shift shift))
@@ -406,13 +407,13 @@ already, and always calls the meet procedure."
                         (let ((node (vector-ref node (logand i 
*branch-mask*))))
                           (if (present? node)
                               node
-                              (not-found i)))
+                              (absent)))
                         (let* ((shift (- shift *branch-bits*))
                                (idx (logand (ash i (- shift))
                                             *branch-mask*)))
                           (lp (vector-ref node idx) shift)))
-                    (not-found i))))
-            (not-found i))))
+                    (absent))))
+            (absent))))
   (match map
     (($ <intmap> min shift root)
      (ref min shift root))