mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

Merge commit 'cdcba5b2f6'

Browse source 
Conflicts:
	module/statprof.scm
This commit is contained in:
Andy Wingo 2015-01-22 14:37:18 +01:00
commit 6f248df1f6
3 changed files with 28 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

7
doc/ref/statprof.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*- @c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual. @c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 2013 Free Software Foundation, Inc. @c Copyright (C) 2013, 2015 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions. @c See the file guile.texi for copying conditions.
@node Statprof @node Statprof
@ -220,7 +220,7 @@ The return value is a list of nodes, each of which is of the type:
@end defun @end defun
@anchor{statprof statprof}@defun statprof thunk [#:loop] [#:hz] [#:count-calls?] [#:full-stacks?] @anchor{statprof statprof}@defun statprof thunk [#:loop] [#:hz] [#:count-calls?] [#: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 The stack will be sampled @var{hz} times per second, and the thunk
itself will be called @var{loop} times. itself will be called @var{loop} times.
@ -236,7 +236,8 @@ retrieve the last-stored stacks.
@end defun @end defun
@anchor{statprof with-statprof}@defspec with-statprof args @anchor{statprof with-statprof}@defspec with-statprof args
Profiles the expressions in its body. Profile the expressions in the body, and return the body's return
value.
Keyword arguments: Keyword arguments:

20
module/statprof.scm
View file

@ -1,7 +1,7 @@
;;;; (statprof) -- a statistical profiler for Guile ;;;; (statprof) -- a statistical profiler for Guile
;;;; -*-scheme-*- ;;;; -*-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 <wingo at pobox dot com> ;;;; Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
;;;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org> ;;;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org>
;;;; ;;;;
@ -829,15 +829,16 @@ The return value is a list of nodes, each of which is of the type:
equal?)))) equal?))))
(define (call-thunk thunk) (define (call-thunk thunk)
(thunk) (call-with-values (lambda () (thunk))
(values)) (lambda results
(apply values results))))
(define* (statprof thunk #:key (loop 1) (hz 100) (count-calls? #f) (define* (statprof thunk #:key (loop 1) (hz 100) (count-calls? #f)
(port (current-output-port)) full-stacks?) (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 The stack will be sampled @var{hz} times per second, and the thunk
be called @var{loop} times. itself will be called @var{loop} times.
If @var{count-calls?} is true, all procedure calls will be recorded. This If @var{count-calls?} is true, all procedure calls will be recorded. This
operation is somewhat expensive." operation is somewhat expensive."
@ -853,15 +854,16 @@ operation is somewhat expensive."
(statprof-start state)) (statprof-start state))
(lambda () (lambda ()
(let lp ((i loop)) (let lp ((i loop))
(unless (zero? i) (unless (= i 1)
(call-thunk thunk) (call-thunk thunk)
(lp (1- i))))) (lp (1- i))))
(call-thunk thunk))
(lambda () (lambda ()
(statprof-stop state) (statprof-stop state)
(statprof-display port state)))))) (statprof-display port state))))))
(define-macro (with-statprof . args) (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: Keyword arguments:

13
test-suite/tests/statprof.test
View file

@ -45,6 +45,19 @@
(throw 'unresolved) (throw 'unresolved)
(apply throw args)))))) (apply throw args))))))
(pass-if-equal "return values"
'(42 77)
(call-with-values
(lambda ()
(with-output-to-port (%make-void-port "w")
(lambda ()
(with-statprof
(let loop ((i 10000))
(if (zero? i)
(values 42 77)
(loop (1- i))))))))
list))
(pass-if "statistical sample counts within expected range" (pass-if "statistical sample counts within expected range"
(when-implemented (when-implemented
;; test to see that if we call 3 identical functions equally, they ;; test to see that if we call 3 identical functions equally, they