diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt index f0727012..8009d468 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt +++ b/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)] \ No newline at end of file diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt index 9dc6d09b..fb5d1720 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt +++ b/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. diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/hidden-costs.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/hidden-costs.rkt index 6d1eb4ff..d3ff094c 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/hidden-costs.rkt +++ b/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 ) . (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 diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/flrandom.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/flrandom.rkt new file mode 100644 index 00000000..95cc317c --- /dev/null +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/flrandom.rkt @@ -0,0 +1,18 @@ +#;#; +#<