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

Switch to `make-'-less constructors.

Browse Source 
original commit: bfc9a2ba766c199f5cb5b285702af8122f3bcc64
This commit is contained in:
Eli Barzilay 2011-09-06 16:32:06 -04:00
parent c211c38729
commit 71b66bbf9f
2 changed files with 12 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/profile/analyzer.rkt
View File

@ -25,14 +25,14 @@
(define id+src->node-hash (make-hasheq)) (define id+src->node-hash (make-hasheq))
(define (id+src->node id+src) (define (id+src->node id+src)
(with-hash id+src->node-hash id+src (with-hash id+src->node-hash id+src
(make-node (car id+src) (cdr id+src) '() 0 0 '() '()))) (node (car id+src) (cdr id+src) '() 0 0 '() '())))
;; special node that is the caller of toplevels and callee of leaves ;; special node that is the caller of toplevels and callee of leaves
(define *-node (id+src->node '(#f . #f))) (define *-node (id+src->node '(#f . #f)))
(define call->edge (define call->edge
(let ([t (make-hasheq)]) (let ([t (make-hasheq)])
(lambda (ler lee) (lambda (ler lee)
(with-hash (with-hash t ler (make-hasheq)) lee (with-hash (with-hash t ler (make-hasheq)) lee
(let ([e (make-edge 0 ler 0 lee 0)]) (let ([e (edge 0 ler 0 lee 0)])
(set-node-callers! lee (cons e (node-callers lee))) (set-node-callers! lee (cons e (node-callers lee)))
(set-node-callees! ler (cons e (node-callees ler))) (set-node-callees! ler (cons e (node-callees ler)))
e))))) e)))))
@ -84,14 +84,13 @@
(for ([n (in-list nodes)]) (for ([n (in-list nodes)])
(set-node-callees! n (sort (node-callees n) > #:key edge-callee-time)) (set-node-callees! n (sort (node-callees n) > #:key edge-callee-time))
(set-node-callers! n (sort (node-callers n) > #:key edge-caller-time))) (set-node-callers! n (sort (node-callers n) > #:key edge-caller-time)))
(make-profile (profile total-time
total-time cpu-time
cpu-time (length samples)
(length samples) (for/list ([time (in-vector thread-times)] [n (in-naturals 0)])
(for/list ([time (in-vector thread-times)] [n (in-naturals 0)]) (cons n time))
(cons n time)) nodes
nodes *-node)))
*-node)))
;; Groups raw samples by their thread-id, returns a vector with a field for ;; Groups raw samples by their thread-id, returns a vector with a field for
;; each thread id holding the sample data for that thread. The samples in ;; each thread id holding the sample data for that thread. The samples in

9
collects/profile/structs.rkt
View File

@ -15,8 +15,7 @@
;; start a graph traversal from the top or the bottom. ;; start a graph traversal from the top or the bottom.
(provide (struct-out profile)) (provide (struct-out profile))
(struct profile (struct profile
(total-time cpu-time sample-number thread-times nodes *-node) (total-time cpu-time sample-number thread-times nodes *-node))
#:constructor-name make-profile)
;; An entry for a single profiled function: ;; An entry for a single profiled function:
;; - id, src: the corresponding values from `continuation-mark-set->context'. ;; - id, src: the corresponding values from `continuation-mark-set->context'.
@ -37,8 +36,7 @@
#:property prop:custom-write #:property prop:custom-write
(lambda (node o w?) (lambda (node o w?)
(fprintf o "#<node:~s>" (fprintf o "#<node:~s>"
(or (node-id node) (if (node-src node) '??? 'ROOT)))) (or (node-id node) (if (node-src node) '??? 'ROOT)))))
#:constructor-name make-node)
;; An edge representing function calls between two nodes: ;; An edge representing function calls between two nodes:
;; - total: the total time spent while the call was anywhere on the stack. ;; - total: the total time spent while the call was anywhere on the stack.
@ -54,5 +52,4 @@
(lambda (edge o w?) (lambda (edge o w?)
(fprintf o "#<edge:~s-~s>" (fprintf o "#<edge:~s-~s>"
(or (node-id (edge-caller edge)) '???) (or (node-id (edge-caller edge)) '???)
(or (node-id (edge-callee edge)) '???))) (or (node-id (edge-callee edge)) '???))))
#:constructor-name make-edge)