factor: trim using lists

[factor.git] / extra / random / lagged-fibonacci / lagged-fibonacci.factor

diff --git a/extra/random/lagged-fibonacci/lagged-fibonacci.factor b/extra/random/lagged-fibonacci/lagged-fibonacci.factor
index 45a4b132dddd3019f922545307f7d103052a80a3..df60ee023c0de8d281b987cfdcf9cbcf12e6adef 100644 (file)
--- a/extra/random/lagged-fibonacci/lagged-fibonacci.factor
+++ b/extra/random/lagged-fibonacci/lagged-fibonacci.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types fry kernel literals locals math
-random sequences specialized-arrays namespaces ;
+USING: accessors alien.c-types alien.data kernel math namespaces
+random sequences sequences.private specialized-arrays ;
 SPECIALIZED-ARRAY: double
 IN: random.lagged-fibonacci
 
-TUPLE: lagged-fibonacci u pt0 pt1 ;
+TUPLE: lagged-fibonacci { u double-array } { pt0 fixnum } { pt1 fixnum } ;
 
 <PRIVATE
 
@@ -17,10 +17,10 @@ CONSTANT: lagged-fibonacci-max-seed 900000000
 CONSTANT: lagged-fibonacci-sig-bits 24
 
 : normalize-seed ( seed -- seed' )
-    abs lagged-fibonacci-max-seed mod ;
+    abs lagged-fibonacci-max-seed mod ; inline
 
 : adjust-ptr ( ptr -- ptr' )
-    1 - dup 0 < [ drop p-r ] when ;
+    1 - dup 0 < [ drop p-r ] when ; inline
 
 PRIVATE>
 
@@ -48,24 +48,28 @@ M:: lagged-fibonacci seed-random ( lagged-fibonacci seed! -- lagged-fibonacci )
             t 0.5 * t!
         ] times
         s
-    ] change-each
+    ] map! drop
     lagged-fibonacci p-r >>pt0
-        q-r >>pt1 ;
+        q-r >>pt1 ; inline
 
 : <lagged-fibonacci> ( seed -- lagged-fibonacci )
     lagged-fibonacci new
-        p-r 1 + <double-array> >>u
-        swap seed-random ;
+        p-r 1 + double <c-array> >>u
+        swap seed-random ; inline
 
 GENERIC: random-float* ( tuple -- r )
- 
-: random-float ( -- n ) random-generator get random-float* ;
+
+: random-float ( -- n ) random-generator get random-float* ; inline
 
 M:: lagged-fibonacci random-float* ( lagged-fibonacci -- x )
-    lagged-fibonacci [ pt0>> ] [ u>> ] bi nth
-    lagged-fibonacci [ pt1>> ] [ u>> ] bi nth - :> uni!
-    uni 0.0 < [ uni 1.0 + uni! ] when
-    uni lagged-fibonacci [ pt0>> ] [ u>> ] bi set-nth
-    lagged-fibonacci [ adjust-ptr ] change-pt0 drop
-    lagged-fibonacci [ adjust-ptr ] change-pt1 drop
-    uni ; inline
+    lagged-fibonacci [ pt0>> ] [ u>> ] bi nth-unsafe
+    lagged-fibonacci [ pt1>> ] [ u>> ] bi nth-unsafe -
+    dup 0.0 < [ 1.0 + ] when
+    [
+        lagged-fibonacci [ pt0>> ] [ u>> ] bi set-nth-unsafe
+        lagged-fibonacci [ adjust-ptr ] change-pt0 drop
+        lagged-fibonacci [ adjust-ptr ] change-pt1 drop
+    ] keep ; inline
+
+: default-lagged-fibonacci ( -- obj )
+    [ random-32 ] with-system-random <lagged-fibonacci> ; inline