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 ;
{ 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 } [
{ 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
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 ;
PRIVATE>
-ERROR: log-expects-positive x ;
-
<PRIVATE
GENERIC: (integer-log2) ( x -- n ) foldable
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
{ "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 +
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 ;
}
{ $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 }
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
{ 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