X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/7c6ce75e2cc218e193b765149e619d1c9c69cbd6..HEAD:/module/statprof.scm diff --git a/module/statprof.scm b/module/statprof.scm index 961f769e4..e613aad2d 100644 --- a/module/statprof.scm +++ b/module/statprof.scm @@ -1,7 +1,7 @@ ;;;; (statprof) -- a statistical profiler for Guile ;;;; -*-scheme-*- ;;;; -;;;; Copyright (C) 2009, 2010, 2011, 2013, 2014 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011, 2013-2015 Free Software Foundation, Inc. ;;;; Copyright (C) 2004, 2009 Andy Wingo ;;;; Copyright (C) 2001 Rob Browning ;;;; @@ -829,15 +829,16 @@ The return value is a list of nodes, each of which is of the type: equal?)))) (define (call-thunk thunk) - (thunk) - (values)) + (call-with-values (lambda () (thunk)) + (lambda results + (apply values results)))) (define* (statprof thunk #:key (loop 1) (hz 100) (count-calls? #f) (port (current-output-port)) full-stacks?) - "Profiles the execution of @var{thunk}. + "Profile the execution of @var{thunk}, and return its return values. -The stack will be sampled @var{hz} times per second, and the thunk itself will -be called @var{loop} times. +The stack will be sampled @var{hz} times per second, and the thunk +itself will be called @var{loop} times. If @var{count-calls?} is true, all procedure calls will be recorded. This operation is somewhat expensive." @@ -853,15 +854,16 @@ operation is somewhat expensive." (statprof-start state)) (lambda () (let lp ((i loop)) - (unless (zero? i) + (unless (= i 1) (call-thunk thunk) - (lp (1- i))))) + (lp (1- i)))) + (call-thunk thunk)) (lambda () (statprof-stop state) (statprof-display port state)))))) (define-macro (with-statprof . args) - "Profiles the expressions in its body. + "Profile the expressions in the body, and return the body's return values. Keyword arguments: