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

integer/integer partial dispatch ops now use both-fixnums?

db4
Slava Pestov 2009-03-16 00:44:44 -05:00
parent 1fab364299
commit c468ed8962
2 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/math/partial-dispatch/partial-dispatch-tests.factor
View File

@ -26,3 +26,8 @@ tools.test math kernel sequences ;
[ fixnum-bitnot ] [ \ bitnot modular-variant ] unit-test [ fixnum-bitnot ] [ \ bitnot modular-variant ] unit-test
[ fixnum+fast ] [ \ fixnum+ modular-variant ] unit-test [ fixnum+fast ] [ \ fixnum+ modular-variant ] unit-test
[ fixnum+fast ] [ \ fixnum+fast modular-variant ] unit-test [ fixnum+fast ] [ \ fixnum+fast modular-variant ] unit-test
[ 3 ] [ 1 2 +-integer-integer ] unit-test
[ 3 ] [ 1 >bignum 2 +-integer-integer ] unit-test
[ 3 ] [ 1 2 >bignum +-integer-integer ] unit-test
[ 3 ] [ 1 >bignum 2 >bignum +-integer-integer ] unit-test

34
basis/math/partial-dispatch/partial-dispatch.factor
View File

@ -45,31 +45,41 @@ M: word integer-op-input-classes
{ bitnot fixnum-bitnot } { bitnot fixnum-bitnot }
} at swap or ; } at swap or ;
: bignum-fixnum-op-quot ( big-word -- quot )
'[ fixnum>bignum _ execute ] ;
: fixnum-bignum-op-quot ( big-word -- quot )
'[ [ fixnum>bignum ] dip _ execute ] ;
: integer-fixnum-op-quot ( fix-word big-word -- quot ) : integer-fixnum-op-quot ( fix-word big-word -- quot )
[ [
[ over fixnum? ] % [ over fixnum? ] %
[ '[ _ execute ] , ] [ '[ _ execute ] , ] [ bignum-fixnum-op-quot , ] bi* \ if ,
[ '[ fixnum>bignum _ execute ] , ] bi*
\ if ,
] [ ] make ; ] [ ] make ;
: fixnum-integer-op-quot ( fix-word big-word -- quot ) : fixnum-integer-op-quot ( fix-word big-word -- quot )
[ [
[ dup fixnum? ] % [ dup fixnum? ] %
[ '[ _ execute ] , ] [ '[ _ execute ] , ] [ fixnum-bignum-op-quot , ] bi* \ if ,
[ '[ [ fixnum>bignum ] dip _ execute ] , ] bi* ] [ ] make ;
\ if ,
: integer-bignum-op-quot ( big-word -- quot )
[
[ over fixnum? ] %
[ fixnum-bignum-op-quot , ] [ '[ _ execute ] , ] bi \ if ,
] [ ] make ; ] [ ] make ;
: integer-integer-op-quot ( fix-word big-word -- quot ) : integer-integer-op-quot ( fix-word big-word -- quot )
[ [
[ dup fixnum? ] % [ 2dup both-fixnums? ] %
2dup integer-fixnum-op-quot , [ '[ _ execute ] , ]
[ [
[ over fixnum? [ [ fixnum>bignum ] dip ] when ] % [
nip , [ dup fixnum? ] %
] [ ] make , [ bignum-fixnum-op-quot , ]
\ if , [ integer-bignum-op-quot , ] bi \ if ,
] [ ] make ,
] bi* \ if ,
] [ ] make ; ] [ ] make ;
: integer-op-word ( triple -- word ) : integer-op-word ( triple -- word )