diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor index 293f49b69a..73706da340 100644 --- a/basis/math/intervals/intervals-tests.factor +++ b/basis/math/intervals/intervals-tests.factor @@ -398,6 +398,12 @@ commutative-ops [ { t } [ -1/0. 1/0. [ full-interval interval-contains? ] bi@ and ] unit-test +! Interval bitand +${ 0 0xaf [a,b] } [ 0 0xff [a,b] 0 0xaf [a,b] interval-bitand ] unit-test +${ -0x100 -10 [a,b] } [ -0xff -1 [a,b] -0xaf -10 [a,b] interval-bitand ] unit-test +${ -0x100 10 [a,b] } [ -0xff 1 [a,b] -0xaf 10 [a,b] interval-bitand ] unit-test +${ 0 0xff [a,b] } [ -0xff -1 [a,b] 0 0xff [a,b] interval-bitand ] unit-test + ! Interval bitor { 1/0. } [ 1/0. bit-weight ] unit-test { 1/0. } [ -1/0. bit-weight ] unit-test diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index e9e6cdf2ee..8c4c1a8e34 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -374,48 +374,23 @@ SYMBOL: incomparable [ nip (rem-range) ] } cond ; -: interval-bitand-pos ( i1 i2 -- ? ) - [ to>> first ] bi@ min 0 swap [a,b] ; - -: interval-bitand-neg ( i1 i2 -- ? ) - dup from>> first 0 < [ drop ] [ nip ] if - 0 swap to>> first [a,b] ; - : interval-nonnegative? ( i -- ? ) from>> first 0 >= ; : interval-negative? ( interval -- ? ) to>> first 0 < ; -: interval-bitand ( i1 i2 -- i3 ) - ! Inaccurate. - [ - { - { - [ 2dup [ interval-nonnegative? ] both? ] - [ interval-bitand-pos ] - } - { - [ 2dup [ interval-nonnegative? ] either? ] - [ interval-bitand-neg ] - } - [ 2drop [-inf,inf] ] - } cond - ] do-empty-interval ; - [ 1 + ] [ neg ] if next-power-of-2 ] if ; -: bounds ( interval -- lower upper ) - { - { full-interval [ -1/0. 1/0. ] } - [ interval>points [ first ] bi@ ] - } case ; +GENERIC: interval-bounds ( interval -- lower upper ) +M: full-interval interval-bounds drop -1/0. 1/0. ; +M: interval interval-bounds interval>points [ first ] bi@ ; : min-lower-bound ( i1 i2 -- n ) [ from>> first ] bi@ min ; @@ -423,13 +398,38 @@ SYMBOL: incomparable : max-lower-bound ( i1 i2 -- n ) [ from>> first ] bi@ max ; +: min-upper-bound ( i1 i2 -- n ) + [ to>> first ] bi@ min ; + : max-upper-bound ( i1 i2 -- n ) [ to>> first ] bi@ max ; : interval-bit-weight ( i1 -- n ) - bounds [ bit-weight ] bi@ max ; + interval-bounds [ bit-weight ] bi@ max ; PRIVATE> +: interval-bitand ( i1 i2 -- i3 ) + [ + { + { + [ 2dup [ interval-nonnegative? ] both? ] + [ min-upper-bound 0 swap [a,b] ] + } + { + [ 2dup [ interval-nonnegative? ] either? ] + [ + dup interval-nonnegative? [ nip ] [ drop ] if + to>> first 0 swap [a,b] + ] + } + { + [ 2dup [ interval-negative? ] both? ] + [ [ min-lower-bound bit-weight neg ] [ min-upper-bound ] 2bi [a,b] ] + } + [ [ min-lower-bound bit-weight neg ] [ max-upper-bound ] 2bi [a,b] ] + } cond + ] do-empty-interval ; + ! Basic Property of bitor: bits can never be taken away. For both signed and ! unsigned integers this means that the number can only grow towards positive ! infinity. Also, the significant bit range can never be larger than either of