diff --git a/basis/math/partial-dispatch/partial-dispatch-tests.factor b/basis/math/partial-dispatch/partial-dispatch-tests.factor index bcf7bb77b0..29979b62d3 100644 --- a/basis/math/partial-dispatch/partial-dispatch-tests.factor +++ b/basis/math/partial-dispatch/partial-dispatch-tests.factor @@ -26,3 +26,8 @@ tools.test math kernel sequences ; [ fixnum-bitnot ] [ \ bitnot modular-variant ] unit-test [ fixnum+fast ] [ \ fixnum+ 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 \ No newline at end of file diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor index 08cd8fb470..6679e81fcd 100644 --- a/basis/math/partial-dispatch/partial-dispatch.factor +++ b/basis/math/partial-dispatch/partial-dispatch.factor @@ -45,31 +45,41 @@ M: word integer-op-input-classes { bitnot fixnum-bitnot } } 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 ) [ [ over fixnum? ] % - [ '[ _ execute ] , ] - [ '[ fixnum>bignum _ execute ] , ] bi* - \ if , + [ '[ _ execute ] , ] [ bignum-fixnum-op-quot , ] bi* \ if , ] [ ] make ; : fixnum-integer-op-quot ( fix-word big-word -- quot ) [ [ dup fixnum? ] % - [ '[ _ execute ] , ] - [ '[ [ fixnum>bignum ] dip _ execute ] , ] bi* - \ if , + [ '[ _ execute ] , ] [ fixnum-bignum-op-quot , ] bi* \ if , + ] [ ] make ; + +: integer-bignum-op-quot ( big-word -- quot ) + [ + [ over fixnum? ] % + [ fixnum-bignum-op-quot , ] [ '[ _ execute ] , ] bi \ if , ] [ ] make ; : integer-integer-op-quot ( fix-word big-word -- quot ) [ - [ dup fixnum? ] % - 2dup integer-fixnum-op-quot , + [ 2dup both-fixnums? ] % + [ '[ _ execute ] , ] [ - [ over fixnum? [ [ fixnum>bignum ] dip ] when ] % - nip , - ] [ ] make , - \ if , + [ + [ dup fixnum? ] % + [ bignum-fixnum-op-quot , ] + [ integer-bignum-op-quot , ] bi \ if , + ] [ ] make , + ] bi* \ if , ] [ ] make ; : integer-op-word ( triple -- word )