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

Handle the case where we would need to merge with multiple children at once.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-06-03 18:46:48 -04:00
parent e095976c8b
commit 1a2080fc97
2 changed files with 28 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -9,13 +9,13 @@ nested-same-kind.rkt 27:0 (#%app * (quote 2.0) (#%app * (quote 3.0) (quote 4) (q
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
@ -25,4 +25,4 @@ nested-same-kind.rkt 28:3 (#%app * (quote 3.0) (quote 4)) -- binary, args all fl
(* 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
(* (* 3.0 (ann 4 Integer)) (* 3.0 (ann 4 Integer)))

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

@ -125,24 +125,34 @@
;; implicitly
(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))])
;; check if the new one is the child of an old one
;; for/first is ok, since we can only have one parent in the list
;; (if we had more, one would have to be the parent of the other, so
;; only one would be in the list)
[parent (for/first ([m (in-list missed-optimizations-log)]
#:when (parent-of? m new))
m)]
;; do we have children in the list, if so, merge with all of them
[children (for/list ([m (in-list missed-optimizations-log)]
#:when (parent-of? new m))
m)])
;; update
(set! 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)]))))
(cond [parent
;; we found our parent, merge with it
(cons (combine-missed-optmizations parent new)
(remove parent missed-optimizations-log))]
[(not (null? children))
;; we found children, merge with them
(let ([new (for/fold ([new new])
([child children])
(combine-missed-optmizations new child))])
(cons new
(filter (lambda (x) (not (member x children)))
missed-optimizations-log)))]
[else
;; no related entry, just add the new one
(cons new missed-optimizations-log)]))))
(define (format-missed-optimization m)
(let ([kind (missed-optimization-kind m)]