suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Don't rely on sample counts for anything.

Browse Source
This commit is contained in:
Vincent St-Amour 2014-01-21 11:34:00 -05:00
parent 8340e10b5d
commit 15adde7d7e
3 changed files with 6 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/contract-profile/boundary-view.rkt
View File

@ -46,8 +46,7 @@
(define (boundary-view correlated) (define (boundary-view correlated)
(match-define (contract-profile (match-define (contract-profile
total-time n-samples n-contract-samples total-time live-contract-samples all-blames regular-profile)
live-contract-samples all-blames regular-profile)
correlated) correlated)
(define all-contracts (remove-duplicates (map blame-contract all-blames))) (define all-contracts (remove-duplicates (map blame-contract all-blames)))

13
pkgs/contract-profile/main.rkt
View File

@ -13,7 +13,6 @@
;; reverse is there to sort samples in forward time, which get-times ;; reverse is there to sort samples in forward time, which get-times
;; needs. ;; needs.
(define samples (get-times (map cdr (reverse (cdr samples*))))) (define samples (get-times (map cdr (reverse (cdr samples*)))))
(define n-samples (length contract-samples))
;; combine blame info and stack trace info. samples should line up ;; combine blame info and stack trace info. samples should line up
(define aug-contract-samples (define aug-contract-samples
;; If the sampler was stopped after recording a contract sample, but ;; If the sampler was stopped after recording a contract sample, but
@ -23,7 +22,6 @@
[s (in-list samples)]) [s (in-list samples)])
(cons c-s s))) (cons c-s s)))
(define live-contract-samples (filter car aug-contract-samples)) (define live-contract-samples (filter car aug-contract-samples))
(define n-contract-samples (length live-contract-samples))
(define all-blames (define all-blames
(set->list (for/set ([b (in-list contract-samples)] (set->list (for/set ([b (in-list contract-samples)]
#:when b) #:when b)
@ -33,8 +31,8 @@
(blame-swap b) ; swap back (blame-swap b) ; swap back
b)))) b))))
(define regular-profile (analyze-samples samples*)) (define regular-profile (analyze-samples samples*))
(contract-profile total-time n-samples n-contract-samples (contract-profile
live-contract-samples all-blames regular-profile)) total-time live-contract-samples all-blames regular-profile))
(define (analyze-contract-samples contract-samples samples*) (define (analyze-contract-samples contract-samples samples*)
@ -54,15 +52,13 @@
(define (print-breakdown correlated) (define (print-breakdown correlated)
(match-define (contract-profile (match-define (contract-profile
total-time n-samples n-contract-samples total-time live-contract-samples all-blames regular-profile)
live-contract-samples all-blames regular-profile)
correlated) correlated)
(define total-contract-time (samples-time live-contract-samples)) (define total-contract-time (samples-time live-contract-samples))
(define contract-ratio (/ total-contract-time (max total-time 1) 1.0)) (define contract-ratio (/ total-contract-time (max total-time 1) 1.0))
(printf "Running time is ~a% contracts\n" (printf "Running time is ~a% contracts\n"
(~r (* 100 contract-ratio) #:precision 2)) (~r (* 100 contract-ratio) #:precision 2))
(printf "~a/~a samples\n" n-contract-samples n-samples)
(printf "~a/~a ms\n\n" (printf "~a/~a ms\n\n"
(~r total-contract-time #:precision 0) (~r total-contract-time #:precision 0)
total-time) total-time)
@ -137,8 +133,7 @@
(define (module-graph-view correlated) (define (module-graph-view correlated)
(match-define (contract-profile (match-define (contract-profile
total-time n-samples n-contract-samples total-time live-contract-samples all-blames regular-profile)
live-contract-samples all-blames regular-profile)
correlated) correlated)
;; first, enumerate all the relevant modules ;; first, enumerate all the relevant modules

2
pkgs/contract-profile/utils.rkt
View File

@ -5,7 +5,7 @@
(provide (all-defined-out)) (provide (all-defined-out))
(struct contract-profile (struct contract-profile
(total-time n-samples n-contract-samples (total-time
;; (pairof blame? profile-sample) ;; (pairof blame? profile-sample)
;; samples taken while a contract was running ;; samples taken while a contract was running
live-contract-samples live-contract-samples