diff --git a/main.rkt b/main.rkt index c103158..f38c683 100644 --- a/main.rkt +++ b/main.rkt @@ -36,6 +36,7 @@ guard racket/file racket/match + racket/pretty racket/sequence racket/set racket/string @@ -73,6 +74,7 @@ (require racket/list rackunit resyntax/private/analyzer + resyntax/private/logger (submod ".."))) @@ -371,7 +373,10 @@ #:into into-hash)) -(define (refactoring-rules-refactor rules syntax #:comments comments #:analysis analysis) +(define (refactoring-rules-refactor rules syntax + #:comments comments + #:analysis analysis + #:rule-timings rule-timings) (define (refactor rule) (with-handlers @@ -424,26 +429,54 @@ #:rule-name (object-name rule) #:message (refactoring-rule-description rule) #:syntax-replacement replacement))))) - + + ;; Timing is only recorded when debug logging is enabled, since that's the only time the + ;; measurements are used. This avoids paying the timing and hash update costs in normal usage. + (define (refactor/timed rule) + (cond + [(log-level? resyntax-logger 'debug) + (define start-ms (current-inexact-monotonic-milliseconds)) + (define result (refactor rule)) + (define elapsed-ms (- (current-inexact-monotonic-milliseconds) start-ms)) + (hash-update! rule-timings (object-name rule) (+ _ elapsed-ms) 0) + result] + [else (refactor rule)])) + (falsey->option (for*/first ([rule (in-list rules)] - [result (in-option (refactor rule))]) + [result (in-option (refactor/timed rule))]) result))) (define (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines) (define rule-list (refactoring-suite-rules suite)) - (for*/fold ([results '()] - [modified-positions (range-set #:comparator natural<=>)] - #:result (reverse results)) - ([stx (in-list (source-code-analysis-visited-forms analysis))] - #:unless (range-set-intersects? modified-positions (syntax-source-range stx)) - [result - (in-option - (refactoring-rules-refactor rule-list stx #:comments comments #:analysis analysis))] - #:when (check-lines-enclose-refactoring-result lines result)) - (values (cons result results) - (range-set-add modified-positions (refactoring-result-modified-range result))))) + (define rule-timings (make-hash)) + (begin0 + (for*/fold ([results '()] + [modified-positions (range-set #:comparator natural<=>)] + #:result (reverse results)) + ([stx (in-list (source-code-analysis-visited-forms analysis))] + #:unless (range-set-intersects? modified-positions (syntax-source-range stx)) + [result + (in-option + (refactoring-rules-refactor rule-list stx + #:comments comments + #:analysis analysis + #:rule-timings rule-timings))] + #:when (check-lines-enclose-refactoring-result lines result)) + (values (cons result results) + (range-set-add modified-positions (refactoring-result-modified-range result)))) + (log-rule-timings rule-timings (source-code-analysis-code analysis)))) + + +;; Logs a table of the total time in milliseconds spent checking each rule against a source, where +;; each rule's total is the sum of the time spent testing it on each individual syntax object. +(define (log-rule-timings rule-timings source) + (when (log-level? resyntax-logger 'debug) + (define timings-str (string-indent (pretty-format rule-timings) #:amount 2)) + (log-resyntax-debug "total time spent checking each rule against ~a (in milliseconds):\n~a" + (or (source-path source) "string source") + timings-str))) (define (check-lines-enclose-refactoring-result lines result) @@ -504,6 +537,21 @@ #:end 28 #:contents (list (inserted-string "(or 1 2 3)"))))) + (test-case "resyntax-analyze logs rule application timings" + (define receiver (make-log-receiver resyntax-logger 'debug)) + (resyntax-analyze (string-source "#lang racket (or 1 (or 2 3))")) + (define timing-messages + (let loop ([messages '()]) + (define log-event (sync/timeout 0 receiver)) + (cond + [log-event + (define message (vector-ref log-event 1)) + (if (regexp-match? #rx"total time spent checking each rule" message) + (loop (cons message messages)) + (loop messages))] + [else messages]))) + (check-equal? (length timing-messages) 1)) + (test-case "resyntax-analyze uses suite analyzers" (define test-suite default-recommendations) (check-true (set? (refactoring-suite-analyzers test-suite)))