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