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

7
collects/profile/analyzer.rkt
View File

@ -25,14 +25,14 @@
(define id+src->node-hash (make-hasheq))
(define (id+src->node 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
(define *-node (id+src->node '(#f . #f)))
(define call->edge
(let ([t (make-hasheq)])
(lambda (ler 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-callees! ler (cons e (node-callees ler)))
e)))))
@ -84,8 +84,7 @@
(for ([n (in-list nodes)])
(set-node-callees! n (sort (node-callees n) > #:key edge-callee-time))
(set-node-callers! n (sort (node-callers n) > #:key edge-caller-time)))
(make-profile
total-time
(profile total-time
cpu-time
(length samples)
(for/list ([time (in-vector thread-times)] [n (in-naturals 0)])

9
collects/profile/structs.rkt
View File

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