diff --git a/extra/random/cmwc/cmwc-tests.factor b/extra/random/cmwc/cmwc-tests.factor index 6e3f4ac178..8dc9f8764f 100644 --- a/extra/random/cmwc/cmwc-tests.factor +++ b/extra/random/cmwc/cmwc-tests.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel random random.cmwc sequences tools.test ; +USING: alien.c-types arrays kernel random random.cmwc sequences +specialized-arrays specialized-arrays.instances.uint tools.test ; IN: random.cmwc.tests [ ] [ @@ -24,18 +25,18 @@ IN: random.cmwc.tests } ] [ cmwc-4096 - 4096 iota >array 362436 seed-random [ + 4096 iota >uint-array 362436 seed-random [ 10 [ random-32 ] replicate ] with-random ] unit-test [ t ] [ cmwc-4096 [ - 4096 iota >array 362436 seed-random [ + 4096 iota >uint-array 362436 seed-random [ 10 [ random-32 ] replicate ] with-random ] [ - 4096 iota >array 362436 seed-random [ + 4096 iota >uint-array 362436 seed-random [ 10 [ random-32 ] replicate ] with-random ] bi = diff --git a/extra/random/cmwc/cmwc.factor b/extra/random/cmwc/cmwc.factor index 00258257be..b38dd0a28a 100644 --- a/extra/random/cmwc/cmwc.factor +++ b/extra/random/cmwc/cmwc.factor @@ -1,28 +1,34 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays fry kernel locals math math.bitwise -random sequences ; +USING: accessors alien.c-types arrays fry kernel locals math +math.bitwise random sequences specialized-arrays +specialized-arrays.instances.uint ; IN: random.cmwc ! Multiply-with-carry RNG -TUPLE: cmwc Q a b c i r mod ; +TUPLE: cmwc + { Q uint-array } + { a fixnum } + { b fixnum } + { c fixnum } + { i fixnum } + { r fixnum } + { mod fixnum } ; -TUPLE: cmwc-seed Q c ; +TUPLE: cmwc-seed { Q uint-array read-only } { c read-only } ; : ( length a b c -- cmwc ) cmwc new swap >>c swap >>b swap >>a - swap [ 1 - >>i ] [ 0 >>Q ] bi + swap [ 1 - >>i ] [ >>Q ] bi dup b>> 1 - >>r dup Q>> length 1 - >>mod ; : ( Q c -- cmwc-seed ) - cmwc-seed new - swap >>c - swap >>Q ; inline + cmwc-seed boa ; inline M: cmwc seed-random [ Q>> >>Q ] @@ -49,6 +55,8 @@ M:: cmwc random-32* ( cmwc -- n ) 4096 [ 18782 4294967295 362436 ] [ - '[ [ random-32 ] replicate ] with-system-random + '[ [ random-32 ] uint-array{ } replicate-as ] with-system-random 362436 seed-random ] bi ; + +: default-cmwc ( -- cmwc ) cmwc-4096 ;