add if-zero/when-zero/unless-zero to core/ and update usages
parent
3cae26b9cd
commit
14ef1649d4
|
@ -14,7 +14,7 @@ M: array resize resize-array ;
|
|||
|
||||
M: object new-sequence drop 0 <array> ;
|
||||
|
||||
M: f new-sequence drop dup zero? [ drop f ] [ 0 <array> ] if ;
|
||||
M: f new-sequence drop [ f ] [ 0 <array> ] if-zero ;
|
||||
|
||||
M: array equal?
|
||||
over array? [ sequence= ] [ 2drop f ] if ;
|
||||
|
|
|
@ -73,14 +73,14 @@ M: utf8 encode-char
|
|||
PRIVATE>
|
||||
|
||||
: code-point-length ( n -- x )
|
||||
dup zero? [ drop 1 ] [
|
||||
[ 1 ] [
|
||||
log2 {
|
||||
{ [ dup 0 6 between? ] [ 1 ] }
|
||||
{ [ dup 7 10 between? ] [ 2 ] }
|
||||
{ [ dup 11 15 between? ] [ 3 ] }
|
||||
{ [ dup 16 20 between? ] [ 4 ] }
|
||||
} cond nip
|
||||
] if ;
|
||||
] if-zero ;
|
||||
|
||||
: code-point-offsets ( string -- indices )
|
||||
0 [ code-point-length + ] accumulate swap suffix ;
|
||||
|
|
|
@ -121,14 +121,14 @@ M: bignum (log2) bignum-log2 ;
|
|||
over zero? [
|
||||
2drop 0.0
|
||||
] [
|
||||
dup zero? [
|
||||
2drop 1/0.
|
||||
[
|
||||
drop 1/0.
|
||||
] [
|
||||
pre-scale
|
||||
/f-loop over odd?
|
||||
[ zero? [ 1 + ] unless ] [ drop ] if
|
||||
post-scale
|
||||
] if
|
||||
] if-zero
|
||||
] if ; inline
|
||||
|
||||
M: bignum /f ( m n -- f )
|
||||
|
|
|
@ -131,7 +131,7 @@ M: ratio >base
|
|||
[
|
||||
dup 0 < negative? set
|
||||
abs 1 /mod
|
||||
[ dup zero? [ drop "" ] [ (>base) sign append ] if ]
|
||||
[ [ "" ] [ (>base) sign append ] if-zero ]
|
||||
[
|
||||
[ numerator (>base) ]
|
||||
[ denominator (>base) ] bi
|
||||
|
|
|
@ -1214,7 +1214,7 @@ HELP: follow
|
|||
{ $examples "Get random numbers until zero is reached:"
|
||||
{ $unchecked-example
|
||||
"USING: random sequences prettyprint math ;"
|
||||
"100 [ random dup zero? [ drop f ] when ] follow ."
|
||||
"100 [ random [ f ] when-zero ] follow ."
|
||||
"{ 100 86 34 32 24 11 7 2 }"
|
||||
} } ;
|
||||
|
||||
|
|
|
@ -29,13 +29,27 @@ M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
|
|||
|
||||
: empty? ( seq -- ? ) length 0 = ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (if-empty) ( seq quot1 quot2 quot3 -- )
|
||||
[ [ drop ] prepose ] [ ] tri* if ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: if-empty ( seq quot1 quot2 -- )
|
||||
[ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline
|
||||
[ dup empty? ] (if-empty) ; inline
|
||||
|
||||
: when-empty ( seq quot -- ) [ ] if-empty ; inline
|
||||
|
||||
: unless-empty ( seq quot -- ) [ ] swap if-empty ; inline
|
||||
|
||||
: if-zero ( n quot1 quot2 -- )
|
||||
[ dup zero? ] (if-empty) ; inline
|
||||
|
||||
: when-zero ( seq quot -- ) [ ] if-zero ; inline
|
||||
|
||||
: unless-zero ( seq quot -- ) [ ] swap if-zero ; inline
|
||||
|
||||
: delete-all ( seq -- ) 0 swap set-length ;
|
||||
|
||||
: first ( seq -- first ) 0 swap nth ; inline
|
||||
|
|
|
@ -58,7 +58,7 @@ PRIVATE>
|
|||
: (split) ( separators n seq -- )
|
||||
3dup rot [ member? ] curry find-from drop
|
||||
[ [ swap subseq , ] 2keep 1 + swap (split) ]
|
||||
[ swap dup zero? [ drop ] [ tail ] if , drop ] if* ; inline recursive
|
||||
[ swap [ tail ] unless-zero , drop ] if* ; inline recursive
|
||||
|
||||
: split, ( seq separators -- ) 0 rot (split) ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue