tools.dispatch: split off method dispatch statistics from tools.time

basis/tools/dispatch/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/tools/dispatch/dispatch-docs.factor

@@ -0,0 +1,8 @@
+IN: tools.dispatch
+USING: help.markup help.syntax vm quotations ;
+
+HELP: last-dispatch-stats
+{ $var-description "A " { $link dispatch-statistics } " instance, set by " { $link collect-dispatch-stats } "." } ;
+
+HELP: dispatch-stats.
+{ $description "Prints method dispatch statistics from the last call to " { $link collect-dispatch-stats } "." } ;

basis/tools/dispatch/dispatch.factor

@@ -0,0 +1,24 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel namespaces prettyprint classes.struct
+vm tools.dispatch.private ;
+IN: tools.dispatch
+
+SYMBOL: last-dispatch-stats
+
+: dispatch-stats. ( -- )
+    last-dispatch-stats get {
+        { "Megamorphic hits" [ megamorphic-cache-hits>> ] }
+        { "Megamorphic misses" [ megamorphic-cache-misses>> ] }
+        { "Cold to monomorphic" [ cold-call-to-ic-transitions>> ] }
+        { "Mono to polymorphic" [ ic-to-pic-transitions>> ] }
+        { "Poly to megamorphic" [ pic-to-mega-transitions>> ] }
+        { "Tag check count" [ pic-tag-count>> ] }
+        { "Tuple check count" [ pic-tuple-count>> ] }
+    } object-table. ;
+
+: collect-dispatch-stats ( quot -- )
+    reset-dispatch-stats
+    call
+    dispatch-stats dispatch-statistics memory>struct
+    last-dispatch-stats set ; inline