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

Only keep profile reports from the relevant file.

Browse Source
This commit is contained in:
Vincent St-Amour 2012-08-31 15:18:49 -04:00
parent 9fd9638252
commit a1c93f466c
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/typed-racket/optimizer/tool/profiling.rkt
View File

@ -9,15 +9,15 @@
(define compiled-module-name 'optimization-coach-compiled-module) (define compiled-module-name 'optimization-coach-compiled-module)
(define (generate-profile this source) (define (generate-profile this source)
(define res-mpi (make-resolved-module-path compiled-module-name))
(define snapshots (define snapshots
(run-inside-optimization-coach-sandbox (run-inside-optimization-coach-sandbox
this this
(lambda () (lambda ()
(parameterize ([current-module-declare-name (parameterize ([current-module-declare-name res-mpi])
(make-resolved-module-path compiled-module-name)])
(eval (let ([input (open-input-text-editor source)]) (eval (let ([input (open-input-text-editor source)])
(port-count-lines! input) (port-count-lines! input)
(read-syntax #f input))) (read-syntax res-mpi input)))
;; Require, to run the body, without actually adding anything to the ;; Require, to run the body, without actually adding anything to the
;; current namespace, in case the module calls `eval'. ;; current namespace, in case the module calls `eval'.
(eval '(require profile/sampler)) (eval '(require profile/sampler))
@ -25,6 +25,11 @@
(dynamic-require '',compiled-module-name #f) (dynamic-require '',compiled-module-name #f)
(sampler 'stop) (sampler 'stop)
(sampler 'get-snapshots))))))) (sampler 'get-snapshots)))))))
(for ([n (profile-nodes (analyze-samples snapshots))]) (define (right-file? node)
(define src (node-src node))
(equal? (and src (srcloc-source src)) res-mpi))
(define nodes
(filter right-file? (profile-nodes (analyze-samples snapshots))))
(for ([n nodes])
(printf "~a -- ~a -- ~a -- ~a\n" (node-id n) (node-total n) (node-self n) (node-src n))) (printf "~a -- ~a -- ~a -- ~a\n" (node-id n) (node-total n) (node-self n) (node-src n)))
(profile-nodes (analyze-samples snapshots))) nodes)