]> gitweb.factorcode.org Git - factor.git/commitdiff
math: adding assert-positive and assert-negative
authorJohn Benediktsson <mrjbq7@gmail.com>
Mon, 1 May 2023 20:18:51 +0000 (13:18 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Mon, 1 May 2023 20:18:51 +0000 (13:18 -0700)
basis/concurrency/semaphores/semaphores.factor
basis/math/bits/bits-tests.factor
basis/math/bitwise/bitwise-tests.factor
basis/math/bitwise/bitwise.factor
basis/math/functions/integer-logs/integer-logs.factor
basis/see/see-tests.factor
core/generalizations/generalizations.factor
core/math/math-docs.factor
core/math/math.factor
core/sequences/sequences.factor

index 69ceab6c23d202d407f99220604aa5e869b6f563..fd4c9d243db2c4b4701ab12c134f6ad10613f0bc 100644 (file)
@@ -6,14 +6,8 @@ IN: concurrency.semaphores
 
 TUPLE: semaphore count threads ;
 
-ERROR: negative-count-semaphore ;
-
-M: negative-count-semaphore summary
-    drop "Cannot have semaphore with negative count" ;
-
 : <semaphore> ( n -- semaphore )
-    dup 0 < [ negative-count-semaphore ] when
-    <dlist> semaphore boa ;
+    assert-non-negative <dlist> semaphore boa ;
 
 : wait-to-acquire ( semaphore timeout -- )
     [ threads>> ] dip "semaphore" wait ;
index c7d1aeae82c7755caf740a17900354cedf195fd9..cf73a0573659d501a7a8b568a40fd894683be552 100644 (file)
@@ -11,7 +11,7 @@ USING: tools.test math math.bits sequences arrays ;
 { 1 } [ 0 make-bits length ] unit-test
 { 1 } [ 1 make-bits length ] unit-test
 { 2 } [ 3 make-bits length ] unit-test
-[ -3 make-bits length ] [ non-negative-integer-expected? ] must-fail-with
+[ -3 make-bits length ] [ non-negative-number-expected? ] must-fail-with
 
 ! Odd bug
 { t } [
index 79567c725c406d85fe117c91fc36a6f3c6b3d000..d992bc43a5d7c28ed3c8c3eb47ffad52373ac8d2 100644 (file)
@@ -75,8 +75,8 @@ SPECIALIZED-ARRAY: uint-4
 { 6 } [ 5 next-even ] unit-test
 { 8 } [ 6 next-even ] unit-test
 
-[ -1 bit-count ] [ non-negative-integer-expected? ] must-fail-with
-[ -1 bit-length ] [ non-negative-integer-expected? ] must-fail-with
+[ -1 bit-count ] [ non-negative-number-expected? ] must-fail-with
+[ -1 bit-length ] [ non-negative-number-expected? ] must-fail-with
 
 { 0b1111 } [ 4 on-bits ] unit-test
 { 0 } [ 0 on-bits ] unit-test
index f74bcc1620f0c088e1cc635f0dfe17cdcf2c5184..59e600633fdf9d278e96bb29a2b42b2d4c167e46 100644 (file)
@@ -143,7 +143,7 @@ M: object bit-count
     binary-object uchar <c-direct-array> byte-array-bit-count ;
 
 : bit-length ( x -- n )
-    dup 0 < [ non-negative-integer-expected ] [
+    dup 0 < [ non-negative-number-expected ] [
         dup 1 > [ log2 1 + ] when
     ] if ;
 
index 80e631e876917b6a58b6bad6d9917f8c1d5162a2..37ea8e11a51b84d9993aa78d159a8fb6131bffda 100644 (file)
@@ -73,8 +73,6 @@ M: bignum (integer-log10) bignum-integer-log10 ; inline
 
 PRIVATE>
 
-ERROR: log-expects-positive x ;
-
 <PRIVATE
 
 GENERIC: (integer-log2) ( x -- n ) foldable
@@ -102,7 +100,7 @@ M: ratio (integer-log10) [ (integer-log10) ] 10 (ratio-integer-log) ;
 PRIVATE>
 
 : integer-log10 ( x -- n )
-    [ (integer-log10) ] (integer-log) ; inline
+    assert-positive (integer-log10) ; inline
 
 : integer-log2 ( x -- n )
-    [ (integer-log2) ] (integer-log) ; inline
+    assert-positive (integer-log2) ; inline
index b245fc01ccf5970ca01d9f82da787008e77c60da..777f73921cf07a3ac610c5c16ce7157b95383789 100644 (file)
@@ -7,8 +7,8 @@ CONSTANT: test-const 10
 { "IN: see.tests\nCONSTANT: test-const 10 inline\n" }
 [ [ \ test-const see ] with-string-writer ] unit-test
 
-{ "IN: math\nERROR: non-negative-integer-expected n ;\n" }
-[ [ \ non-negative-integer-expected see ] with-string-writer ] unit-test
+{ "IN: math\nERROR: non-negative-number-expected n ;\n" }
+[ [ \ non-negative-number-expected see ] with-string-writer ] unit-test
 
 ALIAS: test-alias +
 
index c364b2c24de02b933ebb00069bbdf453338d5d2e..74808a26f2bf4b17ae4443438f4de9ab6c919b5c 100644 (file)
@@ -21,11 +21,9 @@ MACRO: call-n ( n -- quot )
 MACRO: nsum ( n -- quot )
     1 - [ + ] n*quot ;
 
-ERROR: nonpositive-npick n ;
-
 MACRO: npick ( n -- quot )
     {
-        { [ dup 0 <= ] [ nonpositive-npick ] }
+        { [ dup 0 <= ] [ positive-number-expected ] }
         { [ dup 1 = ] [ drop [ dup ] ] }
         [ 1 - [ dup ] [ '[ _ dip swap ] ] swapd times ]
     } cond ;
index a7ea9057c4b00d4c7dd950960c2885ac9988845e..a1552033f6eeabb2251b62d51d3cb6e1694aa5f2 100644 (file)
@@ -491,13 +491,6 @@ HELP: integer>fixnum-strict
 }
 { $description "Converts a general integer to a fixed-width integer." } ;
 
-HELP: log2-expects-positive
-{ $values
-    { "x" object }
-}
-{ $description "Throws a " { $link log2-expects-positive } " error." }
-{ $see-also log2 } ;
-
 HELP: neg?
 { $values
     { "x" object }
index 8b28ad5b87b32ad7b63c834c64fd5587fd3c4bc7..6dad0ab295694fd4f2bd84b74727c406af3508cd 100644 (file)
@@ -131,19 +131,25 @@ GENERIC: (log2) ( x -- n ) foldable
 
 PRIVATE>
 
-ERROR: non-negative-integer-expected n ;
+ERROR: non-negative-number-expected n ;
 
 : assert-non-negative ( n -- n )
-    dup 0 < [ non-negative-integer-expected ] when ; inline
+    dup 0 < [ non-negative-number-expected ] when ; inline
 
-: recursive-hashcode ( n obj quot -- code )
-    pick 0 <= [ 3drop 0 ] [ [ 1 - ] 2dip call ] if ; inline
+ERROR: positive-number-expected n ;
+
+: assert-positive ( n -- n )
+    dup 0 > [ positive-number-expected ] unless ; inline
 
-ERROR: log2-expects-positive x ;
+ERROR: negative-number-expected n ;
 
-: log2 ( x -- n )
-    dup 0 <= [ log2-expects-positive ] [ (log2) ] if ; inline
+: assert-negative ( n -- n )
+    dup 0 < [ negative-number-expected ] unless ; inline
+
+: recursive-hashcode ( n obj quot -- code )
+    pick 0 <= [ 3drop 0 ] [ [ 1 - ] 2dip call ] if ; inline
 
+: log2 ( x -- n ) assert-positive (log2) ; inline
 : zero? ( x -- ? ) 0 number= ; inline
 : 2/ ( x -- y ) -1 shift ; inline
 : sq ( x -- y ) dup * ; inline
index 028ef4f7f94956de0a9281af732a0f616a043444..29a2c214af50b7031eca4c1a1d534765c66f9039 100644 (file)
@@ -275,7 +275,7 @@ TUPLE: repetition
     { elt read-only } ;
 
 : <repetition> ( len elt -- repetition )
-    over 0 < [ non-negative-integer-expected ] when
+    over 0 < [ non-negative-number-expected ] when
     repetition boa ; inline
 
 M: repetition length length>> ; inline