From c0c2d118095cb829bf01d52006622ebe8e74d6c8 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Fri, 7 Oct 2011 17:25:26 -0400 Subject: [PATCH] Move inliner log processing to its own file. --- .../typed-racket/optimizer/tool/logging.rkt | 50 +------- collects/typed-racket/optimizer/tool/mzc.rkt | 113 ++++++++++++++++++ .../typed-racket/optimizer/tool/report.rkt | 53 +------- 3 files changed, 116 insertions(+), 100 deletions(-) create mode 100644 collects/typed-racket/optimizer/tool/mzc.rkt diff --git a/collects/typed-racket/optimizer/tool/logging.rkt b/collects/typed-racket/optimizer/tool/logging.rkt index 16d32af7a1..256aad21e2 100644 --- a/collects/typed-racket/optimizer/tool/logging.rkt +++ b/collects/typed-racket/optimizer/tool/logging.rkt @@ -1,8 +1,8 @@ #lang racket/base -(require "utilities.rkt" +(require "mzc.rkt" typed-racket/optimizer/logging - unstable/logging unstable/syntax racket/match) + unstable/logging) (provide with-intercepted-opt-logging) @@ -19,49 +19,3 @@ ;; From mzc, create a log-entry from the info. (interceptor (mzc-opt-log-message->log-entry (vector-ref l 1)))])) thunk)) - - -(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 (log-message-from-mzc-opt? l) - (regexp-match mzc-optimizer-regexp l)) - -;; String (message from the mzc optimizer) -> log-entry -(define (mzc-opt-log-message->log-entry l) - (define forged-stx (inlining-event->forged-stx l)) - (cond [(regexp-match success-regexp l) - (inlining-success->log-entry forged-stx)] - [(regexp-match failure-regexp l) - (inlining-failure->log-entry forged-stx)] - [else - (error "Unknown log message type" l)])) - -(define inlining-event-regexp - ;; Last bit is `generated?'. We don't care about that. - ;; The middle elements of the vector are numbers of #f. - "#\\(([^ ]+) # ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) [^ ]+\\)") - -(define (inlining-event->forged-stx l) - (match (regexp-match inlining-event-regexp l) - [`(,all ,name ,path ,line ,col ,pos ,span) - (datum->syntax #'here (string->symbol name) - (list path - (string->number line) - (string->number col) - (string->number pos) - (string->number span)))] - [_ (error "ill-formed inlining log entry" l)])) - -(define (inlining-success->log-entry forged-stx) - (opt-log-entry "Inlining" "Inlining" - forged-stx ; stx - forged-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 - (syntax-position forged-stx) - '() '() 1)) ; irritants, merged-irritants badness diff --git a/collects/typed-racket/optimizer/tool/mzc.rkt b/collects/typed-racket/optimizer/tool/mzc.rkt new file mode 100644 index 0000000000..041f9844fb --- /dev/null +++ b/collects/typed-racket/optimizer/tool/mzc.rkt @@ -0,0 +1,113 @@ +#lang racket/base + +;;;; Processing of mzc inliner logs. + +(require "utilities.rkt" + typed-racket/optimizer/logging + unstable/syntax racket/match racket/list) + +(provide log-message-from-mzc-opt? + mzc-opt-log-message->log-entry + post-process-inline-log) + + +;;; Low-level log parsing. Goes from strings to log-entry structs. + +(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 (log-message-from-mzc-opt? l) + (regexp-match mzc-optimizer-regexp l)) + +;; String (message from the mzc optimizer) -> log-entry +(define (mzc-opt-log-message->log-entry l) + (define forged-stx (inlining-event->forged-stx l)) + (cond [(regexp-match success-regexp l) + (inlining-success->log-entry forged-stx)] + [(regexp-match failure-regexp l) + (inlining-failure->log-entry forged-stx)] + [else + (error "Unknown log message type" l)])) + +(define inlining-event-regexp + ;; Last bit is `generated?'. We don't care about that. + ;; The middle elements of the vector are numbers of #f. + "#\\(([^ ]+) # ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) [^ ]+\\)") + +(define (inlining-event->forged-stx l) + (match (regexp-match inlining-event-regexp l) + [`(,all ,name ,path ,line ,col ,pos ,span) + (datum->syntax #'here (string->symbol name) + (list path + (string->number line) + (string->number col) + (string->number pos) + (string->number span)))] + [_ (error "ill-formed inlining log entry" l)])) + +(define (inlining-success->log-entry forged-stx) + (opt-log-entry "Inlining" "Inlining" + forged-stx ; stx + forged-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 + (syntax-position forged-stx) + '() '() 1)) ; irritants, merged-irritants badness + + +;;; Log processing. Interprets the log entries, and produces new ones. + +;; We aggregate results for each function. +;; Log messages produced by the inliner are very raw, unlike the TR logs, +;; which have gone through some aggregation. We do the aggregation here. +(define (post-process-inline-log log) + (define-values (inliner-logs tr-logs) + (partition (lambda (x) (regexp-match "[iI]nlining" (log-entry-kind x))) + log)) + (define grouped-events + (group-by (lambda (x y) + (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 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))) + ;; If we have any failures at all, we consider it a missed opt. + (define aggregation-string + (format "(~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)) + ", " "") + (if (> n-failures 0) + (format "~a failure~a" + n-failures + (if (> n-failures 1) "s" "")) + ""))) + (if (> n-failures 0) + (missed-opt-log-entry + kind + (format "Missed Inlining ~a" aggregation-string) + stx located-stx pos + (missed-opt-log-entry-irritants head) + (missed-opt-log-entry-merged-irritants head) + n-failures) ; badness + (opt-log-entry + kind + (format "Inlining ~a" aggregation-string) + stx located-stx pos))]))) + (append tr-logs new-inline-log-entries)) diff --git a/collects/typed-racket/optimizer/tool/report.rkt b/collects/typed-racket/optimizer/tool/report.rkt index 09553d1b97..faac4e70da 100644 --- a/collects/typed-racket/optimizer/tool/report.rkt +++ b/collects/typed-racket/optimizer/tool/report.rkt @@ -4,7 +4,7 @@ unstable/syntax racket/sandbox typed-racket/optimizer/logging (prefix-in tr: typed-racket/typed-reader) - "logging.rkt" "utilities.rkt") + "logging.rkt" "mzc.rkt") (provide (struct-out report-entry) (struct-out sub-report-entry) @@ -82,57 +82,6 @@ (filter right-file? (reverse log))) -;; We aggregate results for each function. -;; Log messages produced by the inliner are very raw, unlike the TR logs, -;; which have gone through some aggregation. We do the aggregation here. -(define (post-process-inline-log log) - (define-values (inliner-logs tr-logs) - (partition (lambda (x) (regexp-match "[iI]nlining" (log-entry-kind x))) - log)) - (define grouped-events - (group-by (lambda (x y) - (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 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))) - ;; If we have any failures at all, we consider it a missed opt. - (define aggregation-string - (format "(~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)) - ", " "") - (if (> n-failures 0) - (format "~a failure~a" - n-failures - (if (> n-failures 1) "s" "")) - ""))) - (if (> n-failures 0) - (missed-opt-log-entry - kind - (format "Missed Inlining ~a" aggregation-string) - stx located-stx pos - (missed-opt-log-entry-irritants head) - (missed-opt-log-entry-merged-irritants head) - n-failures) ; badness - (opt-log-entry - kind - (format "Inlining ~a" aggregation-string) - stx located-stx pos))]))) - (append tr-logs new-inline-log-entries)) - ;; converts log-entry structs to report-entry structs for further ;; processing (define (log->report log)