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

sequences: faster binary-reduce.

db4
John Benediktsson 2012-09-05 09:32:54 -07:00
parent b6c069f99a
commit 00a9fcbc85
1 changed files with 27 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
core/sequences/sequences.factor
View File

@ -857,26 +857,40 @@ PRIVATE>
swap cut-slice [ swap suffix ] dip append ; swap cut-slice [ swap suffix ] dip append ;
: halves ( seq -- first-slice second-slice ) : halves ( seq -- first-slice second-slice )
[ 0 swap length [ 2/ dup ] keep ] keep dup midpoint@ cut-slice ; inline
[ <slice-unsafe> ] curry 2bi@ ; inline
: binary-reduce ( ... seq start quot: ( ... elt1 elt2 -- ... newelt ) -- ... value ) <PRIVATE
: nth2-unsafe ( n seq -- a b )
[ nth-unsafe ] [ [ 1 + ] dip nth-unsafe ] 2bi ; inline
: nth3-unsafe ( n seq -- a b c )
[ nth-unsafe ]
[ [ 1 + ] dip nth-unsafe ]
[ [ 2 + ] dip nth-unsafe ]
2tri ; inline
: (binary-reduce) ( ... seq start quot: ( ... elt1 elt2 -- ... newelt ) from to -- ... value )
#! We can't use case here since combinators depends on #! We can't use case here since combinators depends on
#! sequences #! sequences
pick length dup 0 3 between? [ 2dup swap - dup 4 < [
integer>fixnum { nip integer>fixnum {
[ drop nip ] [ 2drop nip ]
[ 2drop first-unsafe ] [ 2nip swap nth-unsafe ]
[ [ drop first2-unsafe ] dip call ] [ -rot [ drop swap nth2-unsafe ] dip call ]
[ [ drop first3-unsafe ] dip bi@ ] [ -rot [ drop swap nth3-unsafe ] dip bi@ ]
} dispatch } dispatch
] [ ] [
drop 2/ over [ - dup ] dip
[ halves ] 2dip [ (binary-reduce) ] [ 2curry ] curry 2bi@
[ [ binary-reduce ] 2curry bi@ ] keep pick [ 3bi ] dip call
call
] if ; inline recursive ] if ; inline recursive
PRIVATE>
: binary-reduce ( ... seq start quot: ( ... elt1 elt2 -- ... newelt ) -- ... value )
pick length 0 max 0 swap (binary-reduce) ; inline
: cut ( seq n -- before after ) : cut ( seq n -- before after )
[ head ] [ tail ] 2bi ; [ head ] [ tail ] 2bi ;