mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +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 (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
((>= b-idx *branch-size*)
;; A has a lower shift, but it not within B. ;; 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 (intset-intersect a
(make-intset (+ b-min (ash b-idx b-shift)) (make-intset (+ b-min (ash b-idx b-shift))
b-shift b-shift
(vector-ref b-root b-idx)))))))) 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.
(cond
((vector-ref b-root 0)
=> (lambda (b-root)
(intset-intersect a (intset-intersect a
(make-intset b-min (make-intset b-min
(- b-shift *branch-bits*) (- b-shift *branch-bits*)
(vector-ref b-root 0)))) 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)))