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

2x speedup on lagged-fibonacci after removing mutable local

db4
Doug Coleman 2009-10-16 15:47:19 -05:00
parent 1375e32c62
commit 67b41df21f
1 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
extra/random/lagged-fibonacci/lagged-fibonacci.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types fry kernel literals locals math USING: accessors alien.c-types fry kernel literals locals math
random sequences specialized-arrays namespaces ; random sequences specialized-arrays namespaces sequences.private ;
SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: double
IN: random.lagged-fibonacci IN: random.lagged-fibonacci
@ -50,25 +50,26 @@ M:: lagged-fibonacci seed-random ( lagged-fibonacci seed! -- lagged-fibonacci )
s s
] change-each ] change-each
lagged-fibonacci p-r >>pt0 lagged-fibonacci p-r >>pt0
q-r >>pt1 ; q-r >>pt1 ; inline
: <lagged-fibonacci> ( seed -- lagged-fibonacci ) : <lagged-fibonacci> ( seed -- lagged-fibonacci )
lagged-fibonacci new lagged-fibonacci new
p-r 1 + <double-array> >>u p-r 1 + <double-array> >>u
swap seed-random ; swap seed-random ; inline
GENERIC: random-float* ( tuple -- r ) GENERIC: random-float* ( tuple -- r )
: random-float ( -- n ) random-generator get random-float* ; inline : random-float ( -- n ) random-generator get random-float* ; inline
M:: lagged-fibonacci random-float* ( lagged-fibonacci -- x ) M:: lagged-fibonacci random-float* ( lagged-fibonacci -- x )
lagged-fibonacci [ pt0>> ] [ u>> ] bi nth lagged-fibonacci [ pt0>> ] [ u>> ] bi nth-unsafe
lagged-fibonacci [ pt1>> ] [ u>> ] bi nth - :> uni! lagged-fibonacci [ pt1>> ] [ u>> ] bi nth-unsafe -
uni 0.0 < [ uni 1.0 + uni! ] when dup 0.0 < [ 1.0 + ] when
uni lagged-fibonacci [ pt0>> ] [ u>> ] bi set-nth [
lagged-fibonacci [ pt0>> ] [ u>> ] bi set-nth-unsafe
lagged-fibonacci [ adjust-ptr ] change-pt0 drop lagged-fibonacci [ adjust-ptr ] change-pt0 drop
lagged-fibonacci [ adjust-ptr ] change-pt1 drop lagged-fibonacci [ adjust-ptr ] change-pt1 drop
uni ; inline ] keep ; inline
: default-lagged-fibonacci ( -- obj ) : default-lagged-fibonacci ( -- obj )
[ random-32 ] with-system-random <lagged-fibonacci> ; [ random-32 ] with-system-random <lagged-fibonacci> ; inline