wingo pushed a commit to branch master in repository guile. commit 1850497a5c6f7526c5129637c2e25f44a52c8cb7 Author: Andy Wingo <wi...@pobox.com> 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))