combinators: fix broken optimization that made floats work for integer keys.

core/combinators/combinators-tests.factor

@@ -236,6 +236,7 @@ CONSTANT: case-const-2 2
 [ f ] [ { 1 1 3 7 } contiguous-range? ] unit-test
 [ t ] [ { 7 6 4 8 5 } contiguous-range? ] unit-test
 
+
 : test-case-7 ( obj -- str )
     {
         { \ + [ "plus" ] }
@@ -324,3 +325,14 @@ DEFER: corner-case-1
 [ ( x x -- x x ) ] [
     [ { [ ] [ ] } spread ] infer
 ] unit-test
+
+: test-case-13 ( a -- b )
+    {
+        { 5 [ 5 ] }
+        { 6 [ 6 ] }
+        { 7 [ 7 ] }
+        { 8 [ 8 ] }
+        { 9 [ 9 ] }
+    } case ;
+
+[ 5.0 test-case-13 ] [ no-case? ] must-fail-with

core/combinators/combinators.factor

@@ -159,20 +159,20 @@ ERROR: no-case object ;
 : contiguous-range? ( keys -- ? )
     dup [ fixnum? ] all? [
         dup all-unique? [
-            [ length ]
-            [ [ supremum ] [ infimum ] bi - ]
-            bi - 1 =
+            [ length ] [ supremum ] [ infimum ] tri - - 1 =
         ] [ drop f ] if
     ] [ drop f ] if ;
 
 : dispatch-case-quot ( default assoc -- quot )
     [
-        \ dup ,
-        dup keys [ infimum , ] [ supremum , ] bi \ between? ,
-        [
-            dup keys infimum , [ - >fixnum ] %
-            sort-keys values [ >quotation ] map ,
-            \ dispatch ,
+        \ dup , \ integer? , [
+            \ integer>fixnum-strict , \ dup ,
+            dup keys [ infimum , ] [ supremum , ] bi \ between? ,
+            [
+                dup keys infimum , \ - ,
+                sort-keys values [ >quotation ] map ,
+                \ dispatch ,
+            ] [ ] make , dup , \ if ,
         ] [ ] make , , \ if ,
     ] [ ] make ;