diff --git a/sugar/debug.rkt b/sugar/debug.rkt index 69a914c..f0f233f 100644 --- a/sugar/debug.rkt +++ b/sugar/debug.rkt @@ -4,7 +4,7 @@ (provide+safe report report/time time-name 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) (format (if (= 1 (length expr-results)) @@ -82,6 +82,27 @@ (define-syntax-rule (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) (syntax-case stx () @@ -96,9 +117,17 @@ #'(let* ([op (open-output-string)] [expr-results (parameterize ([current-output-port op]) (time (call-with-values (λ () EXPR ...) values)))]) - (display (format "~a: ~a" 'NAME (get-output-string op))) - expr-results)])) + (display (format "~a: ~a" 'NAME (get-output-string op))) + 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) (syntax-case stx ()