Merge branch 'master' of git://factorcode.org/git/factor

extra/builder/util/util.factor

@@ -41,14 +41,6 @@ DEFER: to-strings
 
 : host-name* ( -- name ) host-name "." split first ;
 
-! : datestamp ( -- string )
-!   now `{ ,[ dup timestamp-year   ]
-!          ,[ dup timestamp-month  ]
-!          ,[ dup timestamp-day    ]
-!          ,[ dup timestamp-hour   ]
-!          ,[     timestamp-minute ] }
-!   [ pad-00 ] map "-" join ;
-
 : datestamp ( -- string )
   now
     { year>> month>> day>> hour>> minute>> } <arr>

extra/ui/gadgets/buttons/buttons-tests.factor

@@ -16,7 +16,7 @@ TUPLE: foo-gadget ;
 T{ foo-gadget } <toolbar> "t" set
 
 [ 2 ] [ "t" get gadget-children length ] unit-test
-[ "Foo A" ] [ "t" get gadget-child gadget-child gadget-child label-string ] unit-test
+[ "Foo A" ] [ "t" get gadget-child gadget-child label-string ] unit-test
 
 [ ] [
     2 <model> {

extra/ui/x11/x11.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2005, 2007 Eduardo Cavazos and Slava Pestov
+! Copyright (C) 2005, 2008 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays ui ui.gadgets ui.gestures
+USING: accessors alien alien.c-types arrays ui ui.gadgets
-ui.backend ui.clipboards ui.gadgets.worlds ui.render assocs
+ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
-kernel math namespaces opengl sequences strings x11.xlib
+assocs kernel math namespaces opengl sequences strings x11.xlib
 x11.events x11.xim x11.glx x11.clipboard x11.constants
 x11.windows io.encodings.string io.encodings.ascii
 io.encodings.utf8 combinators debugger command-line qualified

extra/wordtimer/authors.txt

@@ -0,0 +1 @@
+Phil Dawes

extra/wordtimer/summary.txt

@@ -0,0 +1 @@
+Microsecond precision code timer/profiler.

extra/wordtimer/wordtimer-docs.factor

@@ -0,0 +1,41 @@
+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" } ;
+
+HELP: profile-vocab
+{ $values { "vocabspec" "string name of a vocab" }
+          { "quot" "a quotation to run" } }
+{ $description "Annotates the words in the vocab with timing code then runs the quotation. Finally resets the words and prints the timings information."
+} ;
+
+    
+ARTICLE: "wordtimer" "Word Timer"
+"The " { $vocab-link "wordtimer" } " vocabulary measures accumulated execution time for words. If you just want to profile the accumulated time taken by all words in a vocab you can use " { $vocab-link "profile-vocab" } ". If you need more fine grained control then do the following: First annotate individual words with the " { $link add-timer } " word or whole vocabularies with " { $link add-timers } ". Then 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 } ". Alternatively if you just want to time the contents of a vocabulary you can use profile-vocab." ;
+    
+ABOUT: "wordtimer"

extra/wordtimer/wordtimer-tests.factor

@@ -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

extra/wordtimer/wordtimer.factor

@@ -0,0 +1,81 @@
+USING: kernel sequences namespaces math assocs words arrays tools.annotations vocabs sorting prettyprint io micros math.statistics accessors ;
+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 -- )
+  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
+  reset-vocab
+  correct-for-timing-overhead
+  "total time:" write r> pprint
+  print-word-timings ;