Wordtimer vocab for time-profiling words and vocabs
parent
838bdb9438
commit
fea1350790
|
@ -0,0 +1 @@
|
|||
Phil Dawes
|
|
@ -0,0 +1 @@
|
|||
Microsecond precision code timer/profiler.
|
|
@ -0,0 +1,34 @@
|
|||
USING: help.syntax help.markup kernel prettyprint sequences ;
|
||||
IN: wordtimer
|
||||
|
||||
HELP: reset-word-timer
|
||||
{ $description "resets the global wordtimes datastructure. Must be called before calling any word-timer annotated code"
|
||||
} ;
|
||||
|
||||
HELP: add-timer
|
||||
{ $values { "word" "a word" } }
|
||||
{ $description "annotates the word with timing code which stores timing information globally. You can then view the info with print-word-timings"
|
||||
} ;
|
||||
|
||||
HELP: add-timers
|
||||
{ $values { "vocab" "a string" } }
|
||||
{ $description "annotates all the words in the vocab with timer code. After profiling you can remove the annotations with reset-vocab"
|
||||
} ;
|
||||
|
||||
|
||||
HELP: reset-vocab
|
||||
{ $values { "vocab" "a string" } }
|
||||
{ $description "removes the annotations from all the words in the vocab"
|
||||
} ;
|
||||
|
||||
HELP: print-word-timings
|
||||
{ $description "Displays the timing information for each word-timer annotated word. Columns are: total time taken in microseconds, number of invocations, wordname"
|
||||
} ;
|
||||
|
||||
HELP: correct-for-timing-overhead
|
||||
{ $description "attempts to correct the timings to take into account the overhead of the timing function. This is pretty error-prone but can be handy when you're timing words that only take a handful of milliseconds but are called a lot" } ;
|
||||
|
||||
ARTICLE: "wordtimer" "Word Timer"
|
||||
"The " { $vocab-link "wordtimer" } " vocabulary measures accumulated execution time for words. You first annotate individual words with the " { $link add-timer } " word or whole vocabularies with " { $link add-timers } ". Then you reset the clock with " { $link reset-word-timer } " and execute your code. Finally you can view the timings with " { $link print-word-timings } ". If you have functions that are quick and called often you may want to " { $link correct-for-timing-overhead } ". To remove all the annotations in the vocab you can use " { $link reset-vocab } "." ;
|
||||
|
||||
ABOUT: "wordtimer"
|
|
@ -0,0 +1,10 @@
|
|||
USING: tools.test wordtimer math kernel tools.annotations prettyprint ;
|
||||
IN: wordtimer.tests
|
||||
|
||||
: testfn ( a b c d -- a+b c+d )
|
||||
+ [ + ] dip ;
|
||||
|
||||
[ 3 7 ]
|
||||
[ reset-word-timer
|
||||
\ testfn [ reset ] [ add-timer ] bi
|
||||
1 2 3 4 testfn ] unit-test
|
|
@ -0,0 +1,81 @@
|
|||
USING: kernel sequences namespaces math assocs words arrays tools.annotations vocabs sorting prettyprint io micros math.statistics ;
|
||||
IN: wordtimer
|
||||
|
||||
SYMBOL: *wordtimes*
|
||||
SYMBOL: *calling*
|
||||
|
||||
: reset-word-timer ( -- )
|
||||
H{ } clone *wordtimes* set-global
|
||||
H{ } clone *calling* set-global ;
|
||||
|
||||
: lookup-word-time ( wordname -- utime n )
|
||||
*wordtimes* get-global [ drop { 0 0 } ] cache first2 ;
|
||||
|
||||
: update-times ( utime current-utime current-numinvokes -- utime' invokes' )
|
||||
rot [ + ] curry [ 1+ ] bi* ;
|
||||
|
||||
: register-time ( utime word -- )
|
||||
word-name
|
||||
[ lookup-word-time update-times 2array ] keep *wordtimes* get-global set-at ;
|
||||
|
||||
: calling ( word -- )
|
||||
dup *calling* get-global set-at ; inline
|
||||
|
||||
: finished ( word -- )
|
||||
*calling* get-global delete-at ; inline
|
||||
|
||||
: called-recursively? ( word -- t/f )
|
||||
*calling* get-global at ; inline
|
||||
|
||||
: timed-call ( quot word -- )
|
||||
[ calling ] [ >r micro-time r> register-time ] [ finished ] tri ; inline
|
||||
|
||||
: time-unless-recursing ( quot word -- )
|
||||
dup called-recursively? not
|
||||
[ timed-call ] [ drop call ] if ; inline
|
||||
|
||||
: (add-timer) ( word quot -- quot' )
|
||||
[ swap time-unless-recursing ] 2curry ;
|
||||
|
||||
: add-timer ( word -- )
|
||||
dup [ (add-timer) ] annotate ;
|
||||
|
||||
: add-timers ( vocabspec -- )
|
||||
words [ add-timer ] each ;
|
||||
|
||||
: reset-vocab ( vocabspec -- )
|
||||
words [ reset ] each ;
|
||||
|
||||
: dummy-word ( -- ) ;
|
||||
|
||||
: time-dummy-word ( -- n )
|
||||
[ 100000 [ [ dummy-word ] micro-time , ] times ] { } make median ;
|
||||
|
||||
: subtract-overhead ( {oldtime,n} overhead -- {newtime,n} )
|
||||
[ first2 ] dip
|
||||
swap [ * - ] keep 2array ;
|
||||
|
||||
: change-global ( variable quot -- )
|
||||
global swap change-at ;
|
||||
|
||||
: (correct-for-timing-overhead) ( timingshash -- timingshash )
|
||||
time-dummy-word [ subtract-overhead ] curry assoc-map ;
|
||||
|
||||
: correct-for-timing-overhead ( -- )
|
||||
*wordtimes* [ (correct-for-timing-overhead) ] change-global ;
|
||||
|
||||
: print-word-timings ( -- )
|
||||
*wordtimes* get-global [ swap suffix ] { } assoc>map natural-sort reverse pprint ;
|
||||
|
||||
|
||||
: profile-vocab ( vocabspec quot -- )
|
||||
"annotating vocab..." print flush
|
||||
over [ reset-vocab ] [ add-timers ] bi
|
||||
reset-word-timer
|
||||
"executing quotation..." print flush
|
||||
[ call ] micro-time >r
|
||||
"resetting annotations..." print flush
|
||||
swap reset-vocab
|
||||
correct-for-timing-overhead
|
||||
"total time:" write r> pprint
|
||||
print-word-timings ;
|
Loading…
Reference in New Issue