Move inliner log processing to its own file.
This commit is contained in:
Vincent St-Amour
parent
83bf7532ec
commit
c0c2d11809
|
|
@ -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.
|
||||
"#\\(([^ ]+) #<path:(.+)> ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) [^ ]+\\)")
|
||||
|
||||
(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
|
||||
|
|
|
|||
113
collects/typed-racket/optimizer/tool/mzc.rkt
Normal file
113
collects/typed-racket/optimizer/tool/mzc.rkt
Normal file
|
|
@ -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.
|
||||
"#\\(([^ ]+) #<path:(.+)> ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) [^ ]+\\)")
|
||||
|
||||
(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))
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user