steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.intervals: improve interval-bitand.

clean-macosx-x86-64
John Benediktsson 2019-10-31 10:27:17 -07:00
parent 29ebfe5129
commit bccdb5419b
2 changed files with 37 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/math/intervals/intervals-tests.factor
View File

@ -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

62
basis/math/intervals/intervals.factor
View File

@ -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 ;
<PRIVATE
! Return the weight of the MSB. For signed numbers, this does not mean the sign
! bit.
! Return the weight of the MSB. For signed numbers, this does
! not mean the sign bit.
: bit-weight ( n -- m )
dup [ -1/0. = ] [ 1/0. = ] bi or
[ drop 1/0. ]
[ dup 0 > [ 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