math.intervals: Add [0,b] and [0,b), use in a couple of places

This replicates the `[0,b]` and `[0,b)` words from `math.ranges`.

diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index ba6c4dc64b1bce4221b4e1ba5c0c56fc7b8c3867..8a42872065a77c03400e43720a29810d12820fdd 100644 (file)
--- a/basis/compiler/tree/propagation/transforms/transforms.factor
+++ b/basis/compiler/tree/propagation/transforms/transforms.factor
@@ -57,7 +57,7 @@ IN: compiler.tree.propagation.transforms
     [ interval>> ] [ literal>> ] bi* {
         [ nip integer? ]
         [ nip all-ones? ]
-        [ 0 swap [a,b] interval-subset? ]
+        [ [0,b] interval-subset? ]
     } 2&& ;
 
 : zero-bitand? ( value1 value2 -- ? )

diff --git a/basis/math/intervals/intervals-docs.factor b/basis/math/intervals/intervals-docs.factor
index 309e1ca074e68f8db872ed7a9fcb3770eb462fdf..89ae7791145a9b628732ad1f4dab9bab2cca5241 100644 (file)
--- a/basis/math/intervals/intervals-docs.factor
+++ b/basis/math/intervals/intervals-docs.factor
@@ -146,6 +146,15 @@ HELP: [a,a]
 { $values { "a" real } { "interval" interval } }
 { $description "Creates a new interval consisting of a single point." } ;
 
+HELP: [0,b]
+{ $values { "b" real } { "interval" interval } }
+{ $description "Creates a new interval that includes lower endpoint 0 and includes the upper endpoint." } ;
+
+HELP: [0,b)
+{ $values { "b" real } { "interval" interval } }
+{ $description "Creates a new interval that includes lower endpoint 0 and excludes the upper endpoint." } ;
+
+
 HELP: [-inf,a]
 { $values { "a" real } { "interval" interval } }
 { $description "Creates a new interval containing all real numbers less than or equal to " { $snippet "a" } ", together with negative infinity." } ;

diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor
index 73706da34052576ea91438621a3f831ac60c3cb2..99c88c72ed3ab9ee08e8255150099a3d84a01e88 100644 (file)
--- a/basis/math/intervals/intervals-tests.factor
+++ b/basis/math/intervals/intervals-tests.factor
@@ -23,6 +23,10 @@ IN: math.intervals.tests
 
 { T{ interval f { 1 t } { 1 t } } } [ 1 [a,a] ] unit-test
 
+{ T{ interval f { 0 t } { 42 t } } } [ 42 [0,b] ] unit-test
+
+{ T{ interval f { 0 t } { 42 f } } } [ 42 [0,b) ] unit-test
+
 ! Not sure how to handle NaNs yet...
 ! [ 1 0/0. [a,b] ] must-fail
 ! [ 0/0. 1 [a,b] ] must-fail

diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor
index 63fa4582fd3df8b331fccd46efc107daa307327f..60e933f5304c97ba20133193b64dd7573d12245c 100644 (file)
--- a/basis/math/intervals/intervals.factor
+++ b/basis/math/intervals/intervals.factor
@@ -60,6 +60,10 @@ M: full-interval to>> drop { 1/0. t } ;
 
 : (a,inf] ( a -- interval ) 1/0. (a,b] ; inline
 
+: [0,b] ( b -- interval ) 0 swap [a,b] ; inline
+
+: [0,b) ( b -- interval ) 0 swap [a,b) ; inline
+
 MEMO: [0,inf] ( -- interval ) 0 [a,inf] ; foldable
 
 MEMO: fixnum-interval ( -- interval )
@@ -364,7 +368,7 @@ SYMBOL: incomparable
     } cond
     swap 0 [a,a] interval>= t eq? [ [0,inf] interval-intersect ] when ;
 
-: (rem-range) ( i -- i' ) interval-abs to>> first 0 swap [a,b) ;
+: (rem-range) ( i -- i' ) interval-abs to>> first [0,b) ;
 
 : interval-rem ( i1 i2 -- i3 )
     {
@@ -413,13 +417,13 @@ PRIVATE>
         {
             {
                 [ 2dup [ interval-nonnegative? ] both? ]
-                [ min-upper-bound 0 swap [a,b] ]
+                [ min-upper-bound [0,b] ]
             }
             {
                 [ 2dup [ interval-nonnegative? ] either? ]
                 [
                     dup interval-nonnegative? [ nip ] [ drop ] if
-                    to>> first 0 swap [a,b]
+                    to>> first [0,b]
                 ]
             }
             [
@@ -461,9 +465,9 @@ PRIVATE>
 : interval-bitxor ( i1 i2 -- i3 )
     [
         { { [ 2dup [ interval-nonnegative? ] both? ]
-            [ max-upper-bound bit-weight 1 - 0 swap [a,b] ] }
+            [ max-upper-bound bit-weight 1 - [0,b] ] }
           { [ 2dup [ interval-negative? ] both? ]
-            [ min-lower-bound bit-weight 1 - 0 swap [a,b] ] }
+            [ min-lower-bound bit-weight 1 - [0,b] ] }
           [ interval-union interval-bit-weight [ neg ] [ 1 - ] bi [a,b] ]
         } cond
     ] do-empty-interval ;
@@ -474,7 +478,7 @@ M: full-interval interval-log2 drop [0,inf] ;
 M: interval interval-log2
     to>> first 1 max dup most-positive-fixnum >
     [ drop full-interval interval-log2 ]
-    [ 1 + >integer log2 0 swap [a,b] ]
+    [ 1 + >integer log2 [0,b] ]
     if ;
 
 : assume< ( i1 i2 -- i3 )