Rainbow now includes a built-in profiler. It's easy to invoke: (profiler expr)
Example: (profiler (repeat 5 (tokens (rand-string 1000) #\0)))
gives the output below. The function-nesting in the output follows the lexical nesting of measured functions, so it's not exactly the call tree. The profiler measures "own-time", the time spent executing instructions in that function alone, and "total-time", which is the sum of own-times for a subtree.In the example output below, some functions are marked as having zero invocations; these are (do ...) forms which rainbow inlines to the containing function. Rainbow attempts to unmacex the code so it's a little more recognisable - it can handle do, let, with, aif and afn so far, as well as [foo _ bar] style functions. Features I'd like to add: * waiting-time: the time a function spends on the stack waiting for callees to return * call-tree: break down timings for f by callers and callees of f * profile multiple threads - for now it only profiles its argument, in a single thread * nested closure pruning: there is little added value in showing times for inner closures generated by (let ...) and similar macros; there probably is value however in seeing times for (afn ...) and for closures that are passed as arguments to other functions. * a little more unmacexing, expanded code is still quite unreadable If you want to use this to improve a program you normally run over scheme, caveat emptor : the invocation counts should be accurate, but the timings are likely to be misleading due to variation in relative inefficiencies. It's still very alpha and not hugely tested, but it has already given me information that I've used to speed up rainbow and the parser. All comments, suggestions, bug-reports welcome. Invocation profiles
=================
total-time own-time invocations fn
150.123ms 0.013ms 5 rand-string
150.11ms 0.014ms 5 (fn (c) (with (nc 62 s (newstring n) i 0) (let str (infile "/dev/urandom") (protect (fn nil (do ((let gs48 nil (assign gs48 (fn (gs49) (if gs49 (do (let x (readb str) (if (no (> x 247)) (do (do (ato
150.096ms 0.057ms 5 (fn (nc s i) (let str (infile "/dev/urandom") (protect (fn nil (do ((let gs48 nil (assign gs48 (fn (gs49) (if gs49 (do (let x (readb str) (if (no (> x 247)) (do (do (atomic-invoke (fn nil (with (g
150.039ms 0.024ms 5 (fn (str) (protect (fn nil (do ((let gs48 nil (assign gs48 (fn (gs49) (if gs49 (do (let x (readb str) (if (no (> x 247)) (do (do (atomic-invoke (fn nil (with (gs50 s gs52 i gs53 (c (mod x nc)))
150.015ms 0.32ms 0 (fn nil (do ((let gs48 nil (assign gs48 (fn (gs49) (if gs49 (do (let x (readb str) (if (no (> x 247)) (do (do (atomic-invoke (fn nil (with (gs50 s gs52 i gs53 (c (mod x nc))) (let gs51 gs53 (s
149.695ms 0.0ms 0 (fn nil ((let gs48 nil (assign gs48 (fn (gs49) (if gs49 (do (let x (readb str) (if (no (> x 247)) (do (do (atomic-invoke (fn nil (with (gs50 s gs52 i gs53 (c (mod x nc))) (let gs51 gs53 (sre
149.695ms 0.022ms 5 (fn (gs48) (assign gs48 (fn (gs49) (if gs49 (do (let x (readb str) (if (no (> x 247)) (do (do (atomic-invoke (fn nil (with (gs50 s gs52 i gs53 (c (mod x nc))) (let gs51 gs53 (sref gs50 gs5
149.673ms 85.466ms 5157 (fn (gs49) (if gs49 (do (let x (readb str) (if (no (> x 247)) (do (do (atomic-invoke (fn nil (with (gs50 s gs52 i gs53 (c (mod x nc))) (let gs51 gs53 (sref gs50 gs51 gs52)))))) (do (assi
64.207ms 0.0ms 0 (fn nil (let x (readb str) (if (no (> x 247)) (do (do (atomic-invoke (fn nil (with (gs50 s gs52 i gs53 (c (mod x nc))) (let gs51 gs53 (sref gs50 gs51 gs52)))))) (do (assign i (+ i 1)))
64.207ms 25.723ms 5152 (fn (x) (if (no (> x 247)) (do (do (atomic-invoke (fn nil (with (gs50 s gs52 i gs53 (c (mod x nc))) (let gs51 gs53 (sref gs50 gs51 gs52)))))) (do (assign i (+ i 1)))) nil))
38.484ms 0.0ms 0 (fn nil (do (atomic-invoke (fn nil (with (gs50 s gs52 i gs53 (c (mod x nc))) (let gs51 gs53 (sref gs50 gs51 gs52)))))) (do (assign i (+ i 1))))
38.484ms 0.0ms 0 (fn nil (atomic-invoke (fn nil (with (gs50 s gs52 i gs53 (c (mod x nc))) (let gs51 gs53 (sref gs50 gs51 gs52))))))
38.484ms 10.491ms 0 (fn nil (with (gs50 s gs52 i gs53 (c (mod x nc))) (let gs51 gs53 (sref gs50 gs51 gs52))))
27.993ms 18.986ms 5000 (fn (gs50 gs52 gs53) (let gs51 gs53 (sref gs50 gs51 gs52)))
9.007ms 9.007ms 5000 (fn (gs51) (sref gs50 gs51 gs52))
56.971ms 56.971ms 5152 [builtin:readb]
53.291ms 53.291ms 5000 [builtin:sref]
37.054ms 37.054ms 5000 [builtin:atomic-invoke]
25.376ms 25.376ms 5006 [builtin:+]
20.878ms 0.069ms 5 tokens
20.809ms 0.013ms 5 (fn (test) (let rec (afn (cs toks tok) (if (no cs) (consif tok toks) (test (car cs)) (self (cdr cs) (consif tok toks) nil) (self (cdr cs) toks (cons (car cs) tok)))) (rev (map [coerce _ 'string] (ma
20.712ms 0.014ms 5 (fn (self) (assign self (fn (cs toks tok) (if (no cs) (consif tok toks) (test (car cs)) (self (cdr cs) (consif tok toks) nil) (self (cdr cs) toks (cons (car cs) tok))))))
20.698ms 20.698ms 5005 (fn (cs toks tok) (if (no cs) (consif tok toks) (test (car cs)) (self (cdr cs) (consif tok toks) nil) (self (cdr cs) toks (cons (car cs) tok))))
0.084ms 0.029ms 5 (fn (rec) (rev (map [coerce _ 'string] (map rev (rec (coerce s 'cons) nil nil)))))
0.055ms 0.055ms 87 [coerce _ 'string]
18.908ms 18.908ms 15273 no
18.08ms 18.08ms 5000 ref:string
17.854ms 17.854ms 5163 [builtin:<]
16.819ms 16.819ms 5035 [builtin:is]
15.506ms 15.506ms 10198 [builtin:cdr]
15.186ms 0.141ms 92 rev
15.045ms 0.371ms 92 (fn (self) (assign self (fn (xs acc) (if (no xs) acc (self (cdr xs) (cons (car xs) acc))))))
14.674ms 14.674ms 5096 (fn (xs acc) (if (no xs) acc (self (cdr xs) (cons (car xs) acc))))
11.927ms 11.927ms 5000 [builtin:mod]
10.082ms 10.082ms 5152 [builtin:>]
10.009ms 10.009ms 15105 [builtin:car]
9.555ms 9.555ms 10182 [builtin:cons]
9.057ms 9.057ms 5 [builtin:infile]
5.274ms 0.049ms 15 testify
5.225ms 5.225ms 5000 [is _ x]
3.433ms 3.433ms 92 [builtin:coerce]
| 
