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

sequences: some minor performance improvements.

db4
John Benediktsson 2012-08-30 11:33:57 -07:00
parent d3fc7ef6c2
commit 629a5b7bf3
2 changed files with 18 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
core/sequences/sequences.factor
View File

@ -24,7 +24,6 @@ GENERIC: lengthen ( n seq -- )
GENERIC: shorten ( n seq -- ) GENERIC: shorten ( n seq -- )
M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; inline M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; inline
M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; inline M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; inline
: empty? ( seq -- ? ) length 0 = ; inline : empty? ( seq -- ? ) length 0 = ; inline
@ -663,9 +662,13 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
<PRIVATE <PRIVATE
: move-unsafe ( to from seq -- )
2over =
[ 3drop ] [ [ nth-unsafe swap ] [ set-nth-unsafe ] bi ] if ; inline
: (filter!) ( ... quot: ( ... elt -- ... ? ) store scan seq -- ... ) : (filter!) ( ... quot: ( ... elt -- ... ? ) store scan seq -- ... )
2dup length < [ 2dup length < [
[ move ] 3keep [ move-unsafe ] 3keep
[ nth-unsafe pick call [ 1 + ] when ] 2keep [ nth-unsafe pick call [ 1 + ] when ] 2keep
[ 1 + ] dip [ 1 + ] dip
(filter!) (filter!)
@ -701,6 +704,12 @@ PRIVATE>
[ length 1 - ] keep [ length 1 - ] keep
over 0 < [ bounds-error ] [ nth-unsafe ] if ; inline over 0 < [ bounds-error ] [ nth-unsafe ] if ; inline
<PRIVATE
: last-unsafe ( seq -- elt ) [ length 1 - ] [ nth-unsafe ] bi ;
PRIVATE>
: set-last ( elt seq -- ) : set-last ( elt seq -- )
[ length 1 - ] keep [ length 1 - ] keep
over 0 < [ bounds-error ] [ set-nth-unsafe ] if ; inline over 0 < [ bounds-error ] [ set-nth-unsafe ] if ; inline
@ -713,7 +722,7 @@ PRIVATE>
2over = [ 2over = [
2drop 2drop 2drop 2drop
] [ ] [
[ [ 2over + pick ] dip move [ 1 + ] dip ] keep [ [ 2over + pick ] dip move-unsafe [ 1 + ] dip ] keep
move-backward move-backward
] if ; ] if ;
@ -721,7 +730,7 @@ PRIVATE>
2over = [ 2over = [
2drop 2drop 2drop 2drop
] [ ] [
[ [ pick [ dup dup ] dip + swap ] dip move 1 - ] keep [ [ pick [ dup dup ] dip + swap ] dip move-unsafe 1 - ] keep
move-forward move-forward
] if ; ] if ;
@ -762,7 +771,9 @@ PRIVATE>
[ [ { } ] dip dup 1 + ] dip replace-slice ; [ [ { } ] dip dup 1 + ] dip replace-slice ;
: pop ( seq -- elt ) : pop ( seq -- elt )
[ length 1 - ] [ [ nth ] [ shorten ] 2bi ] bi ; [ length 1 - ] keep over 0 >=
[ [ nth-unsafe ] [ shorten ] 2bi ]
[ bounds-error ] if ;
: exchange ( m n seq -- ) : exchange ( m n seq -- )
[ nip bounds-check 2drop ] [ nip bounds-check 2drop ]
@ -899,7 +910,7 @@ PRIVATE>
[ rest ] [ first-unsafe ] bi ; [ rest ] [ first-unsafe ] bi ;
: unclip-last ( seq -- butlast last ) : unclip-last ( seq -- butlast last )
[ but-last ] [ last ] bi ; [ but-last ] [ last-unsafe ] bi ;
: unclip-slice ( seq -- rest-slice first ) : unclip-slice ( seq -- rest-slice first )
[ rest-slice ] [ first-unsafe ] bi ; inline [ rest-slice ] [ first-unsafe ] bi ; inline
@ -927,7 +938,7 @@ PRIVATE>
[ find-last ] (map-find) ; inline [ find-last ] (map-find) ; inline
: unclip-last-slice ( seq -- butlast-slice last ) : unclip-last-slice ( seq -- butlast-slice last )
[ but-last-slice ] [ last ] bi ; inline [ but-last-slice ] [ last-unsafe ] bi ; inline
<PRIVATE <PRIVATE

6
extra/sequences/extras/extras.factor
View File

@ -202,12 +202,6 @@ PRIVATE>
: trim-as ( ... seq quot: ( ... elt -- ... ? ) exemplar -- ... newseq ) : trim-as ( ... seq quot: ( ... elt -- ... ? ) exemplar -- ... newseq )
[ trim-slice ] [ like ] bi* ; inline [ trim-slice ] [ like ] bi* ; inline
<PRIVATE
: last-unsafe ( seq -- elt ) [ length 1 - ] [ nth-unsafe ] bi ;
PRIVATE>
: ?trim ( ... seq quot: ( ... elt -- ... ? ) -- ... seq/newseq ) : ?trim ( ... seq quot: ( ... elt -- ... ? ) -- ... seq/newseq )
over empty? [ drop ] [ over empty? [ drop ] [
over [ first-unsafe ] [ last-unsafe ] bi pick bi@ or over [ first-unsafe ] [ last-unsafe ] bi pick bi@ or