add flrandom and unsafe-flrandom

pkgs/racket-pkgs/racket-doc/scribblings/reference/flonums.scrbl

@@ -131,6 +131,10 @@ Like @racket[make-rectangular], @racket[real-part], and
 @racket[imag-part], but both parts of the complex number must be
 inexact.}
 
+@defproc[(flrandom [rand-gen pseudo-random-generator?]) (and flonum? (>/c 0) (</c 1))]{
+
+Equivalent to @racket[(random rand-gen)].}
+
 @; ------------------------------------------------------------------------
 
 @section[#:tag "flvectors"]{Flonum Vectors}

pkgs/racket-pkgs/racket-doc/scribblings/reference/numbers.scrbl

@@ -834,11 +834,11 @@ both in binary and as integers.
 @subsection{Random Numbers}
 
 @defproc*[([(random [k (integer-in 1 4294967087)]
-                    [generator pseudo-random-generator?
+                    [rand-gen pseudo-random-generator?
                                (current-pseudo-random-generator)])
             exact-nonnegative-integer?]
-           [(random [generator pseudo-random-generator?
-                               (current-pseudo-random-generator)]) 
+           [(random [rand-gen pseudo-random-generator?
+                              (current-pseudo-random-generator)]) 
             (and/c real? inexact? (>/c 0) (</c 1))])]{  
 
 When called with an integer argument @racket[k], returns a random
@@ -882,17 +882,17 @@ Returns @racket[#t] if @racket[v] is a pseudo-random number generator,
 @racket[#f] otherwise.}
 
 
-@defparam[current-pseudo-random-generator generator pseudo-random-generator?]{
+@defparam[current-pseudo-random-generator rand-gen pseudo-random-generator?]{
 
 A @tech{parameter} that determines the pseudo-random number generator
 used by @racket[random].}
 
 
-@defproc[(pseudo-random-generator->vector [generator pseudo-random-generator?])
+@defproc[(pseudo-random-generator->vector [rand-gen pseudo-random-generator?])
          pseudo-random-generator-vector?]{
 
 Produces a vector that represents the complete internal state of
-@racket[generator]. The vector is suitable as an argument to
+@racket[rand-gen]. The vector is suitable as an argument to
 @racket[vector->pseudo-random-generator] to recreate the generator in
 its current state (across runs and across platforms).}
 
@@ -903,12 +903,12 @@ its current state (across runs and across platforms).}
 Produces a pseudo-random number generator whose internal state
 corresponds to @racket[vec].}
 
-@defproc[(vector->pseudo-random-generator! [generator pseudo-random-generator?]
+@defproc[(vector->pseudo-random-generator! [rand-gen pseudo-random-generator?]
                                            [vec pseudo-random-generator-vector?])
          void?]{
 
 Like @racket[vector->pseudo-random-generator], but changes
-@racket[generator] to the given state, instead of creating a new
+@racket[rand-gen] to the given state, instead of creating a new
 generator.}
 
 

pkgs/racket-pkgs/racket-doc/scribblings/reference/unsafe.scrbl

@@ -177,6 +177,11 @@ These are similar to the safe bindings @racket[->fl] and @racket[fl->exact-integ
 but further constrained to consume or produce a fixnum.
 }
 
+@defproc[(unsafe-flrandom [rand-gen pseudo-random-generator?]) (and flonum? (>/c 0) (</c 1))]{
+
+Unchecked version of @racket[flrandom].
+}
+
 
 @section{Unsafe Data Extraction}
 

pkgs/racket-pkgs/racket-test/tests/racket/flonum.rktl

@@ -164,6 +164,20 @@
 (err/rt-test (for/flvector #:length 5 #:fill 0 ([i 5]) 8.0))
 (err/rt-test (for/flvector #:length 10 #:fill 0 ([i 5]) 8.0))
 
+;; ----------------------------------------
+;; flrandom
+
+(let ([r (make-pseudo-random-generator)]
+      [seed (random 100000)])
+  (define (reset)
+    (parameterize ([current-pseudo-random-generator r])
+      (random-seed seed)))
+  (test (begin (reset) (random r))
+        flrandom
+        (begin (reset) r)))
+
+(err/rt-test (flrandom 5.0))
+
 ;; ----------------------------------------
 ;; Check corners of `flexpt':
 ;;  Tests by Neil T.:

pkgs/racket-pkgs/racket-test/tests/racket/unsafe.rktl

@@ -52,10 +52,15 @@
       (test result (compose post (eval `(lambda () (,proc ',x ',y))))))
     (pre)
     (test result (compose post (eval `(lambda (x) (,proc x ',y)))) x))
-  (define (test-un result proc x)
-    (test result (eval proc) x)
-    (test result (eval `(lambda (x) (,proc x))) x)
-    (test result (eval `(lambda () (,proc ',x)))))
+  (define (test-un result proc x
+                   #:pre [pre void] 
+                   #:post [post (lambda (x) x)])
+    (pre)
+    (test result (compose post (eval proc)) x)
+    (pre)
+    (test result (compose post (eval `(lambda (x) (,proc x)))) x)
+    (pre)
+    (test result (compose post (eval `(lambda () (,proc ',x))))))
 
   (test-bin 3 'unsafe-fx+ 1 2)
   (test-bin -1 'unsafe-fx+ 1 -2)
@@ -282,6 +287,16 @@
                                                       (lambda (exn) (unsafe-extfl+ x y))])
                                        (unsafe-extfl- (unsafe-extfl+ x y) NO-SUCH-VARIABLE)))
               1.1t0 3.3t0 5.2t0))
+  
+  (let ([r (make-pseudo-random-generator)]
+        [seed (random 100000)])
+    (define (reset)
+      (parameterize ([current-pseudo-random-generator r])
+        (random-seed seed)))
+    (reset)
+    (define val (random r))
+    (test-un val 'unsafe-flrandom r
+             #:pre reset))
 
   (test-un 5 'unsafe-car (cons 5 9))
   (test-un 9 'unsafe-cdr (cons 5 9))

racket/collects/racket/HISTORY.txt

@@ -1,3 +1,6 @@
+Version 5.90.0.11
+Added flrandom and unsafe-flrandom
+
 Version 5.90.0.10
 Changed serializable-struct, etc. to provide deserialized-info:...
  through a derialized-info submodule

racket/collects/racket/flonum.rkt

@@ -9,6 +9,7 @@
          flabs flsqrt flexp fllog
          flsin flcos fltan flasin flacos flatan
          flfloor flceiling flround fltruncate flexpt
+         flrandom
          fl= fl< fl<= fl> fl>= flmin flmax
          ->fl fl->exact-integer
          flvector? flvector make-flvector 
@@ -28,3 +29,10 @@
   for*/flvector
   flvector-copy
   0.0)
+
+(define (flrandom r)
+  (if (pseudo-random-generator? r)
+      (unsafe-flrandom r)
+      (raise-argument-error 'flrandom
+                            "pseudo-random-generator?"
+                            r)))

racket/src/racket/src/jitarith.c

@@ -302,7 +302,8 @@ int scheme_can_unbox_directly(Scheme_Object *obj, int extfl)
             && (SCHEME_PRIM_PROC_OPT_FLAGS(app->rator) & SCHEME_PRIM_IS_UNARY_INLINED)) {
           if (!extfl) {
             if (IS_NAMED_PRIM(app->rator, "->fl")
-                || IS_NAMED_PRIM(app->rator, "fx->fl"))
+                || IS_NAMED_PRIM(app->rator, "fx->fl")
+                || IS_NAMED_PRIM(app->rator, "unsafe-flrandom"))
               return 1;
           }
 #ifdef MZ_LONG_DOUBLE

racket/src/racket/src/jitinline.c

@@ -49,6 +49,10 @@ static Scheme_Object *ts_scheme_make_fsemaphore(int argc, Scheme_Object **argv)
 # define ts_scheme_make_fsemaphore scheme_make_fsemaphore
 #endif
 
+static void call_flrandom(Scheme_Object *rs) {
+  scheme_jit_save_fp = scheme_double_random(rs);
+}
+
 static Scheme_Object *extract_one_cc_mark_to_tag(Scheme_Object *mark_set, 
                                                  Scheme_Object *key,
                                                  Scheme_Object *prompt_tag)
@@ -1663,6 +1667,36 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
       if (jitter->unbox)
         scheme_generate_unboxing(jitter, dest);
       
+      return 1;
+    } else if (IS_NAMED_PRIM(rator, "unsafe-flrandom")) {
+      mz_jit_unbox_state ubs;
+
+      LOG_IT(("inlined %s\n", name));
+      
+      mz_runstack_skipped(jitter, 1);
+
+      scheme_mz_unbox_save(jitter, &ubs);
+
+      scheme_generate_non_tail(app->rand, jitter, 0, 1, 0);
+      CHECK_LIMIT();
+
+      scheme_mz_unbox_restore(jitter, &ubs);
+
+      mz_runstack_unskipped(jitter, 1);
+
+      mz_prepare(1);
+      jit_pusharg_p(JIT_R0);
+      (void)mz_finish(call_flrandom);
+      (void)mz_tl_ldi_d_fppush(JIT_FPR0, tl_scheme_jit_save_fp, JIT_R2);
+      CHECK_LIMIT();
+      
+      if (jitter->unbox) {
+        jitter->unbox_depth++;
+      } else {
+        scheme_generate_alloc_double(jitter, 0, dest);
+        CHECK_LIMIT();
+      }
+      
       return 1;
     } else if (IS_NAMED_PRIM(rator, "add1")) {
       scheme_generate_arith(jitter, rator, app->rand, NULL, 1, ARITH_ADD, 0, 1, NULL, 1, 0, 0, NULL, dest);

racket/src/racket/src/newrandom.inc

@@ -42,7 +42,7 @@
 
 /* the actual generator */
 
-static double mrg32k3a(Scheme_Random_State *s) { /* (double), in {0..m1-1} */
+XFORM_NONGCING static double mrg32k3a(Scheme_Random_State *s) { /* (double), in {0..m1-1} */
   double x10, x20, y;
   intptr_t   k10, k20;
 
@@ -212,7 +212,7 @@ static uintptr_t sch_int_rand(uintptr_t n, Scheme_Random_State *rs)
   return (uintptr_t)xq;
 }
 
-static double sch_double_rand(Scheme_Random_State *rs)
+XFORM_NONGCING static double sch_double_rand(Scheme_Random_State *rs)
 {
   double  x;
   x = mrg32k3a(rs);

racket/src/racket/src/number.c

@@ -204,6 +204,8 @@ static Scheme_Object *unsafe_make_flrectangular (int argc, Scheme_Object *argv[]
 static Scheme_Object *unsafe_flreal_part (int argc, Scheme_Object *argv[]);
 static Scheme_Object *unsafe_flimag_part (int argc, Scheme_Object *argv[]);
 
+static Scheme_Object *unsafe_flrandom (int argc, Scheme_Object *argv[]);
+
 #ifdef MZ_USE_SINGLE_FLOATS
 static Scheme_Object *TO_FLOAT(const Scheme_Object *n);
 #endif
@@ -1438,6 +1440,15 @@ void scheme_init_unsafe_number(Scheme_Env *env)
                                                             | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
                                                             | SCHEME_PRIM_PRODUCES_FLONUM);
   scheme_add_global_constant("unsafe-flimag-part", p, env);
+
+  p = scheme_make_immed_prim(unsafe_flrandom, "unsafe-flrandom", 1, 1);
+  if (scheme_can_inline_fp_op())
+    flags = SCHEME_PRIM_IS_UNARY_INLINED;
+  else
+    flags = SCHEME_PRIM_SOMETIMES_INLINED;
+  SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
+                                                            | SCHEME_PRIM_PRODUCES_FLONUM);
+  scheme_add_global_constant("unsafe-flrandom", p, env);
 }
 
 void scheme_init_extfl_unsafe_number(Scheme_Env *env)
@@ -5397,6 +5408,11 @@ static Scheme_Object *unsafe_flimag_part (int argc, Scheme_Object *argv[])
   return ((Scheme_Complex *)argv[0])->i;
 }
 
+static Scheme_Object *unsafe_flrandom (int argc, Scheme_Object *argv[])
+{
+  return scheme_make_double(scheme_double_random(argv[0]));
+}
+
 static Scheme_Object *integer_to_extfl (int argc, Scheme_Object *argv[])
 {
 #ifdef MZ_LONG_DOUBLE

racket/src/racket/src/numstr.c

@@ -2756,6 +2756,11 @@ sch_random(int argc, Scheme_Object *argv[])
   }
 }
 
+double scheme_double_random(Scheme_Object *rand_state)
+{
+  return sch_double_rand((Scheme_Random_State *)rand_state);
+}
+
 static Scheme_Object *
 do_pack(const char *name, int argc, Scheme_Object *argv[], int set, int check)
 {

racket/src/racket/src/schminc.h

@@ -15,7 +15,7 @@
 #define USE_COMPILED_STARTUP 1
 
 #define EXPECTED_PRIM_COUNT 1116
-#define EXPECTED_UNSAFE_COUNT 100
+#define EXPECTED_UNSAFE_COUNT 101
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45
 #define EXPECTED_FUTURES_COUNT 15

racket/src/racket/src/schpriv.h

@@ -2177,6 +2177,8 @@ extern Scheme_Object *scheme_zerof, *scheme_nzerof, *scheme_single_scheme_pi;
 extern Scheme_Object *scheme_single_inf_object, *scheme_single_minus_inf_object, *scheme_single_nan_object;
 #endif
 
+XFORM_NONGCING double scheme_double_random(Scheme_Object *rand_state);
+
 /****** General numeric ******/
 
 Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.90.0.10"
+#define MZSCHEME_VERSION "5.90.0.11"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 90
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 10
+#define MZSCHEME_VERSION_W 11
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)