Add types and optimizations for flrandom and unsafe-flrandom.

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt

@@ -604,6 +604,7 @@
   (define make-flrectangular-type (lambda () (-Flonum -Flonum . -> . -FloatComplex)))
   (define flreal-part-type (lambda () (-FloatComplex . -> . -Flonum)))
   (define flimag-part-type (lambda () (-FloatComplex . -> . -Flonum)))
+  (define flrandom-type (lambda () (-Pseudo-Random-Generator . -> . -Flonum)))
 
   ;; There's a repetitive pattern in the types of each comparison operator.
   ;; As explained below, this is because filters don't do intersections.
@@ -2056,6 +2057,7 @@
 [make-flrectangular (make-flrectangular-type)]
 [flreal-part (flreal-part-type)]
 [flimag-part (flimag-part-type)]
+[flrandom (flrandom-type)]
 
 [unsafe-flabs (flabs-type)]
 [unsafe-fl+ (fl+-type)]
@@ -2095,3 +2097,4 @@
 [unsafe-make-flrectangular (make-flrectangular-type)]
 [unsafe-flreal-part (flreal-part-type)]
 [unsafe-flimag-part (flimag-part-type)]
+[unsafe-flrandom (flrandom-type)]

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt

@@ -5,7 +5,7 @@
          (for-template racket/base racket/flonum racket/unsafe/ops racket/math)
          "../utils/utils.rkt"
          (utils tc-utils)
-         (types numeric-tower union)
+         (types numeric-tower union abbrev)
          (optimizer utils numeric-utils logging fixnum))
 
 (provide float-opt-expr float-arg-expr int-expr)
@@ -37,6 +37,10 @@
 (define-literal-syntax-class ->float^ (exact->inexact real->double-flonum))
 (define-literal-syntax-class ->single-float^ (exact->inexact real->single-flonum))
 
+(define-literal-syntax-class random)
+(define-literal-syntax-class flrandom)
+(define-merged-syntax-class random-op (random^ flrandom^))
+
 (define-syntax-class (float-op tbl)
   #:commit
   (pattern i:id
@@ -229,6 +233,19 @@
     #:do [(log-fl-opt "float sub1")]
     #:with opt #'(unsafe-fl- n.opt 1.0))
 
+  (pattern (#%plain-app op:random-op prng:opt-expr)
+    #:when (subtypeof? #'prng -Pseudo-Random-Generator)
+    #:do [(log-fl-opt "float random")]
+    #:with opt #'(unsafe-flrandom prng.opt))
+  (pattern (#%plain-app op:random^) ; random with no args
+    #:do [(log-fl-opt "float 0-arg random")
+          ;; We introduce a reference to `current-pseudo-random-generator',
+          ;; but, by optimizing, we're preventing the hidden cost reports
+          ;; from triggering down the line (see hidden-cost.rkt), so we need
+          ;; to do the logging ourselves.
+          (log-optimization-info "hidden parameter (random)" #'op)]
+    #:with opt #'(unsafe-flrandom (current-pseudo-random-generator)))
+
   ;; warn about (potentially) exact real arithmetic, in general
   ;; Note: These patterns don't perform optimization. They only produce logging
   ;;  for consumption by Optimization Coach.

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/hidden-costs.rkt

@@ -19,6 +19,7 @@
 (define-syntax-class hidden-cost-log-expr
   #:commit
   #:literal-sets (kernel-literals)
+
   ;; Log functions that access parameters implicitly (e.g. `display', which
   ;; accesses `current-output-port').
   (pattern (#%plain-app op:hidden-port-parameter-function args:opt-expr ...)
@@ -29,12 +30,15 @@
              (not (subtypeof? arg -Output-Port)))
     #:do [(log-optimization-info "hidden parameter" #'op)]
     #:with opt #'(op args.opt ...))
+  ;; This one only fires if the call to `random' didn't get optimized
+  ;; (which logs the hidden cost itself), i.e. (random <Integer>) .
   (pattern (#%plain-app op:hidden-random-parameter-function args:opt-expr ...)
     ;; see above
     #:when (for/and ([arg (in-syntax #'(args ...))])
              (not (subtypeof? arg -Pseudo-Random-Generator)))
     #:do [(log-optimization-info "hidden parameter (random)" #'op)]
     #:with opt #'(op args.opt ...))
+
   ;; Log calls to struct constructors, so that OC can report those used in
   ;; hot loops.
   ;; Note: Sometimes constructors are wrapped in `#%expression', need to watch

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/flrandom.rkt

@@ -0,0 +1,18 @@
+#;#;
+#<<END
+TR info: flrandom.rkt 16:7 random -- hidden parameter (random)
+TR opt: flrandom.rkt 15:6 (random) -- float 0-arg random
+TR opt: flrandom.rkt 17:6 (random (current-pseudo-random-generator)) -- float random
+TR opt: flrandom.rkt 18:6 (flrandom (current-pseudo-random-generator)) -- float random
+END
+#<<END
+END
+
+#lang typed/racket
+
+(require racket/flonum)
+
+(void (random)) ; yes
+(void (random 2)) ; no
+(void (random (current-pseudo-random-generator))) ; yes
+(void (flrandom (current-pseudo-random-generator))) ; yes