steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Small ricing

db4
Slava Pestov 2008-10-02 06:47:20 -05:00
parent 58edcddea8
commit 28d3654f61
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
core/sequences/sequences.factor
View File

@ -27,7 +27,7 @@ M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ;
M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
: empty? ( seq -- ? ) length zero? ; inline : empty? ( seq -- ? ) length 0 = ; inline
: if-empty ( seq quot1 quot2 -- ) : if-empty ( seq quot1 quot2 -- )
[ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline [ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline
@ -362,7 +362,7 @@ PRIVATE>
prepose curry ; inline prepose curry ; inline
: (interleave) ( n elt between quot -- ) : (interleave) ( n elt between quot -- )
roll zero? [ nip ] [ swapd 2slip ] if call ; inline roll 0 = [ nip ] [ swapd 2slip ] if call ; inline
PRIVATE> PRIVATE>
@ -530,7 +530,7 @@ M: sequence <=>
[ -rot 2nth-unsafe <=> ] [ [ length ] compare ] if* ; [ -rot 2nth-unsafe <=> ] [ [ length ] compare ] if* ;
: sequence= ( seq1 seq2 -- ? ) : sequence= ( seq1 seq2 -- ? )
2dup [ length ] bi@ number= 2dup [ length ] bi@ =
[ mismatch not ] [ 2drop f ] if ; inline [ mismatch not ] [ 2drop f ] if ; inline
: sequence-hashcode-step ( oldhash newpart -- newhash ) : sequence-hashcode-step ( oldhash newpart -- newhash )
@ -547,7 +547,7 @@ M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ;
M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
: move ( to from seq -- ) : move ( to from seq -- )
2over number= 2over =
[ 3drop ] [ [ nth swap ] [ set-nth ] bi ] if ; inline [ 3drop ] [ [ nth swap ] [ set-nth ] bi ] if ; inline
<PRIVATE <PRIVATE
@ -582,7 +582,7 @@ PRIVATE>
<PRIVATE <PRIVATE
: move-backward ( shift from to seq -- ) : move-backward ( shift from to seq -- )
2over number= [ 2over = [
2drop 2drop 2drop 2drop
] [ ] [
[ >r 2over + pick r> move >r 1+ r> ] keep [ >r 2over + pick r> move >r 1+ r> ] keep
@ -590,7 +590,7 @@ PRIVATE>
] if ; ] if ;
: move-forward ( shift from to seq -- ) : move-forward ( shift from to seq -- )
2over number= [ 2over = [
2drop 2drop 2drop 2drop
] [ ] [
[ >r pick >r dup dup r> + swap r> move 1- ] keep [ >r pick >r dup dup r> + swap r> move 1- ] keep
@ -607,7 +607,7 @@ PRIVATE>
PRIVATE> PRIVATE>
: open-slice ( shift from seq -- ) : open-slice ( shift from seq -- )
pick zero? [ pick 0 = [
3drop 3drop
] [ ] [
pick over length + over >r >r pick over length + over >r >r
@ -680,7 +680,7 @@ PRIVATE>
: padding ( seq n elt quot -- newseq ) : padding ( seq n elt quot -- newseq )
[ [
[ over length [-] dup zero? [ drop ] ] dip [ over length [-] dup 0 = [ drop ] ] dip
[ <repetition> ] curry [ <repetition> ] curry
] dip compose if ; inline ] dip compose if ; inline