dev-refac-2020
Matthew Butterick 6 years ago
parent 15a86c21a7
commit f3ba2b714b

@ -4,7 +4,7 @@
(provide+safe report report/time time-name (provide+safe report report/time time-name
report/line report/file report/line report/file
report* report*/line report*/file report* report*/line report*/file
report-apply repeat time-repeat time-repeat* compare) report-apply repeat time-repeat time-repeat* time-name time-named time-avg compare)
(define (stringify-results expr-results) (define (stringify-results expr-results)
(format (if (= 1 (length expr-results)) (format (if (= 1 (length expr-results))
@ -82,6 +82,27 @@
(define-syntax-rule (time-repeat NUM EXPR ...) (define-syntax-rule (time-repeat NUM EXPR ...)
(time (repeat NUM EXPR ...))) (time (repeat NUM EXPR ...)))
(define (parse-time-str str)
(for/list ([num (in-port read (open-input-string str))]
#:when (number? num))
num))
(define-syntax-rule (time-avg NUM EXPR ...)
(let ([n NUM])
(define-values (strs results)
(for/lists (strs results)
([i n])
(let* ([op (open-output-string)]
[expr-results (parameterize ([current-output-port op])
(time (call-with-values (λ () EXPR ...) values)))])
(values (get-output-string op) expr-results))))
(displayln (apply format "~a: cpu time: ~a real time: ~a gc time: ~a (avg of ~a)"
(append
(list (car '(EXPR ...)))
(for/list ([vals (apply map list (map parse-time-str strs))])
(floor (/ (apply + vals) n)))
(list n))))
(car (reverse results))))
(define-syntax (time-repeat* stx) (define-syntax (time-repeat* stx)
(syntax-case stx () (syntax-case stx ()
@ -96,9 +117,17 @@
#'(let* ([op (open-output-string)] #'(let* ([op (open-output-string)]
[expr-results (parameterize ([current-output-port op]) [expr-results (parameterize ([current-output-port op])
(time (call-with-values (λ () EXPR ...) values)))]) (time (call-with-values (λ () EXPR ...) values)))])
(display (format "~a: ~a" 'NAME (get-output-string op))) (display (format "~a: ~a" 'NAME (get-output-string op)))
expr-results)])) expr-results)]))
(define-syntax (time-named stx)
(syntax-case stx ()
[(_ EXPR ...)
#'(let* ([op (open-output-string)]
[expr-results (parameterize ([current-output-port op])
(time (call-with-values (λ () EXPR ...) values)))])
(display (format "~a: ~a" (car '(EXPR ...)) (get-output-string op)))
expr-results)]))
(define-syntax (compare stx) (define-syntax (compare stx)
(syntax-case stx () (syntax-case stx ()

Loading…
Cancel
Save