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

First attempt at handling missed optimization cascades.

Browse Source 
Currently, if missed optimizations a and b are of the same kind, a is caused
by b, and b is caused by c, we merge them into a single miss with cause c.

This works in some cases, but fails in others.

original commit: 8d2f66faa6e77376e04827cd56be440325d77a29
This commit is contained in:
Vincent St-Amour 2011-06-03 17:27:22 -04:00
parent 33d343dd6f
commit d2d2432b1d
4 changed files with 88 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/tests/typed-scheme/optimizer/missed-optimizations/nested-same-kind.rkt Normal file
View File

@ -0,0 +1,28 @@
#;
(
nested-same-kind.rkt 25:0 (#%app * (quote 2.0) (#%app * (quote 3.0) (quote 4))) -- binary, args all float-arg-expr, return type not Float -- caused by: 25:19 (quote 4)
nested-same-kind.rkt 25:0 (#%app * (quote 2.0) (#%app * (quote 3.0) (quote 4))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 25:7 (#%app * (quote 3.0) (quote 4))
nested-same-kind.rkt 26:0 (#%app * (quote 1.0) (#%app * (quote 2.0) (#%app * (quote 3.0) (quote 4)))) -- binary, args all float-arg-expr, return type not Float -- caused by: 26:26 (quote 4)
nested-same-kind.rkt 26:0 (#%app * (quote 1.0) (#%app * (quote 2.0) (#%app * (quote 3.0) (quote 4)))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 26:14 (#%app * (quote 3.0) (quote 4))
nested-same-kind.rkt 27:0 (#%app * (quote 2.0) (#%app * (quote 3.0) (quote 4) (quote 5))) -- binary, args all float-arg-expr, return type not Float -- caused by: 27:19 (quote 4), 27:35 (quote 5)
nested-same-kind.rkt 27:0 (#%app * (quote 2.0) (#%app * (quote 3.0) (quote 4) (quote 5))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 27:7 (#%app * (quote 3.0) (quote 4) (quote 5))
nested-same-kind.rkt 28:0 (#%app * (#%app * (quote 3.0) (quote 4)) (#%app * (quote 3.0) (quote 4))) -- binary, args all float-arg-expr, return type not Float -- caused by: 28:15 (quote 4), 28:39 (quote 4)
nested-same-kind.rkt 28:0 (#%app * (#%app * (quote 3.0) (quote 4)) (#%app * (quote 3.0) (quote 4))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 28:27 (#%app * (quote 3.0) (quote 4))
nested-same-kind.rkt 28:0 (#%app * (#%app * (quote 3.0) (quote 4)) (#%app * (quote 3.0) (quote 4))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 28:3 (#%app * (quote 3.0) (quote 4))
nested-same-kind.rkt 28:3 (#%app * (quote 3.0) (quote 4)) -- binary, args all float-arg-expr, return type not Float -- caused by: 28:15 (quote 4)
24.0
24.0
120.0
144.0
)
#lang typed/racket
;; when a single "bubble" causes missed optimizations to cascade, a single
;; close call should be reported, with the outermost expression being reported
;; but with the innermost flagged as the cause
(* 2.0 (* 3.0 (ann 4 Integer)))
(* 1.0 (* 2.0 (* 3.0 (ann 4 Integer))))
(* 2.0 (* 3.0 (ann 4 Integer) (ann 5 Integer)))
(* (* 3.0 (ann 4 Integer)) (* 3.0 (ann 4 Integer))) ; doesn't currently work properly

4
collects/tests/typed-scheme/optimizer/missed-optimizations/precision-loss.rkt
View File

@ -6,9 +6,8 @@ precision-loss.rkt 26:1 + -- binary float
precision-loss.rkt 28:0 (#%app + (#%app - (quote 3/4)) (quote 2.0)) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 28:3 (#%app - (quote 3/4))
precision-loss.rkt 28:1 + -- binary float
precision-loss.rkt 30:1 + -- binary float
precision-loss.rkt 36:0 (#%app * (#%app * (quote 3/4) (quote 2/3)) (quote 2.0)) -- binary, args all float-arg-expr, return type not Float -- caused by: 36:8 (#%app * (quote 3/4) (quote 2/3))
precision-loss.rkt 36:0 (#%app * (#%app * (quote 3/4) (quote 2/3)) (quote 2.0)) -- binary, args all float-arg-expr, return type not Float -- caused by: 36:11 (quote 3/4), 36:15 (quote 2/3)
precision-loss.rkt 36:0 (#%app * (#%app * (quote 3/4) (quote 2/3)) (quote 2.0)) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 36:8 (#%app * (quote 3/4) (quote 2/3))
precision-loss.rkt 36:8 (#%app * (quote 3/4) (quote 2/3)) -- binary, args all float-arg-expr, return type not Float -- caused by: 36:11 (quote 3/4), 36:15 (quote 2/3)
2.5
2.75
1.25
@ -16,6 +15,7 @@ precision-loss.rkt 36:8 (#%app * (quote 3/4) (quote 2/3)) -- binary, args all fl
1.0
)
#lang typed/racket
;; warn when the extra precision gained by doing exact computations would

4
collects/tests/typed-scheme/optimizer/tests/float-real.rkt
View File

@ -4,14 +4,14 @@ float-real.rkt 18:1 + -- binary float
float-real.rkt 19:0 (#%app + (quote 2.3) (#%app * (quote 2) (quote 3.2))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 19:7 (#%app * (quote 2) (quote 3.2))
float-real.rkt 19:1 + -- binary float
float-real.rkt 19:7 (#%app * (quote 2) (quote 3.2)) -- binary, args all float-arg-expr, return type not Float -- caused by: 19:15 (quote 2)
float-real.rkt 20:0 (#%app * (quote 2.3) (#%app * (quote 2) (quote 3.1))) -- binary, args all float-arg-expr, return type not Float -- caused by: 20:7 (#%app * (quote 2) (quote 3.1))
float-real.rkt 20:0 (#%app * (quote 2.3) (#%app * (quote 2) (quote 3.1))) -- binary, args all float-arg-expr, return type not Float -- caused by: 20:15 (quote 2)
float-real.rkt 20:0 (#%app * (quote 2.3) (#%app * (quote 2) (quote 3.1))) -- exact arithmetic subexpression inside a float expression, extra precision discarded -- caused by: 20:7 (#%app * (quote 2) (quote 3.1))
float-real.rkt 20:7 (#%app * (quote 2) (quote 3.1)) -- binary, args all float-arg-expr, return type not Float -- caused by: 20:15 (quote 2)
5.3
8.7
14.26
)
#lang typed/racket
;; reals within float expressions should be coerced when it's safe to do so

61
collects/typed-scheme/optimizer/logging.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base
(require racket/set racket/string racket/match
(require racket/set racket/string racket/match racket/list
unstable/syntax)
(provide log-optimization log-missed-optimization
@ -87,18 +87,69 @@
;; badness : Integer. crude measure of how severe the missed optimizations are
;; currently, it's simply a count of how many missed optimizations occur
;; within a given syntax object
(struct missed-optimization (kind stx irritants [badness #:mutable])
;; irritants are the original, potentially indirect causes of the miss
;; merged-irritants are intermediate steps between stx and an irritant
;; they are not actual irritants anymore because they were the stx for a miss
;; that got merged into this miss. we need to keep them around to detect
;; future potential merges.
(struct missed-optimization (kind stx irritants merged-irritants badness)
#:transparent)
(define missed-optimizations-log '())
;; is parent the "parent" missed optimization of child?
;; this determines whether they get reported together or not
;; currently, parents and children must be of the same kind of missed
;; optimization, and the child must be an irritant of the parent, or be a
;; merged irritant of the parent
(define (parent-of? parent child)
(and (equal? (missed-optimization-kind parent)
(missed-optimization-kind child))
(member (missed-optimization-stx child)
(append (missed-optimization-irritants parent)
(missed-optimization-merged-irritants parent)))))
;; combine reporting of two missed optimizations, increasing badness in the
;; process
(define (combine-missed-optmizations parent child)
(missed-optimization
(missed-optimization-kind parent) ; same as child's
(missed-optimization-stx parent) ; we report the outermost one
(remove-duplicates
(append (remove (missed-optimization-stx child)
(missed-optimization-irritants parent))
(missed-optimization-irritants child)))
(remove-duplicates
(append (missed-optimization-merged-irritants child)
(missed-optimization-merged-irritants parent)
;; we merge child in, keep it for future merges
(list (missed-optimization-stx child))))
(+ (missed-optimization-badness parent)
(missed-optimization-badness child))))
(define (log-missed-optimization kind stx [irritants '()])
;; for convenience, if a single irritant is given, wrap it in a list
;; implicitly
(let ([irritants (if (list? irritants) irritants (list irritants))])
(let* ([irritants (if (list? irritants) irritants (list irritants))]
[new (missed-optimization kind stx irritants '() 1)]
;; check if the new one is the child of an old one, or vice versa
;; we check for either to do a single traversal
[parent/child (for/first ([m (in-list missed-optimizations-log)]
#:when (or (parent-of? m new)
(parent-of? new m)))
m)]
;; if we found a related entry, is it our parent or our child?
[parent? (and parent/child (parent-of? parent/child new))])
;; update
(set! missed-optimizations-log
(cons (missed-optimization kind stx irritants 1)
missed-optimizations-log))))
(cond [parent/child
;; we replace the related entry with a new one
(cons (if parent?
(combine-missed-optmizations parent/child new)
(combine-missed-optmizations new parent/child))
(remove parent/child missed-optimizations-log))]
;; no related entry, just add the new one
[else (cons new missed-optimizations-log)]))))
(define (format-missed-optimization m)
(let ([kind (missed-optimization-kind m)]