diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor
index 5234f03ecf..806b0961ca 100755
--- a/basis/math/intervals/intervals-tests.factor
+++ b/basis/math/intervals/intervals-tests.factor
@@ -123,6 +123,8 @@ IN: math.intervals.tests
 
 [ empty-interval ] [ -1 1 (a,b) empty-interval interval/ ] unit-test
 
+[ t ] [ 0 0 331 [a,b) -1775 -953 (a,b) interval/ interval-contains? ] unit-test
+
 [ t ] [ -1 1 (a,b) -1 1 (a,b) interval/ [-inf,inf] = ] unit-test
 
 [ t ] [ -1 1 (a,b) 0 1 (a,b) interval/ [-inf,inf] = ] unit-test
diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor
index 6e50f42726..df3d46fcb4 100755
--- a/basis/math/intervals/intervals.factor
+++ b/basis/math/intervals/intervals.factor
@@ -76,10 +76,12 @@ TUPLE: interval { from read-only } { to read-only } ;
     [ from>> ] [ to>> ] bi ;
 
 : points>interval ( seq -- interval )
-    dup [ first fp-nan? ] contains? [ drop [-inf,inf] ] [
+    dup [ first fp-nan? ] contains?
+    [ drop [-inf,inf] ] [
         dup first
-        [ [ endpoint-min ] reduce ] 2keep
-        [ endpoint-max ] reduce <interval>
+        [ [ endpoint-min ] reduce ]
+        [ [ endpoint-max ] reduce ]
+        2bi <interval>
     ] if ;
 
 : (interval-op) ( p1 p2 quot -- p3 )
@@ -108,19 +110,6 @@ TUPLE: interval { from read-only } { to read-only } ;
 : interval- ( i1 i2 -- i3 )
     [ [ - ] interval-op ] do-empty-interval ;
 
-: interval* ( i1 i2 -- i3 )
-    [ [ * ] interval-op ] do-empty-interval ;
-
-: interval-1+ ( i1 -- i2 ) 1 [a,a] interval+ ;
-
-: interval-1- ( i1 -- i2 ) -1 [a,a] interval+ ;
-
-: interval-neg ( i1 -- i2 ) -1 [a,a] interval* ;
-
-: interval-bitnot ( i1 -- i2 ) interval-neg interval-1- ;
-
-: interval-sq ( i1 -- i2 ) dup interval* ;
-
 : interval-intersect ( i1 i2 -- i3 )
     {
         { [ dup empty-interval eq? ] [ nip ] }
@@ -159,6 +148,21 @@ TUPLE: interval { from read-only } { to read-only } ;
 : interval-contains? ( x int -- ? )
     >r [a,a] r> interval-subset? ;
 
+: interval* ( i1 i2 -- i3 )
+    [ [ [ * ] interval-op ] do-empty-interval ]
+    [ [ 0 swap interval-contains? ] either? ] 2bi
+    [ 0 [a,a] interval-union ] when ;
+
+: interval-1+ ( i1 -- i2 ) 1 [a,a] interval+ ;
+
+: interval-1- ( i1 -- i2 ) -1 [a,a] interval+ ;
+
+: interval-neg ( i1 -- i2 ) -1 [a,a] interval* ;
+
+: interval-bitnot ( i1 -- i2 ) interval-neg interval-1- ;
+
+: interval-sq ( i1 -- i2 ) dup interval* ;
+
 : interval-singleton? ( int -- ? )
     dup empty-interval eq? [
         drop f
@@ -216,8 +220,11 @@ TUPLE: interval { from read-only } { to read-only } ;
     ] unless ;
 
 : interval-division-op ( i1 i2 quot -- i3 )
-    >r 0 over interval-closure interval-contains?
-    [ 2drop [-inf,inf] ] r> if ; inline
+    {
+        { [ 0 pick interval-closure interval-contains? ] [ 3drop [-inf,inf] ] }
+        { [ pick 0 swap interval-contains? ] [ call 0 [a,a] interval-union ] }
+        [ call ]
+    } cond ; inline
 
 : interval/ ( i1 i2 -- i3 )
     [ [ [ / ] interval-op ] interval-division-op ] do-empty-interval ;