From d9e0afab1c60155dd0368f0da7cdc3f7ef842d90 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 7 Oct 2011 18:04:53 -0400
Subject: [PATCH] Handle out-of-fuel messages.

---
 collects/typed-racket/optimizer/tool/mzc.rkt | 53 +++++++++++++++-----
 1 file changed, 40 insertions(+), 13 deletions(-)

diff --git a/collects/typed-racket/optimizer/tool/mzc.rkt b/collects/typed-racket/optimizer/tool/mzc.rkt
index 041f9844fb..2361c17860 100644
--- a/collects/typed-racket/optimizer/tool/mzc.rkt
+++ b/collects/typed-racket/optimizer/tool/mzc.rkt
@@ -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)