From 0e710c1618c4a27aabc951dfdb2249527f673522 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 6 Oct 2011 11:50:54 -0400 Subject: [PATCH] Show inlining and failed inlinings in Performance Report. --- .../typed-racket/optimizer/tool/logging.rkt | 67 +++++++++++++++++++ .../typed-racket/optimizer/tool/report.rkt | 10 +-- .../typed-racket/optimizer/tool/utilities.rkt | 34 ++++++++++ 3 files changed, 106 insertions(+), 5 deletions(-) create mode 100644 collects/typed-racket/optimizer/tool/logging.rkt create mode 100644 collects/typed-racket/optimizer/tool/utilities.rkt diff --git a/collects/typed-racket/optimizer/tool/logging.rkt b/collects/typed-racket/optimizer/tool/logging.rkt new file mode 100644 index 0000000000..16d32af7a1 --- /dev/null +++ b/collects/typed-racket/optimizer/tool/logging.rkt @@ -0,0 +1,67 @@ +#lang racket/base + +(require "utilities.rkt" + typed-racket/optimizer/logging + unstable/logging unstable/syntax racket/match) + +(provide with-intercepted-opt-logging) + +;; Intercepts both TR optimizer logging and mzc optimizer logging. +;; Interceptor accepts log-entry structs. +(define (with-intercepted-opt-logging interceptor thunk) + (with-intercepted-logging #:level 'debug + (lambda (l) + (cond [(log-message-from-tr-opt? l) + ;; From TR, use the log-entry struct provided. + (interceptor (cdr (vector-ref l 2)))] + ;; We look at the message to tell if it's from mzc. + [(log-message-from-mzc-opt? (vector-ref l 1)) + ;; 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/report.rkt b/collects/typed-racket/optimizer/tool/report.rkt index 039b6313f4..fbb1aaa015 100644 --- a/collects/typed-racket/optimizer/tool/report.rkt +++ b/collects/typed-racket/optimizer/tool/report.rkt @@ -3,7 +3,8 @@ (require racket/class racket/gui/base racket/match racket/port racket/list unstable/syntax racket/sandbox typed-racket/optimizer/logging - (prefix-in tr: typed-racket/typed-reader)) + (prefix-in tr: typed-racket/typed-reader) + "logging.rkt") (provide (struct-out report-entry) (struct-out sub-report-entry) @@ -61,10 +62,9 @@ (define log '()) (call-with-trusted-sandbox-configuration (lambda () - (with-intercepted-tr-logging + (with-intercepted-opt-logging (lambda (l) - (define data (cdr (vector-ref l 2))) ; get the log-entry part - (set! log (cons data log))) + (set! log (cons l log))) (lambda () (define port-name (send this get-port-name)) (parameterize @@ -75,7 +75,7 @@ base) (current-load-relative-directory))] [read-accept-reader #t]) - (void (expand (tr:read-syntax portname input)))))))) + (void (compile (tr:read-syntax portname input)))))))) (filter right-file? (reverse log))) ;; converts log-entry structs to report-entry structs for further diff --git a/collects/typed-racket/optimizer/tool/utilities.rkt b/collects/typed-racket/optimizer/tool/utilities.rkt new file mode 100644 index 0000000000..7b85becf33 --- /dev/null +++ b/collects/typed-racket/optimizer/tool/utilities.rkt @@ -0,0 +1,34 @@ +#lang racket/base + +;; TODO all this stuff should make it into unstable/X + +(provide (all-defined-out)) + +(define (regexp-filter r log) + (for/list ([l (in-list log)] #:when (regexp-match r l)) + l)) + +;; (x x -> bool) (listof x) -> (listof (listof x)) +;; groups together elements that are considered equal +;; =? should be reflexive, transitive and commutative +(define (group-by =? l) + (for/fold ([res '()]) ; list of lists + ([elt (in-list l)]) + (let loop ([classes res] ; "zipper" of the equivalence classes + [rev-classes '()]) + (cond [(null? classes) + ;; did not find an equivalence class, create a new one + (cons (list elt) res)] + [(=? elt (car (car classes))) + ;; found the equivalence class + (append rev-classes ; we keep what we skipped + ;; we extend the current class + (list (cons elt (car classes))) + (cdr classes))] ; and add the rest + [else ; keep going + (loop (cdr classes) + (cons (car classes) rev-classes))])))) +;; TODO add to unstable/list, and add tests. here's one +;; -> (group-by = '(1 2 1 2 54 2 5 43 7 2 643 1 2 0)) +;; '((0) (2 2 2 2 2) (7) (43) (5) (54) (643) (1 1 1)) +;; TODO needs a #:key arg