compiler.tree.propagation.*: implements downgrading to fixnum for the

mod word, maybe a first step in solving #224

factor_vm::primitive_bignum_mod is changed so that it outputs a fixnum
if the value is small enough. Then the compiler can take advantage of
knowing that expressions like [ >bignum 10 mod ] always result in a
fixnum [-9,9] and inline more arithmetic.

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -51,6 +51,10 @@ IN: compiler.tree.propagation.known-words
 : 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 ;
 
@@ -123,13 +127,13 @@ IN: compiler.tree.propagation.known-words
 \ /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
 
@@ -232,11 +236,9 @@ generic-comparison-ops [
     { integer>fixnum-strict fixnum }
 
     { >bignum bignum }
-    { fixnum>bignum bignum }
     { float>bignum bignum }
 
     { >float float }
-    { fixnum>float float }
     { bignum>float float }
 
     { >integer integer }
@@ -244,6 +246,17 @@ generic-comparison-ops [
     '[ _ 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 }

basis/compiler/tree/propagation/propagation-tests.factor

@@ -21,6 +21,12 @@ IN: compiler.tree.propagation.tests
     ] 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
@@ -745,8 +751,11 @@ MIXIN: empty-mixin
     [ { 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 } ] [
@@ -770,7 +779,7 @@ MIXIN: empty-mixin
 [ 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
@@ -941,7 +950,7 @@ M: tuple-with-read-only-slot clone
 [ 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
 
@@ -1037,7 +1046,7 @@ M: f derp drop t ;
 : 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 )

basis/stack-checker/known-words/known-words.factor

@@ -332,7 +332,7 @@ M: object infer-call* \ call bad-macro-input ;
 \ 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

vm/math.cpp

@@ -2,6 +2,15 @@
 
 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()))));
 }
@@ -139,7 +148,8 @@ void factor_vm::primitive_bignum_divmod() {
 
 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() {