factor/extra/random/random.factor

56 lines
1.5 KiB
Factor
Raw Normal View History

2008-03-19 17:18:03 -04:00
! Copyright (C) 2008 Doug Coleman.
2007-09-20 18:09:08 -04:00
! See http://factorcode.org/license.txt for BSD license.
2008-03-19 17:18:03 -04:00
USING: alien.c-types kernel math namespaces sequences
2008-03-29 15:51:50 -04:00
io.backend io.binary combinators system vocabs.loader
inspector ;
2007-09-20 18:09:08 -04:00
IN: random
SYMBOL: system-random-generator
2008-03-27 07:27:36 -04:00
SYMBOL: secure-random-generator
SYMBOL: random-generator
GENERIC: seed-random ( tuple seed -- )
GENERIC: random-32* ( tuple -- r )
2008-03-27 07:30:59 -04:00
GENERIC: random-bytes* ( n tuple -- byte-array )
2008-03-27 07:27:36 -04:00
M: object random-bytes* ( n tuple -- byte-array )
swap [ drop random-32* ] with map >c-uint-array ;
2008-03-29 00:20:33 -04:00
M: object random-32* ( tuple -- r ) 4 random-bytes* le> ;
2008-03-27 07:27:36 -04:00
ERROR: no-random-number-generator ;
2008-03-29 15:50:52 -04:00
M: no-random-number-generator summary
drop "Random number generator is not defined." ;
2008-03-27 07:27:36 -04:00
M: f random-bytes* ( n obj -- * ) no-random-number-generator ;
M: f random-32* ( obj -- * ) no-random-number-generator ;
2008-03-27 07:30:59 -04:00
: random-bytes ( n -- byte-array )
2008-03-19 17:18:03 -04:00
[
2008-03-28 23:10:01 -04:00
dup 4 rem zero? [ 1+ ] unless
random-generator get random-bytes*
2008-03-19 17:18:03 -04:00
] keep head ;
2007-09-20 18:09:08 -04:00
: random ( seq -- elt )
dup empty? [
drop f
] [
[
2008-03-19 17:18:03 -04:00
length dup log2 7 + 8 /i
random-bytes byte-array>bignum swap mod
2007-09-20 18:09:08 -04:00
] keep nth
] if ;
2008-03-19 22:41:39 -04:00
: random-bits ( n -- r ) 2^ random ;
2008-03-19 17:18:03 -04:00
: with-random ( tuple quot -- )
2008-03-19 22:41:39 -04:00
random-generator swap with-variable ; inline
2008-03-28 23:10:01 -04:00
: with-system-random ( quot -- )
system-random-generator get swap with-random ; inline
2008-03-28 23:10:01 -04:00
: with-secure-random ( quot -- )
secure-random-generator get swap with-random ; inline