diff --git a/basis/compiler/tree/propagation/known-words/known-words-tests.factor b/basis/compiler/tree/propagation/known-words/known-words-tests.factor
index dd8974df0a..8ef9056cf5 100644
--- a/basis/compiler/tree/propagation/known-words/known-words-tests.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words-tests.factor
@@ -1,21 +1,34 @@
-USING: compiler.tree.propagation.known-words kernel math math.intervals
-tools.test ;
+USING: accessors compiler.tree.propagation.info
+compiler.tree.propagation.known-words kernel kernel.private layouts math
+math.intervals math.private random tools.test words ;
 IN: compiler.tree.propagation.known-words.tests
 
 {
-    fixnum
-    T{ interval { from { -19 t } } { to { 19 t } } }
+    fixnum T{ interval { from { -19 t } } { to { 19 t } } }
 } [
-    integer
-    T{ interval { from { -19 t } } { to { 19 t } } }
-    maybe>fixnum
+    fixnum fixnum full-interval 0 20 [a,b] mod-merge-classes/intervals
 ] unit-test
 
 {
-    object
-    T{ interval { from { -19 t } } { to { 19 t } } }
+    object T{ interval { from { -20 f } } { to { 20 f } } }
 } [
-    object
-    T{ interval { from { -19 t } } { to { 19 t } } }
-    maybe>fixnum
+    object object full-interval 0 20 [a,b] mod-merge-classes/intervals
+] unit-test
+
+{ fixnum } [
+    bignum <class-info>
+    fixnum fixnum-interval <class/interval-info>
+    \ mod "outputs" word-prop call( x y -- z )
+    class>>
+] unit-test
+
+! Since 10 >bignum 5 >bignum bignum-mod => fixnum, the output class
+! must be integer.
+{ integer } [
+    bignum <class-info> dup \ bignum-mod "outputs" word-prop call class>>
+] unit-test
+
+{ t } [
+    100 random 2^ >bignum
+    [ { bignum } declare 10 /mod ] call nip fixnum?
 ] unit-test
diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 63286a2493..9b6e943a01 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -51,10 +51,6 @@ 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 ;
 
@@ -98,12 +94,14 @@ IN: compiler.tree.propagation.known-words
 
 \ absq [ interval-absq ] [ may-overflow real-valued ] unary-op
 
-: binary-op-class ( info1 info2 -- newclass )
-    [ class>> ] bi@
+: merge-classes ( class1 class2 -- class3 )
     2dup [ null-class? ] either? [ 2drop null ] [
         [ math-closure ] bi@ math-class-max
     ] if ;
 
+: binary-op-class ( info1 info2 -- newclass )
+    [ class>> ] bi@ merge-classes ;
+
 : binary-op-interval ( info1 info2 quot -- newinterval )
     [ [ interval>> ] bi@ ] dip call ; inline
 
@@ -127,13 +125,30 @@ 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 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 maybe>fixnum ] binary-op
-\ fixnum-mod [ interval-mod ] [ fixnum-valued ] binary-op
-\ mod-fixnum-integer [ interval-mod ] [ fixnum-valued ] binary-op
-\ mod-integer-fixnum [ interval-mod ] [ fixnum-valued ] binary-op
+: mod-merge-classes/intervals ( c1 c2 i1 i2 -- c3 i3 )
+    [ merge-classes dup bignum = [ drop integer ] when ]
+    [ interval-mod ] 2bi*
+    over integer class<= [
+        integral-closure dup fixnum-interval interval-subset? [
+            nip fixnum swap
+        ] when
+    ] when ;
+
+: mod-outputs-info ( info1 info2 fixer-word -- info3 )
+    [
+        [ [ class>> ] bi@ ] [ [ interval>> ] bi@ ] 2bi
+        mod-merge-classes/intervals
+    ] dip execute( cls int -- cls' int' ) <class/interval-info> ;
+
+{
+    { mod real-valued }
+    { fmod real-valued }
+    { mod-integer-integer integer-valued }
+    { mod-fixnum-integer integer-valued }
+    { mod-integer-fixnum integer-valued }
+    { bignum-mod integer-valued }
+    { fixnum-mod fixnum-valued }
+} [ '[ _ mod-outputs-info ] "outputs" set-word-prop ] assoc-each
 
 \ rem [ [ interval-rem ] [ may-overflow real-valued ] binary-op ] each-derived-op
 
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index c21634e856..c8be22b535 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -1,15 +1,14 @@
-USING: kernel compiler.tree.builder compiler.tree
-compiler.tree.propagation compiler.tree.recursive
-compiler.tree.normalization tools.test math math.order accessors
-sequences arrays kernel.private vectors alien.accessors
-alien.c-types sequences.private byte-arrays classes.algebra
-classes.tuple.private math.functions math.private strings
-layouts compiler.tree.propagation.info compiler.tree.def-use
-compiler.tree.debugger compiler.tree.checker slots.private words
-hashtables classes assocs locals specialized-arrays system
-sorting math.libm math.floats.private math.integers.private
-math.intervals quotations effects alien alien.data sets
-strings.private vocabs generic.single ;
+USING: accessors alien alien.accessors alien.c-types alien.data arrays assocs
+byte-arrays classes classes.algebra classes.tuple.private compiler.tree
+compiler.tree.builder compiler.tree.checker compiler.tree.debugger
+compiler.tree.def-use compiler.tree.normalization compiler.tree.optimizer
+compiler.tree.propagation compiler.tree.propagation.info
+compiler.tree.recursive effects fry generic.single hashtables kernel
+kernel.private layouts locals math math.floats.private math.functions
+math.integers.private math.intervals math.libm math.order math.private
+quotations sets sequences sequences.private slots.private sorting
+specialized-arrays strings strings.private system tools.test vectors vocabs
+words ;
 FROM: math => float ;
 SPECIALIZED-ARRAY: double
 SPECIALIZED-ARRAY: void*
@@ -751,11 +750,42 @@ MIXIN: empty-mixin
     [ { float } declare 0 eq? ] final-classes
 ] unit-test
 
-! 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
+{
+    { fixnum integer integer fixnum }
+} [
+    {
+        { integer fixnum }
+        ! These two are tricky. Possibly, they will always be
+        ! fixnums. But that requires a better interval-mod.
+        { fixnum integer }
+        { fixnum bignum }
+        { bignum fixnum }
+    } [ '[ _ declare mod ] final-classes first ] map
+] unit-test
+
+! Due to downpromotion, we lose the type here.
+{ V{ integer } } [
+    [ { bignum bignum } declare bignum-mod ] final-classes
+] unit-test
+
+! And here
+{ V{ bignum integer } } [
+    [ { bignum bignum } declare /mod ] final-classes
+] unit-test
+
+! So this code gets worse than it was.
+{
+    [
+        bignum-mod 20 over tag 0 eq?
+        [ fixnum+ ] [ fixnum>bignum bignum+ ] if
+    ]
+} [
+    [ { bignum bignum } declare bignum-mod 20 + ]
+    build-tree optimize-tree nodes>quot
+] unit-test
+
+{ V{ fixnum } } [
+    [ fixnum-mod ] final-classes
 ] unit-test
 
 [ V{ integer } ] [