add support for infinity to intervals

diff --git a/extra/db/queries/queries.factor b/extra/db/queries/queries.factor
index 7f3eaff84ce8961604ab0d1a8133783b7fad2e76..9ee44ffeedb81bfcd707cdd9adc251fa53f8a817 100644 (file)
--- a/extra/db/queries/queries.factor
+++ b/extra/db/queries/queries.factor
@@ -44,19 +44,38 @@ M: random-id-generator eval-generator ( singleton -- obj )
 : interval-comparison ( ? str -- str )
     "from" = " >" " <" ? swap [ "= " append ] when ;
 
+: fp-infinity? ( float -- ? )
+    dup float? [
+        double>bits -52 shift 11 2^ 1- [ bitand ] keep =
+    ] [
+        drop f
+    ] if ;
+
 : where-interval ( spec obj from/to -- )
-    pick column-name>> 0%
-    >r first2 r> interval-comparison 0%
-    bind# ;
+    over first fp-infinity? [
+        3drop
+    ] [
+        pick column-name>> 0%
+        >r first2 r> interval-comparison 0%
+        bind#
+    ] if ;
 
 : in-parens ( quot -- )
     "(" 0% call ")" 0% ; inline
 
 M: interval where ( spec obj -- )
-    [
-        [ from>> "from" where-interval " and " 0% ]
-        [ to>> "to" where-interval ] 2bi
-    ] in-parens ;
+    dup [ from>> ] [ to>> ] bi
+    [ first fp-infinity? ] bi@ and [
+        2drop
+        " 1 = 1 " 0% ! dummy
+    ] [
+        [
+            [ from>> "from" where-interval ] [
+                nip [ from>> ] [ to>> ] bi
+                [ first fp-infinity? ] bi@ or [ " and " 0% ] unless
+            ] [ to>> "to" where-interval ] 2tri
+        ] in-parens
+    ] if ;
 
 M: sequence where ( spec obj -- )
     [

diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index 81a402ee5dc011d7400bf0a6676bd1f2b6fb3ef9..2b73b5c4fe516a6eba9bf9adc16011364739e4fc 100755 (executable)
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -293,6 +293,35 @@ TUPLE: exam id name score ;
         }
     ] [
         T{ exam f T{ range f 1 3 1 } } select-tuples
+    ] unit-test
+
+    [
+        {
+            T{ exam f 2 "Stan" 80 }
+            T{ exam f 3 "Kenny" 60 }
+            T{ exam f 4 "Cartman" 41 }
+        }
+    ] [
+        T{ exam f T{ interval f { 2 t } { 1.0/0.0 f } } } select-tuples
+    ] unit-test
+
+    [
+        {
+            T{ exam f 1 "Kyle" 100 }
+        }
+    ] [
+        T{ exam f T{ interval f { -1.0/0.0 t } { 2 f } } } select-tuples
+    ] unit-test
+
+    [
+        {
+            T{ exam f 1 "Kyle" 100 }
+            T{ exam f 2 "Stan" 80 }
+            T{ exam f 3 "Kenny" 60 }
+            T{ exam f 4 "Cartman" 41 }
+        }
+    ] [
+        T{ exam f T{ interval f { -1.0/0.0 t } { 1/0. f } } } select-tuples
     ] unit-test ;
 
 TUPLE: bignum-test id m n o ;