diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/nested-same-kind.rkt b/collects/tests/typed-scheme/optimizer/missed-optimizations/nested-same-kind.rkt index 293bef96..93cf0998 100644 --- a/collects/tests/typed-scheme/optimizer/missed-optimizations/nested-same-kind.rkt +++ b/collects/tests/typed-scheme/optimizer/missed-optimizations/nested-same-kind.rkt @@ -1,12 +1,12 @@ #; ( -TR missed opt: nested-same-kind.rkt 25:0 (* 2.0 (* 3.0 (ann 4 Integer))) -- binary, args all float-arg-expr, return type not Float -- caused by: 25:19 (quote 4) +TR missed opt: nested-same-kind.rkt 25:0 (* 2.0 (* 3.0 (ann 4 Integer))) -- binary, args all float-arg-expr, return type not Float -- caused by: 25:19 (quote 4) (3 times) TR missed opt: nested-same-kind.rkt 25:0 (* 2.0 (* 3.0 (ann 4 Integer))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 25:7 (#%app * (quote 3.0) (quote 4)) -TR missed opt: nested-same-kind.rkt 26:0 (* 1.0 (* 2.0 (* 3.0 (ann 4 Integer)))) -- binary, args all float-arg-expr, return type not Float -- caused by: 26:26 (quote 4) -TR missed opt: nested-same-kind.rkt 26:0 (* 1.0 (* 2.0 (* 3.0 (ann 4 Integer)))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 26:14 (#%app * (quote 3.0) (quote 4)) -TR missed opt: nested-same-kind.rkt 27:0 (* 2.0 (* 3.0 (ann 4 Integer) (ann 5 Integer))) -- binary, args all float-arg-expr, return type not Float -- caused by: 27:19 (quote 4), 27:35 (quote 5) +TR missed opt: nested-same-kind.rkt 26:0 (* 1.0 (* 2.0 (* 3.0 (ann 4 Integer)))) -- binary, args all float-arg-expr, return type not Float -- caused by: 26:26 (quote 4) (7 times) +TR missed opt: nested-same-kind.rkt 26:0 (* 1.0 (* 2.0 (* 3.0 (ann 4 Integer)))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 26:14 (#%app * (quote 3.0) (quote 4)) (3 times) +TR missed opt: nested-same-kind.rkt 27:0 (* 2.0 (* 3.0 (ann 4 Integer) (ann 5 Integer))) -- binary, args all float-arg-expr, return type not Float -- caused by: 27:19 (quote 4), 27:35 (quote 5) (3 times) TR missed opt: nested-same-kind.rkt 27:0 (* 2.0 (* 3.0 (ann 4 Integer) (ann 5 Integer))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 27:7 (#%app * (quote 3.0) (quote 4) (quote 5)) -TR missed opt: nested-same-kind.rkt 28:0 (* (* 3.0 (ann 4 Integer)) (* 3.0 (ann 4 Integer))) -- binary, args all float-arg-expr, return type not Float -- caused by: 28:15 (quote 4), 28:39 (quote 4) +TR missed opt: nested-same-kind.rkt 28:0 (* (* 3.0 (ann 4 Integer)) (* 3.0 (ann 4 Integer))) -- binary, args all float-arg-expr, return type not Float -- caused by: 28:15 (quote 4), 28:39 (quote 4) (5 times) TR missed opt: nested-same-kind.rkt 28:0 (* (* 3.0 (ann 4 Integer)) (* 3.0 (ann 4 Integer))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 28:27 (#%app * (quote 3.0) (quote 4)) TR missed opt: nested-same-kind.rkt 28:0 (* (* 3.0 (ann 4 Integer)) (* 3.0 (ann 4 Integer))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 28:3 (#%app * (quote 3.0) (quote 4)) 24.0 diff --git a/collects/tests/typed-scheme/optimizer/missed-optimizations/precision-loss.rkt b/collects/tests/typed-scheme/optimizer/missed-optimizations/precision-loss.rkt index a1a02f6d..dd41421d 100644 --- a/collects/tests/typed-scheme/optimizer/missed-optimizations/precision-loss.rkt +++ b/collects/tests/typed-scheme/optimizer/missed-optimizations/precision-loss.rkt @@ -6,7 +6,7 @@ TR opt: precision-loss.rkt 26:1 + -- binary float TR missed opt: precision-loss.rkt 28:0 (+ (- 3/4) 2.0) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 28:3 (#%app - (quote 3/4)) TR opt: precision-loss.rkt 28:1 + -- binary float TR opt: precision-loss.rkt 30:1 + -- binary float -TR missed opt: precision-loss.rkt 36:0 (* (ann (* 3/4 2/3) Real) 2.0) -- binary, args all float-arg-expr, return type not Float -- caused by: 36:11 (quote 3/4), 36:15 (quote 2/3) +TR missed opt: precision-loss.rkt 36:0 (* (ann (* 3/4 2/3) Real) 2.0) -- binary, args all float-arg-expr, return type not Float -- caused by: 36:11 (quote 3/4), 36:15 (quote 2/3) (3 times) TR missed opt: precision-loss.rkt 36:0 (* (ann (* 3/4 2/3) Real) 2.0) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 36:8 (#%app * (quote 3/4) (quote 2/3)) 2.5 2.75 diff --git a/collects/tests/typed-scheme/optimizer/tests/float-real.rkt b/collects/tests/typed-scheme/optimizer/tests/float-real.rkt index 658de29c..a797a54a 100644 --- a/collects/tests/typed-scheme/optimizer/tests/float-real.rkt +++ b/collects/tests/typed-scheme/optimizer/tests/float-real.rkt @@ -4,7 +4,7 @@ TR opt: float-real.rkt 18:1 + -- binary float TR missed opt: float-real.rkt 19:0 (+ 2.3 (* (ann 2 Integer) 3.2)) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 19:7 (#%app * (quote 2) (quote 3.2)) TR opt: float-real.rkt 19:1 + -- binary float TR missed opt: float-real.rkt 19:7 (* (ann 2 Integer) 3.2) -- binary, args all float-arg-expr, return type not Float -- caused by: 19:15 (quote 2) -TR missed opt: float-real.rkt 20:0 (* 2.3 (* (ann 2 Integer) 3.1)) -- binary, args all float-arg-expr, return type not Float -- caused by: 20:15 (quote 2) +TR missed opt: float-real.rkt 20:0 (* 2.3 (* (ann 2 Integer) 3.1)) -- binary, args all float-arg-expr, return type not Float -- caused by: 20:15 (quote 2) (3 times) TR missed opt: float-real.rkt 20:0 (* 2.3 (* (ann 2 Integer) 3.1)) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 20:7 (#%app * (quote 2) (quote 3.1)) 5.3 8.7 diff --git a/collects/typed-scheme/optimizer/logging.rkt b/collects/typed-scheme/optimizer/logging.rkt index f460706b..f440563c 100644 --- a/collects/typed-scheme/optimizer/logging.rkt +++ b/collects/typed-scheme/optimizer/logging.rkt @@ -28,17 +28,22 @@ ;; a problem per se) (define log-so-far '()) -(define (gen-log-message msg stx from) - (let ([stx (locate-stx stx)]) - (format "~a: ~a ~a ~s -- ~a" - from - (syntax-source-file-name stx) - (line+col->string stx) - (syntax->datum stx) - msg))) +(define (gen-log-message msg stx from show-badness?) + (let* ([stx (locate-stx stx)] + [str (format "~a: ~a ~a ~s -- ~a" + from + (syntax-source-file-name stx) + (line+col->string stx) + (syntax->datum stx) + msg)]) + (if show-badness? ; #f or integer + (format "~a (~a times)" str show-badness?) + str))) -(define (log-optimization msg stx #:from [from "TR opt"]) - (let* ([new-message (gen-log-message msg stx from)] +(define (log-optimization msg stx + #:from [from "TR opt"] + #:show-badness? [show-badness? #f]) + (let* ([new-message (gen-log-message msg stx from show-badness?)] [new-entry (log-entry new-message stx (syntax-position stx))]) (set! log-so-far (cons new-entry log-so-far)))) @@ -47,9 +52,14 @@ (define (print-log) (define logger (current-logger)) ;; add missed optimizations messages to the log, now that we know all of them - (for-each (lambda (x) (log-optimization (format-missed-optimization x) - (missed-optimization-stx x) - #:from "TR missed opt")) + (for-each (lambda (x) + (log-optimization + (format-missed-optimization x) + (missed-optimization-stx x) + #:from "TR missed opt" + #:show-badness? + (let ([badness (missed-optimization-badness x)]) + (and (> badness 1) badness)))) missed-optimizations-log) (for-each (lambda (x) (log-message logger 'warning (log-entry-msg x) optimization-log-key))