random: support "random" on floats (uses uniform-random-float).

diff --git a/basis/random/random.factor b/basis/random/random.factor
index 5b8c1b3e7b81eb4a6ce7d85634473556686d24cb..2bf65648b93b9c30f8fb132245e3d14238c6327d 100644 (file)
--- a/basis/random/random.factor
+++ b/basis/random/random.factor
@@ -1,11 +1,12 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.data arrays assocs
-byte-arrays byte-vectors combinators combinators.short-circuit
-fry hashtables hashtables.private hints io.backend io.binary
+USING: accessors alien.data arrays assocs byte-arrays
+byte-vectors combinators combinators.short-circuit fry
+hashtables hashtables.private hints io.backend io.binary
 kernel locals math math.bitwise math.constants math.functions
 math.order math.ranges namespaces sequences sequences.private
 sets summary system typed vocabs ;
+QUALIFIED-WITH: alien.c-types c
 IN: random
 
 SYMBOL: system-random-generator
@@ -18,10 +19,10 @@ GENERIC: random-bytes* ( n tuple -- byte-array )
 
 M: object random-bytes* ( n tuple -- byte-array )
     [ [ <byte-vector> ] keep 4 /mod ] dip
-    [ pick '[ _ random-32* int <ref> _ push-all ] times ]
+    [ pick '[ _ random-32* c:int <ref> _ push-all ] times ]
     [
         over zero?
-        [ 2drop ] [ random-32* int <ref> swap head append! ] if
+        [ 2drop ] [ random-32* c:int <ref> swap head append! ] if
     ] bi-curry bi* B{ } like ;
 
 HINTS: M\ object random-bytes* { fixnum object } ;
@@ -112,7 +113,7 @@ ERROR: too-many-samples seq n ;
 <PRIVATE
 
 : (uniform-random-float) ( min max obj -- n )
-    [ 4 4 ] dip [ random-bytes* uint deref >float ] curry bi@
+    [ 4 4 ] dip [ random-bytes* c:uint deref >float ] curry bi@
     2.0 32 ^ * +
     [ over - 2.0 -64 ^ * ] dip
     * + ; inline
@@ -122,6 +123,8 @@ PRIVATE>
 : uniform-random-float ( min max -- n )
     random-generator get (uniform-random-float) ; inline
 
+M: float random [ f ] [ 0.0 swap uniform-random-float ] if-zero ;
+
 : random-unit ( -- n )
     0.0 1.0 uniform-random-float ; inline