diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 8ec98ccc66..e5cade415a 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -149,6 +149,12 @@ IN: compiler.tree.propagation.tests
     ] final-literals
 ] unit-test
 
+[ V{ t } ] [ [ 40 mod 40 < ] final-literals ] unit-test
+
+[ V{ f } ] [ [ 40 mod 0 >= ] final-literals ] unit-test
+
+[ V{ t } ] [ [ 40 rem 0 >= ] final-literals ] unit-test
+
 [ V{ string } ] [
     [ dup string? not [ "Oops" throw ] [ ] if ] final-classes
 ] unit-test
diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor
index 2b8b3dff24..929df04e9e 100644
--- a/basis/math/intervals/intervals-tests.factor
+++ b/basis/math/intervals/intervals-tests.factor
@@ -211,6 +211,10 @@ IN: math.intervals.tests
 
 [ t ] [ 1 100 [a,b] -1 1 [a,b] interval/i [-inf,inf] = ] unit-test
 
+! Accuracy of interval-mod
+[ t ] [ full-interval 40 40 [a,b] interval-mod -40 40 (a,b) interval-subset?
+] unit-test
+
 ! Interval random tester
 : random-element ( interval -- n )
     dup full-interval eq? [
diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor
index 767197a975..0c2540eb8b 100755
--- a/basis/math/intervals/intervals.factor
+++ b/basis/math/intervals/intervals.factor
@@ -270,20 +270,20 @@ TUPLE: interval { from read-only } { to read-only } ;
     } cond ;
 
 : interval-mod ( i1 i2 -- i3 )
-    #! Inaccurate.
-    [
-        [
-            nip interval-abs to>> first [ neg ] keep (a,b)
-        ] interval-division-op
-    ] do-empty-interval ;
+    {
+        { [ over empty-interval eq? ] [ drop ] }
+        { [ dup empty-interval eq? ] [ nip ] }
+        { [ dup full-interval eq? ] [ nip ] }
+        [ nip interval-abs to>> first [ neg ] keep (a,b) ]
+    } cond ;
 
 : interval-rem ( i1 i2 -- i3 )
-    #! Inaccurate.
-    [
-        [
-            nip interval-abs to>> first 0 swap [a,b)
-        ] interval-division-op
-    ] do-empty-interval ;
+    {
+        { [ over empty-interval eq? ] [ drop ] }
+        { [ dup empty-interval eq? ] [ nip ] }
+        { [ dup full-interval eq? ] [ nip ] }
+        [ nip interval-abs to>> first 0 swap [a,b) ]
+    } cond ;
 
 : interval-recip ( i1 -- i2 ) 1 [a,a] swap interval/ ;