ARTICLE: "tools.annotations" "Word annotations"
"The word annotation feature modifies word definitions to add debugging code. You can restore the old definition by calling " { $link reset } " on the word in question."
+$nl
+"Printing messages when a word is called or returns:"
{ $subsection watch }
+{ $subsection watch-vars }
+"Starting the walker when a word is called:"
{ $subsection breakpoint }
{ $subsection breakpoint-if }
+"Timing words:"
+{ $subsection reset-word-timing }
+{ $subsection add-timing }
+{ $subsection word-timing. }
"All of the above words are implemented using a single combinator which applies a quotation to a word definition to yield a new definition:"
{ $subsection annotate } ;
{ "seq" sequence } }
{ $description "Makes a sequence of the inputs to a word by counting the number of inputs in the stack effect and saving that many items from the datastack." } ;
+HELP: add-timing
+{ $values { "word" word } }
+{ $description "Adds timing code to a word, which records its total running time, including that of words it calls, on every invocation." }
+{ $see-also "tools.time" } ;
+
+HELP: reset-word-timing
+{ $description "Resets the word timing table." } ;
+
+HELP: word-timing.
+{ $description "Prints the word timing table." } ;
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel words parser io summary quotations
-sequences prettyprint continuations effects definitions
-compiler.units namespaces assocs tools.walker generic
-inspector fry ;
+USING: accessors kernel math sorting words parser io summary
+quotations sequences prettyprint continuations effects
+definitions compiler.units namespaces assocs tools.walker
+tools.time generic inspector fry ;
IN: tools.annotations
GENERIC: reset ( word -- )
f "unannotated-def" set-word-prop
] [ drop ] if ;
+ERROR: cannot-annotate-twice word ;
+
: annotate ( word quot -- )
over "unannotated-def" word-prop [
- "Cannot annotate a word twice" throw
+ over cannot-annotate-twice
] when
[
over dup def>> "unannotated-def" set-word-prop
: breakpoint-if ( word quot -- )
'[ [ _ [ [ break ] when ] ] dip 3append ] annotate-methods ;
+
+SYMBOL: word-timing
+
+H{ } clone word-timing set-global
+
+: reset-word-timing ( -- )
+ word-timing get clear-assoc ;
+
+: (add-timing) ( def word -- def' )
+ '[ _ benchmark _ word-timing get at+ ] ;
+
+: add-timing ( word -- )
+ dup '[ _ (add-timing) ] annotate ;
+
+: word-timing. ( -- )
+ word-timing get
+ >alist [ 1000000 /f ] assoc-map sort-values
+ simple-table. ;