From a718127fd16d69e86b238fa88cd1bec6564d66d5 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 6 Feb 2014 18:17:03 -0800 Subject: [PATCH] random: some cleanup. --- basis/random/dummy/dummy.factor | 4 +-- .../mersenne-twister/mersenne-twister.factor | 7 ++--- basis/random/random-docs.factor | 6 ++-- basis/random/random.factor | 28 +++++++++---------- .../blum-blum-shub/blum-blum-shub.factor | 2 +- 5 files changed, 23 insertions(+), 24 deletions(-) diff --git a/basis/random/dummy/dummy.factor b/basis/random/dummy/dummy.factor index 988bd015d0..2103732193 100644 --- a/basis/random/dummy/dummy.factor +++ b/basis/random/dummy/dummy.factor @@ -4,8 +4,8 @@ IN: random.dummy TUPLE: random-dummy i ; C: random-dummy -M: random-dummy seed-random ( obj seed -- obj ) +M: random-dummy seed-random >>i ; -M: random-dummy random-32* ( obj -- r ) +M: random-dummy random-32* [ dup 1 + ] change-i drop ; diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor index 908e62fe66..b55c3455b0 100644 --- a/basis/random/mersenne-twister/mersenne-twister.factor +++ b/basis/random/mersenne-twister/mersenne-twister.factor @@ -62,20 +62,19 @@ PRIVATE> init-mt-seq 0 mersenne-twister boa dup mt-generate ; -M: mersenne-twister seed-random ( mt seed -- mt' ) +M: mersenne-twister seed-random init-mt-seq >>seq [ mt-generate ] [ 0 >>i drop ] [ ] tri ; -M: mersenne-twister random-32* ( mt -- r ) +M: mersenne-twister random-32* [ next-index ] [ seq>> nth-unsafe mt-temper ] [ [ 1 + ] change-i drop ] tri ; : default-mersenne-twister ( -- mersenne-twister ) - [ 32 random-bits ] with-system-random - ; + [ random-32 ] with-system-random ; [ default-mersenne-twister random-generator set-global diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index 441aea15b2..6777e1be1a 100644 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -10,7 +10,7 @@ HELP: seed-random { $notes "Not supported on all random number generators." } ; HELP: random-32* -{ $values { "obj" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } } +{ $values { "obj" "a random number generator" } { "n" "an integer between 0 and 2^32-1" } } { $description "Generates a random 32-bit unsigned integer." } ; HELP: random-bytes* @@ -78,11 +78,11 @@ HELP: random-units } ; HELP: random-bits -{ $values { "numbits" integer } { "r" "a random integer" } } +{ $values { "numbits" integer } { "n" "a random integer" } } { $description "Outputs an random integer n bits in length." } ; HELP: random-bits* -{ $values { "numbits" integer } { "r" "a random integer" } } +{ $values { "numbits" integer } { "n" "a random integer" } } { $description "Returns an integer exactly " { $snippet "numbits" } " in length, with the topmost bit set to one." } ; HELP: with-random diff --git a/basis/random/random.factor b/basis/random/random.factor index 0c232611c8..093e0b87e7 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -15,10 +15,10 @@ SYMBOL: secure-random-generator SYMBOL: random-generator GENERIC# seed-random 1 ( obj seed -- obj ) -GENERIC: random-32* ( obj -- r ) +GENERIC: random-32* ( obj -- n ) GENERIC: random-bytes* ( n obj -- byte-array ) -M: object random-bytes* ( n obj -- byte-array ) +M: object random-bytes* [ integer>fixnum-strict [ ] keep ] dip [ over 4 >= ] [ [ 4 - ] dip @@ -27,7 +27,7 @@ M: object random-bytes* ( n obj -- byte-array ) random-32* c:int swap head 0 pick copy-unsafe ] if ; -M: object random-32* ( obj -- r ) +M: object random-32* 4 swap random-bytes* c:uint deref ; ERROR: no-random-number-generator ; @@ -47,7 +47,7 @@ M: f random-32* ( obj -- * ) no-random-number-generator ; [ obj random-32* numbits 32 - [ dup 32 > ] [ [ 32 shift obj random-32* + ] [ 32 - ] bi* @@ -60,27 +60,27 @@ M: f random-32* ( obj -- * ) no-random-number-generator ; PRIVATE> -: random-bits ( numbits -- r ) +: random-bits ( numbits -- n ) random-generator get (random-bits) ; -: random-bits* ( numbits -- r ) +: random-bits* ( numbits -- n ) 1 - [ random-bits ] keep set-bit ; ] [ +:: ((random-integer)) ( m obj -- n ) + obj random-32* 32 m next-power-of-2-bits 32 - [ dup 0 > ] [ [ 32 shift obj random-32* + ] [ 32 + ] [ 32 - ] tri* - ] while drop [ n * ] [ neg shift ] bi* ; inline + ] while drop [ m * ] [ neg shift ] bi* ; inline -GENERIC# (random-integer) 1 ( n obj -- r ) -M: fixnum (random-integer) ( n obj -- r ) ((random-integer)) ; -M: bignum (random-integer) ( n obj -- r ) ((random-integer)) ; +GENERIC# (random-integer) 1 ( m obj -- n ) +M: fixnum (random-integer) ( m obj -- n ) ((random-integer)) ; +M: bignum (random-integer) ( m obj -- n ) ((random-integer)) ; -: random-integer ( n -- r ) +: random-integer ( m -- n ) random-generator get (random-integer) ; PRIVATE> diff --git a/extra/random/blum-blum-shub/blum-blum-shub.factor b/extra/random/blum-blum-shub/blum-blum-shub.factor index 8229abca69..dca24e7a3a 100644 --- a/extra/random/blum-blum-shub/blum-blum-shub.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub.factor @@ -25,6 +25,6 @@ PRIVATE> [ find-relative-prime ] keep blum-blum-shub boa ; -M: blum-blum-shub random-32* ( bbs -- r ) +M: blum-blum-shub random-32* 0 32 rot [ next-bbs-bit swap 1 shift bitor ] curry times ;