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

sequences.product: use some unsafe to make it faster.

db4
John Benediktsson 2013-10-12 11:35:17 -07:00
parent 3d2cd564bf
commit de62db7775
1 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
basis/sequences/product/product.factor
View File

@ -1,5 +1,6 @@
! (c)2009 Joe Groff bsd license ! (c)2009 Joe Groff bsd license
USING: accessors arrays assocs kernel locals math sequences ; USING: accessors arrays assocs kernel locals math sequences
sequences.private ;
FROM: sequences => change-nth ; FROM: sequences => change-nth ;
IN: sequences.product IN: sequences.product
@ -25,24 +26,27 @@ M: product-sequence length lengths>> product ;
:: (carry-n) ( ns lengths i -- ) :: (carry-n) ( ns lengths i -- )
ns length i 1 + = [ ns length i 1 + = [
i ns nth i lengths nth = [ i ns nth-unsafe i lengths nth-unsafe = [
0 i ns set-nth 0 i ns set-nth-unsafe
i 1 + ns [ 1 + ] change-nth i 1 + ns [ 1 + ] change-nth-unsafe
ns lengths i 1 + (carry-n) ns lengths i 1 + (carry-n)
] when ] when
] unless ; ] unless ; inline recursive
: carry-ns ( ns lengths -- ) : carry-ns ( ns lengths -- )
0 (carry-n) ; 0 (carry-n) ; inline
: product-iter ( ns lengths -- ) : product-iter ( ns lengths -- )
[ 0 over [ 1 + ] change-nth ] dip carry-ns ; [ 0 over [ 1 + ] change-nth-unsafe ] dip carry-ns ; inline
: start-product-iter ( sequences -- ns lengths ) : start-product-iter ( sequences -- ns lengths )
[ length 0 <array> ] [ [ length ] map ] bi ; [ length 0 <array> ] [ [ length ] map ] bi ; inline
: end-product-iter? ( ns lengths -- ? ) : end-product-iter? ( ns lengths -- ? )
[ last ] same? ; [ last-unsafe ] same? ; inline
: product-length ( sequences -- length )
[ length ] [ * ] map-reduce ; inline
PRIVATE> PRIVATE>
@ -58,9 +62,9 @@ M: product-sequence nth
:: product-map-as ( ... sequences quot: ( ... seq -- ... value ) exemplar -- ... sequence ) :: product-map-as ( ... sequences quot: ( ... seq -- ... value ) exemplar -- ... sequence )
0 :> i! 0 :> i!
sequences [ length ] [ * ] map-reduce exemplar sequences product-length exemplar
[| result | [| result |
sequences [ quot call i result set-nth i 1 + i! ] product-each sequences [ quot call i result set-nth-unsafe i 1 + i! ] product-each
result result
] new-like ; inline ] new-like ; inline
@ -69,8 +73,8 @@ M: product-sequence nth
:: product-map>assoc ( ... sequences quot: ( ... seq -- ... key value ) exemplar -- ... assoc ) :: product-map>assoc ( ... sequences quot: ( ... seq -- ... key value ) exemplar -- ... assoc )
0 :> i! 0 :> i!
sequences [ length ] [ * ] map-reduce { } sequences product-length { }
[| result | [| result |
sequences [ quot call 2array i result set-nth i 1 + i! ] product-each sequences [ quot call 2array i result set-nth-unsafe i 1 + i! ] product-each
result result
] new-like exemplar assoc-like ; inline ] new-like exemplar assoc-like ; inline