: ensure-math-class ( class must-be -- class' )
[ class<= ] most ;
+: maybe>fixnum ( class interval -- class' interval )
+ 2dup [ integer class<= ] [ fixnum-interval interval-subset? ] bi*
+ and [ nip fixnum swap ] when ;
+
: number-valued ( class interval -- class' interval' )
[ number ensure-math-class ] dip ;
\ /i [ [ interval/i ] [ may-overflow integer-valued ] binary-op ] each-derived-op
\ /f [ [ interval/f ] [ float-valued ] binary-op ] each-derived-op
-\ mod [ interval-mod ] [ real-valued ] binary-op
+\ mod [ interval-mod ] [ real-valued maybe>fixnum ] binary-op
\ fmod [ interval-mod ] [ real-valued ] binary-op
\ mod-integer-integer [ interval-mod ] [ integer-valued ] binary-op
-\ bignum-mod [ interval-mod ] [ integer-valued ] binary-op
+\ bignum-mod [ interval-mod ] [ integer-valued maybe>fixnum ] binary-op
\ fixnum-mod [ interval-mod ] [ fixnum-valued ] binary-op
-\ mod-fixnum-integer [ interval-mod ] [ integer-valued ] binary-op
-\ mod-integer-fixnum [ interval-mod ] [ integer-valued ] binary-op
+\ mod-fixnum-integer [ interval-mod ] [ fixnum-valued ] binary-op
+\ mod-integer-fixnum [ interval-mod ] [ fixnum-valued ] binary-op
\ rem [ [ interval-rem ] [ may-overflow real-valued ] binary-op ] each-derived-op
{ integer>fixnum-strict fixnum }
{ >bignum bignum }
- { fixnum>bignum bignum }
{ float>bignum bignum }
{ >float float }
- { fixnum>float float }
{ bignum>float float }
{ >integer integer }
'[ _ swap interval>> <class/interval-info> ] "outputs" set-word-prop
] assoc-each
+! For these we limit the outputted interval
+{
+ { fixnum>bignum bignum }
+ { fixnum>float float }
+} [
+ '[
+ _ swap interval>> fixnum-interval interval-intersect
+ <class/interval-info>
+ ] "outputs" set-word-prop
+] assoc-each
+
{
{ >array array }
{ >vector vector }
] filter
] unit-test
+! The value interval should be limited for these.
+{ t t } [
+ [ fixnum>bignum ] final-info first interval>> fixnum-interval =
+ [ fixnum>float ] final-info first interval>> fixnum-interval =
+] unit-test
+
[ V{ } ] [ [ ] final-classes ] unit-test
[ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test
[ { float } declare 0 eq? ] final-classes
] unit-test
-[ V{ integer } ] [
+! Here we can know both that 1) mod(integer, fixnum) = fixnum and 2)
+! mod(fixnum, integer) = fixnum
+[ V{ fixnum } V{ fixnum } ] [
[ { integer fixnum } declare mod ] final-classes
+ [ { fixnum integer } declare mod ] final-classes
] unit-test
[ V{ integer } ] [
[ V{ t } ] [
[ [ 123 bitand ] [ drop f ] if dup [ 0 >= ] [ not ] if ] final-literals
] unit-test
-
+
[ V{ bignum } ] [
[ { bignum } declare dup 1 - bitxor ] final-classes
] unit-test
[ V{ fixnum } ] [ [ >bignum 10 mod 2^ ] final-classes ] unit-test
[ V{ bignum } ] [ [ >bignum 10 bitand ] final-classes ] unit-test
[ V{ bignum } ] [ [ >bignum 10 >bignum bitand ] final-classes ] unit-test
-[ V{ bignum } ] [ [ >bignum 10 mod ] final-classes ] unit-test
+[ V{ fixnum } ] [ [ >bignum 10 mod ] final-classes ] unit-test
[ V{ bignum } ] [ [ { fixnum } declare -1 >bignum bitand ] final-classes ] unit-test
[ V{ bignum } ] [ [ { fixnum } declare -1 >bignum swap bitand ] final-classes ] unit-test
: bitand-ratio1 ( x -- y )
1 swap bitand zero? ;
-[ 2+1/2 bitand-ratio0 ] [ no-method? ] must-fail-with
+[ 2+1/2 bitand-ratio0 ] [ no-method? ] must-fail-with
[ 2+1/2 bitand-ratio1 ] [ no-method? ] must-fail-with
: shift-test0 ( x -- y )
\ bignum-bitor { bignum bignum } { bignum } define-primitive \ bignum-bitor make-foldable
\ bignum-bitxor { bignum bignum } { bignum } define-primitive \ bignum-bitxor make-foldable
\ bignum-log2 { bignum } { bignum } define-primitive \ bignum-log2 make-foldable
-\ bignum-mod { bignum bignum } { bignum } define-primitive \ bignum-mod make-foldable
+\ bignum-mod { bignum bignum } { integer } define-primitive \ bignum-mod make-foldable
\ bignum-gcd { bignum bignum } { bignum } define-primitive \ bignum-gcd make-foldable
\ bignum-shift { bignum fixnum } { bignum } define-primitive \ bignum-shift make-foldable
\ bignum/i { bignum bignum } { bignum } define-primitive \ bignum/i make-foldable
namespace factor {
+cell bignum_maybe_to_fixnum(bignum* bn) {
+ fixnum len = BIGNUM_LENGTH(bn);
+ bignum_digit_type *digits = BIGNUM_START_PTR(bn);
+ if (len == 1 && digits[0] >= fixnum_min && digits[0] <= fixnum_max) {
+ return tag_fixnum(bignum_to_fixnum(bn));
+ }
+ return tag<bignum>(bn);
+}
+
void factor_vm::primitive_bignum_to_fixnum() {
ctx->replace(tag_fixnum(bignum_to_fixnum(untag<bignum>(ctx->peek()))));
}
void factor_vm::primitive_bignum_mod() {
POP_BIGNUMS(x, y);
- ctx->replace(tag<bignum>(bignum_remainder(x, y)));
+ cell val = bignum_maybe_to_fixnum(bignum_remainder(x, y));
+ ctx->replace(val);
}
void factor_vm::primitive_bignum_gcd() {