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

Handle out-of-fuel messages.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-10-07 18:04:53 -04:00
parent c0c2d11809
commit d9e0afab1c
1 changed files with 40 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/typed-racket/optimizer/tool/mzc.rkt
View File

@ -16,6 +16,8 @@
(define mzc-optimizer-regexp "^mzc optimizer: ")
(define success-regexp (string-append mzc-optimizer-regexp "inlining: "))
(define failure-regexp (string-append mzc-optimizer-regexp "no inlining: "))
(define out-of-fuel-regexp (string-append mzc-optimizer-regexp
"no inlining, out of fuel: "))
(define (log-message-from-mzc-opt? l)
(regexp-match mzc-optimizer-regexp l))
@ -27,6 +29,8 @@
(inlining-success->log-entry forged-stx)]
[(regexp-match failure-regexp l)
(inlining-failure->log-entry forged-stx)]
[(regexp-match out-of-fuel-regexp l)
(inlining-out-of-fuel->log-entry forged-stx)]
[else
(error "Unknown log message type" l)]))
@ -46,17 +50,24 @@
(string->number span)))]
[_ (error "ill-formed inlining log entry" l)]))
(define success-kind "Inlining")
(define failure-kind "Failed Inlining")
(define out-of-fuel-kind "Failed Inlining, Out of Fuel")
(define (inlining-success->log-entry forged-stx)
(opt-log-entry "Inlining" "Inlining"
forged-stx ; stx
forged-stx ; located-stx
(opt-log-entry success-kind success-kind
forged-stx forged-stx ; stx, located-stx
(syntax-position forged-stx)))
(define (inlining-failure->log-entry forged-stx)
(missed-opt-log-entry "Failed Inlining" "Failed Inlining"
forged-stx
forged-stx
(missed-opt-log-entry failure-kind failure-kind
forged-stx forged-stx
(syntax-position forged-stx)
'() '() 1)) ; irritants, merged-irritants badness
(define (inlining-out-of-fuel->log-entry forged-stx)
(missed-opt-log-entry out-of-fuel-kind out-of-fuel-kind
forged-stx forged-stx
(syntax-position forged-stx)
'() '() 1))
;;; Log processing. Interprets the log entries, and produces new ones.
@ -73,32 +84,48 @@
(equal? (log-entry-pos x) ; right file, so that's enough
(log-entry-pos y)))
inliner-logs))
(define (success? l) (equal? "Inlining" (log-entry-kind l)))
(define (failure? l) (equal? "Failed Inlining" (log-entry-kind l)))
(define (success? l) (equal? success-kind (log-entry-kind l)))
(define (failure? l) (equal? failure-kind (log-entry-kind l)))
(define (out-of-fuel? l) (equal? out-of-fuel-kind (log-entry-kind l)))
(define new-inline-log-entries
(for/list ([group (in-list grouped-events)])
(define head (car group))
(match head ; events are grouped, first element is representative
[(log-entry kind msg stx located-stx pos)
(define n-successes (length (filter success? group)))
(define n-failures (length (filter failure? group)))
(define n-successes (length (filter success? group)))
(define n-failures (length (filter failure? group)))
(define n-out-of-fuels (length (filter out-of-fuel? group)))
;; If we have any failures at all, we consider it a missed opt.
(define aggregation-string
(format "(~a~a~a~a~a)"
(format "(~a~a~a~a~a~a~a)"
(if (> n-successes 0)
(format "~a success~a"
n-successes
(if (> n-successes 1) "es" ""))
"")
(if (and (> n-successes 0)
(> n-failures 0))
(or (> n-failures 0)
(> n-out-of-fuels 0)))
", " "")
(if (> n-failures 0)
(format "~a failure~a"
n-failures
(if (> n-failures 1) "s" ""))
"")
(if (and (> n-failures 0)
(> n-out-of-fuels 0))
", " "")
(if (> n-out-of-fuels 0)
(format "~a out of fuel~a"
n-out-of-fuels
(if (> n-out-of-fuels 1) "s" ""))
"")))
(if (> n-failures 0)
;; This is where the interesting decisions are taken.
(define counts-as-a-missed-opt?
(or (> n-failures 0) ; any straight failure is a problem
(> n-out-of-fuels n-successes) ; we fail more often than not
))
(if counts-as-a-missed-opt?
(missed-opt-log-entry
kind
(format "Missed Inlining ~a" aggregation-string)