diff options
| author | Andy Wingo <wingo@pobox.com> | 2014-06-29 19:40:43 +0200 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2014-06-29 19:41:16 +0200 |
| commit | 257db78b6b6495ff46ff6be9a7b72e5cd40b27bb (patch) | |
| tree | f4987bf5017a3e425c2f01b2f84e425366cc7940 | |
| parent | b5cb1c77fffb65642165cfc9153e95eba770b509 (diff) | |
| download | guile-257db78b6b6495ff46ff6be9a7b72e5cd40b27bb.tar.gz | |
Fix an intset-intersect corner case
* module/language/cps/intset.scm (intset-intersect): Avoid creating
invalid intsets when lowering an intset with a higher shift.
| -rw-r--r-- | module/language/cps/intset.scm | 30 |
1 files changed, 19 insertions, 11 deletions
diff --git a/module/language/cps/intset.scm b/module/language/cps/intset.scm index 8c5fef724..970a5e0f6 100644 --- a/module/language/cps/intset.scm +++ b/module/language/cps/intset.scm @@ -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*) - ;; A has a lower shift, but it not within B. - empty-intset - (intset-intersect a - (make-intset (+ b-min (ash b-idx b-shift)) - b-shift - (vector-ref b-root b-idx)))))))) + (cond + ((>= b-idx *branch-size*) + ;; A has a lower shift, but it not within B. + 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 + 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. - (intset-intersect a - (make-intset b-min - (- b-shift *branch-bits*) - (vector-ref b-root 0)))) + (cond + ((vector-ref b-root 0) + => (lambda (b-root) + (intset-intersect a + (make-intset b-min + (- b-shift *branch-bits*) + 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))) |