mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

Fix an intset-intersect corner case

Browse source 
* module/language/cps/intset.scm (intset-intersect): Avoid creating
  invalid intsets when lowering an intset with a higher shift.
This commit is contained in:
Andy Wingo 2014-06-29 19:40:43 +02:00
parent b5cb1c77ff
commit 257db78b6b
1 changed files with 19 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

30
module/language/cps/intset.scm
View file

@ -396,22 +396,30 @@
(else (else
(let* ((b-shift (- b-shift *branch-bits*)) (let* ((b-shift (- b-shift *branch-bits*))
(b-idx (ash (- a-min b-min) (- b-shift)))) (b-idx (ash (- a-min b-min) (- b-shift))))
(if (>= b-idx *branch-size*) (cond
;; A has a lower shift, but it not within B. ((>= b-idx *branch-size*)
empty-intset ;; A has a lower shift, but it not within B.
(intset-intersect a empty-intset)
(make-intset (+ b-min (ash b-idx b-shift)) ((vector-ref b-root b-idx)
b-shift => (lambda (b-root)
(vector-ref b-root b-idx)))))))) (intset-intersect a
(make-intset (+ b-min (ash b-idx b-shift))
b-shift
b-root))))
(else empty-intset))))))
((< b-shift a-shift) ((< b-shift a-shift)
;; Make A have the lower shift. ;; Make A have the lower shift.
(intset-intersect b a)) (intset-intersect b a))
((< a-shift b-shift) ((< a-shift b-shift)
;; A and B have the same min but a different shift. Recurse down. ;; A and B have the same min but a different shift. Recurse down.
(intset-intersect a (cond
(make-intset b-min ((vector-ref b-root 0)
(- b-shift *branch-bits*) => (lambda (b-root)
(vector-ref b-root 0)))) (intset-intersect a
(make-intset b-min
(- b-shift *branch-bits*)
b-root))))
(else empty-intset)))
(else (else
;; At this point, A and B cover the same range. ;; At this point, A and B cover the same range.
(let ((root (intersect a-shift a-root b-root))) (let ((root (intersect a-shift a-root b-root)))