suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Have a more useful message for float missed opts.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-06-27 18:22:58 -04:00
parent 5ddfcfba9d
commit d68267cbfa
2 changed files with 23 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/typed-scheme/optimizer/float.rkt
View File

@ -4,7 +4,7 @@
racket/dict racket/flonum racket/dict racket/flonum
(for-template racket/base racket/flonum racket/unsafe/ops racket/math) (for-template racket/base racket/flonum racket/unsafe/ops racket/math)
"../utils/utils.rkt" "../utils/utils.rkt"
(types numeric-tower) (types numeric-tower type-table)
(optimizer utils numeric-utils logging fixnum)) (optimizer utils numeric-utils logging fixnum))
(provide float-opt-expr float-arg-expr) (provide float-opt-expr float-arg-expr)
@ -74,6 +74,15 @@
(pattern e:real-expr (pattern e:real-expr
#:with opt #'(exact->inexact e))) #:with opt #'(exact->inexact e)))
(define (log-float-real-missed-opt stx irritants)
(log-missed-optimization
(format "This expression has type ~a. It would be better optimized if it had a Float type. To fix this, change the irritant~a to have~a Float type~a."
(print-res (type-of stx))
(if (> (length irritants) 1) "s" "")
(if (> (length irritants) 1) "" " a")
(if (> (length irritants) 1) "s" "")) ; plural
stx irritants))
(define-syntax-class float-opt-expr (define-syntax-class float-opt-expr
#:commit #:commit
(pattern (#%plain-app (~var op (float-op unary-float-ops)) f:float-arg-expr) (pattern (#%plain-app (~var op (float-op unary-float-ops)) f:float-arg-expr)
@ -81,8 +90,7 @@
[missed-optimization? (and (not safe-to-opt?) [missed-optimization? (and (not safe-to-opt?)
(in-real-layer? this-syntax))]) (in-real-layer? this-syntax))])
(when missed-optimization? (when missed-optimization?
(log-missed-optimization "unary, arg float-arg-expr, return type not Float" (log-float-real-missed-opt this-syntax (list #'f)))
this-syntax))
safe-to-opt?) safe-to-opt?)
#:with opt #:with opt
(begin (log-optimization "unary float" this-syntax) (begin (log-optimization "unary float" this-syntax)
@ -100,11 +108,11 @@
[missed-optimization? (and (not safe-to-opt?) [missed-optimization? (and (not safe-to-opt?)
(in-real-layer? this-syntax))]) (in-real-layer? this-syntax))])
(when missed-optimization? (when missed-optimization?
(log-missed-optimization "binary, args all float-arg-expr, return type not Float" (log-float-real-missed-opt
this-syntax this-syntax
(for/list ([x (in-list (syntax->list #'(f1 f2 fs ...)))] (for/list ([x (in-list (syntax->list #'(f1 f2 fs ...)))]
#:when (not (subtypeof? x -Flonum))) #:when (not (subtypeof? x -Flonum)))
x))) x)))
;; If an optimization was expected (whether it was safe or not doesn't matter), ;; If an optimization was expected (whether it was safe or not doesn't matter),
;; report subexpressions doing expensive exact arithmetic (Exact-Rational and ;; report subexpressions doing expensive exact arithmetic (Exact-Rational and
;; Real arithmetic), since that extra precision would be "lost" by going to ;; Real arithmetic), since that extra precision would be "lost" by going to

8
collects/typed-scheme/optimizer/utils.rkt
View File

@ -12,7 +12,8 @@
mk-unsafe-tbl mk-unsafe-tbl
n-ary->binary n-ary->binary
unboxed-gensym reset-unboxed-gensym unboxed-gensym reset-unboxed-gensym
optimize) optimize
print-res)
;; if set to #t, the optimizer will dump its result to stdout before compilation ;; if set to #t, the optimizer will dump its result to stdout before compilation
(define *show-optimized-code* #f) (define *show-optimized-code* #f)
@ -51,3 +52,8 @@
;; will be set to the actual optimization function at the entry point ;; will be set to the actual optimization function at the entry point
;; of the optimizer ;; of the optimizer
(define optimize (make-parameter #f)) (define optimize (make-parameter #f))
(define (print-res t)
(match t
[(tc-result1: t f o)
(format "~a" t)]))