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

View File

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