syndicate-lang
/
marketplace-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Profile both process-accounting and regular call-stack

This commit is contained in:
Tony Garnock-Jones 2014-02-19 16:11:54 -05:00
parent 6e3b8be397
commit a48f886509
1 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
ground.rkt
View File

@ -20,20 +20,23 @@
(provide run-ground-vm) (provide run-ground-vm)
(require/typed profile (require/typed profile
[profile-thunk ((-> Void) #:custom-key (Pairof [profile-thunk ((-> Void) #:custom-key (Option (Pairof
(Continuation-Mark-Keyof Any) (Continuation-Mark-Keyof Any)
(-> (Listof Any) (Listof Any))) (-> (Listof Any) (Listof Any))))
-> Void)]) -> Void)])
(: run-ground-vm : process-spec -> Void) (: run-ground-vm : process-spec -> Void)
(define (run-ground-vm boot) (define (run-ground-vm boot)
(profile-thunk (lambda () (run-ground-vm* boot)) (profile-thunk
#:custom-key (cons marketplace-continuation-mark-key (lambda ()
(lambda: ([vs : (Listof Any)]) (profile-thunk (lambda () (run-ground-vm* boot))
(let: loop : (Listof Any) ((vs : (Listof Any) vs)) #:custom-key (cons marketplace-continuation-mark-key
(if (null? vs) (lambda: ([vs : (Listof Any)])
'() (let: loop : (Listof Any) ((vs : (Listof Any) vs))
(cons vs (loop (cdr vs))))))))) (if (null? vs)
'(ground)
(cons vs (loop (cdr vs)))))))))
#:custom-key #f))
(: run-ground-vm* : process-spec -> Void) (: run-ground-vm* : process-spec -> Void)
(define (run-ground-vm* boot) (define (run-ground-vm* boot)