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

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

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