From 77d45d654ab664282c6ea70e359d4525a9c8b7f0 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Tue, 8 Jul 2008 20:01:28 +0100 Subject: [PATCH 01/17] Wordtimer vocab for time-profiling words and vocabs --- extra/wordtimer/authors.txt | 1 + extra/wordtimer/summary.txt | 1 + extra/wordtimer/wordtimer-docs.factor | 34 +++++++++++ extra/wordtimer/wordtimer-tests.factor | 10 ++++ extra/wordtimer/wordtimer.factor | 81 ++++++++++++++++++++++++++ 5 files changed, 127 insertions(+) create mode 100644 extra/wordtimer/authors.txt create mode 100644 extra/wordtimer/summary.txt create mode 100644 extra/wordtimer/wordtimer-docs.factor create mode 100644 extra/wordtimer/wordtimer-tests.factor create mode 100644 extra/wordtimer/wordtimer.factor diff --git a/extra/wordtimer/authors.txt b/extra/wordtimer/authors.txt new file mode 100644 index 0000000000..0be42b2faa --- /dev/null +++ b/extra/wordtimer/authors.txt @@ -0,0 +1 @@ +Phil Dawes diff --git a/extra/wordtimer/summary.txt b/extra/wordtimer/summary.txt new file mode 100644 index 0000000000..efe591da27 --- /dev/null +++ b/extra/wordtimer/summary.txt @@ -0,0 +1 @@ +Microsecond precision code timer/profiler. diff --git a/extra/wordtimer/wordtimer-docs.factor b/extra/wordtimer/wordtimer-docs.factor new file mode 100644 index 0000000000..7d9de34252 --- /dev/null +++ b/extra/wordtimer/wordtimer-docs.factor @@ -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" diff --git a/extra/wordtimer/wordtimer-tests.factor b/extra/wordtimer/wordtimer-tests.factor new file mode 100644 index 0000000000..47287179ce --- /dev/null +++ b/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 \ No newline at end of file diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor new file mode 100644 index 0000000000..1ce5f13a81 --- /dev/null +++ b/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 ; +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 ; \ No newline at end of file From cf342b9a86df0f8e8f69bc5e2ee71472867282f0 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Tue, 8 Jul 2008 20:32:34 +0100 Subject: [PATCH 02/17] fixed to use new-style accessor for word-name --- extra/wordtimer/wordtimer.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor index 1ce5f13a81..e9ed0c8cf0 100644 --- a/extra/wordtimer/wordtimer.factor +++ b/extra/wordtimer/wordtimer.factor @@ -1,4 +1,4 @@ -USING: kernel sequences namespaces math assocs words arrays tools.annotations vocabs sorting prettyprint io micros math.statistics ; +USING: kernel sequences namespaces math assocs words arrays tools.annotations vocabs sorting prettyprint io micros math.statistics accessors ; IN: wordtimer SYMBOL: *wordtimes* @@ -15,7 +15,7 @@ SYMBOL: *calling* rot [ + ] curry [ 1+ ] bi* ; : register-time ( utime word -- ) - word-name + name>> [ lookup-word-time update-times 2array ] keep *wordtimes* get-global set-at ; : calling ( word -- ) From 7b5529a290da1fdf4756db8fca58b41dc2bd5abc Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Tue, 8 Jul 2008 20:50:49 +0100 Subject: [PATCH 03/17] Added doc for profile-vocab --- extra/wordtimer/wordtimer-docs.factor | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/extra/wordtimer/wordtimer-docs.factor b/extra/wordtimer/wordtimer-docs.factor index 7d9de34252..47b85bb007 100644 --- a/extra/wordtimer/wordtimer-docs.factor +++ b/extra/wordtimer/wordtimer-docs.factor @@ -27,8 +27,15 @@ HELP: print-word-timings 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. 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 } "." ; +"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" From de59a24380f747e116901695a6251a30083247e8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 10 Jul 2008 13:11:43 -0500 Subject: [PATCH 04/17] Rename incorrectly named file --- extra/backtrack/{description.txt => summary.txt} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename extra/backtrack/{description.txt => summary.txt} (100%) diff --git a/extra/backtrack/description.txt b/extra/backtrack/summary.txt similarity index 100% rename from extra/backtrack/description.txt rename to extra/backtrack/summary.txt From b93342298f2d043815df41dd404a27d34793e047 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Thu, 10 Jul 2008 23:59:43 +0200 Subject: [PATCH 05/17] Initial import of etags vocab, that generates an word index in Emacs etags format --- extra/ctags/etags/etags-tests.factor | 47 +++++++++++++++++++ extra/ctags/etags/etags.factor | 68 ++++++++++++++++++++++++++++ 2 files changed, 115 insertions(+) create mode 100644 extra/ctags/etags/etags-tests.factor create mode 100644 extra/ctags/etags/etags.factor diff --git a/extra/ctags/etags/etags-tests.factor b/extra/ctags/etags/etags-tests.factor new file mode 100644 index 0000000000..fbd9a65186 --- /dev/null +++ b/extra/ctags/etags/etags-tests.factor @@ -0,0 +1,47 @@ +USING: kernel ctags.etags tools.test io.backend sequences arrays prettyprint hashtables assocs ; +IN: ctags.etags.tests + + +[ H{ { "path" V{ if { "path" 1 } } } } ] +[ H{ } clone dup V{ if { "path" 1 } } "path" rot set-at ] unit-test + +[ { "path" V{ if { "path" 1 } } } ] +[ H{ } clone dup { "path" V{ if { "path" 1 } } } "path" rot set-at "path" swap at ] unit-test + + +[ V{ if { "path" 1 } } ] +[ "path" H{ { "path" V{ if { "path" 1 } } } } at ] unit-test + +[ "path" ] [ { if { "path" 1 } } ctag-path ] unit-test + +[ V{ } ] +[ "path" H{ } clone ctag-at ] unit-test + +[ V{ if { "path" 1 } } ] +[ "path" H{ { "path" V{ if { "path" 1 } } } } ctag-at ] unit-test + +[ { if 28 } ] +[ { if { "resource:core/kernel/kernel.factor" 28 } } ctag-value ] unit-test + +[ V{ } ] [ { if { "path" 1 } } H{ } clone ctag-hashvalue ] unit-test + +[ V{ if { "path" 1 } } ] +[ { if { "path" 1 } } + { { "path" V{ if { "path" 1 } } } } >hashtable + ctag-hashvalue +] unit-test + +[ H{ { "path" V{ { if 1 } } } } ] +[ { if { "path" 1 } } H{ } clone ctag-add ] unit-test + +[ H{ { "path" V{ { if 1 } } } } ] +[ { { if { "path" 1 } } } ctag-hash ] unit-test + +[ "if28,704" ] +[ "resource:core/kernel/kernel.factor" { if 28 } etag ] unit-test + +! [ V{ " " "resource:core/kernel/kernel.factor,22" "if28,704" "unless31,755" } ] +! [ { { "resource:core/kernel/kernel.factor" +! V{ { if 28 } +! { unless 31 } } } } etag-strings ] unit-test + diff --git a/extra/ctags/etags/etags.factor b/extra/ctags/etags/etags.factor new file mode 100644 index 0000000000..227f146307 --- /dev/null +++ b/extra/ctags/etags/etags.factor @@ -0,0 +1,68 @@ +! Copyright (C) 2008 Alfredo Beaumont +! See http://factorcode.org/license.txt for BSD license. + +! Emacs Etags generator +! Alfredo Beaumont +USING: kernel sequences sorting assocs words prettyprint ctags +io.encodings.ascii io.files math math.parser namespaces strings locals +shuffle io.backend memoize ; +IN: ctags.etags + +: ctag-path ( alist -- path ) + second first ; + +: ctag-at ( key hash -- vector ) + at [ V{ } clone ] unless* ; + +: ctag-hashvalue ( alist hash -- vector ) + [ ctag-path ] dip ctag-at ; + +: ctag-value ( ctag -- seq ) + dup [ first , second second , ] { } make ; + +: ctag-add ( ctag hash -- hash ) + [ ctag-hashvalue ] 2keep [ dup ctag-path [ ctag-value suffix ] dip ] dip [ set-at ] keep ; + +: ctag-hash ( seq -- hash ) + H{ } clone swap [ swap ctag-add ] each ; + +: line>bytes ( n seq -- bytes ) + nth length 1+ ; + +: lines>bytes ( n seq -- bytes ) + over zero? [ line>bytes ] [ [ [ 1 - ] dip lines>bytes ] 2keep line>bytes + ] if ; + +: file>bytes ( n path -- bytes ) + ascii file-lines lines>bytes ; + +SYMBOL: resource +: etag ( path seq -- str ) + [ + dup first ?word-name % + 1 HEX: 7f % + second dup number>string % + 1 CHAR: , % + 2 - swap file>bytes number>string % + ] "" make ; + +: etag-entry ( alist -- alist path ) + [ first ] keep swap ; + +: vector-length ( vector -- n ) + 0 [ length + ] reduce ; + +: etag-header ( n path -- str ) + [ + % + 1 CHAR: , % + number>string % + ] "" make ; + +: etag-strings ( alist -- seq ) + { } swap [ etag-entry resource [ second [ resource get swap etag ] map dup vector-length resource get normalize-path etag-header prefix 1 HEX: 0c prefix ] with-variable append ] each ; + +: etags-write ( alist path -- ) + [ etag-strings ] dip ascii set-file-lines ; + +: etags ( path -- ) + (ctags) sort-values ctag-hash >alist swap etags-write ; \ No newline at end of file From cec5291ed420e98ed8c344e10b91f5e44cef7287 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Fri, 11 Jul 2008 10:32:15 +0200 Subject: [PATCH 06/17] Style improvements --- extra/ctags/etags/etags.factor | 29 ++++++++++++++++++++++++----- 1 file changed, 24 insertions(+), 5 deletions(-) diff --git a/extra/ctags/etags/etags.factor b/extra/ctags/etags/etags.factor index 227f146307..75fe249538 100644 --- a/extra/ctags/etags/etags.factor +++ b/extra/ctags/etags/etags.factor @@ -21,7 +21,9 @@ IN: ctags.etags dup [ first , second second , ] { } make ; : ctag-add ( ctag hash -- hash ) - [ ctag-hashvalue ] 2keep [ dup ctag-path [ ctag-value suffix ] dip ] dip [ set-at ] keep ; + [ ctag-hashvalue ] 2keep [ + dup ctag-path [ ctag-value suffix ] dip + ] dip [ set-at ] keep ; : ctag-hash ( seq -- hash ) H{ } clone swap [ swap ctag-add ] each ; @@ -30,12 +32,16 @@ IN: ctags.etags nth length 1+ ; : lines>bytes ( n seq -- bytes ) - over zero? [ line>bytes ] [ [ [ 1 - ] dip lines>bytes ] 2keep line>bytes + ] if ; + over zero? [ + line>bytes ] [ + [ + [ 1- ] dip lines>bytes + ] 2keep line>bytes + + ] if ; : file>bytes ( n path -- bytes ) ascii file-lines lines>bytes ; -SYMBOL: resource : etag ( path seq -- str ) [ dup first ?word-name % @@ -51,15 +57,28 @@ SYMBOL: resource : vector-length ( vector -- n ) 0 [ length + ] reduce ; -: etag-header ( n path -- str ) +:
( n path -- str ) [ % 1 CHAR: , % number>string % ] "" make ; +: etag-header ( vec1 n resource -- vec2 ) + normalize-path
prefix + 1 HEX: 0c prefix ; + +SYMBOL: resource : etag-strings ( alist -- seq ) - { } swap [ etag-entry resource [ second [ resource get swap etag ] map dup vector-length resource get normalize-path etag-header prefix 1 HEX: 0c prefix ] with-variable append ] each ; + { } swap [ + etag-entry resource [ + second [ + resource get swap etag + ] map dup vector-length + resource get + ] with-variable + etag-header append + ] each ; : etags-write ( alist path -- ) [ etag-strings ] dip ascii set-file-lines ; From 4cb68c4a4df5a3150cfffaff9bb4324af2091780 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Fri, 11 Jul 2008 10:53:51 +0200 Subject: [PATCH 07/17] Open every source file just once. This make code work ~20x faster --- extra/ctags/etags/etags.factor | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/extra/ctags/etags/etags.factor b/extra/ctags/etags/etags.factor index 75fe249538..94928a263e 100644 --- a/extra/ctags/etags/etags.factor +++ b/extra/ctags/etags/etags.factor @@ -5,7 +5,7 @@ ! Alfredo Beaumont USING: kernel sequences sorting assocs words prettyprint ctags io.encodings.ascii io.files math math.parser namespaces strings locals -shuffle io.backend memoize ; +shuffle io.backend arrays ; IN: ctags.etags : ctag-path ( alist -- path ) @@ -39,20 +39,20 @@ IN: ctags.etags ] 2keep line>bytes + ] if ; -: file>bytes ( n path -- bytes ) - ascii file-lines lines>bytes ; +: file>lines ( resource -- lines ) + ascii file-lines ; -: etag ( path seq -- str ) +: etag ( lines seq -- str ) [ dup first ?word-name % 1 HEX: 7f % second dup number>string % 1 CHAR: , % - 2 - swap file>bytes number>string % + 2 - swap lines>bytes number>string % ] "" make ; -: etag-entry ( alist -- alist path ) - [ first ] keep swap ; +: etag-entry ( alist -- alist array ) + [ first ] keep swap [ file>lines ] keep 2array ; : vector-length ( vector -- n ) 0 [ length + ] reduce ; @@ -73,9 +73,9 @@ SYMBOL: resource { } swap [ etag-entry resource [ second [ - resource get swap etag + resource get first swap etag ] map dup vector-length - resource get + resource get second ] with-variable etag-header append ] each ; From 5a1ab1edaed1e93b9d6f436970772579c90c8b22 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Fri, 11 Jul 2008 16:16:01 +0200 Subject: [PATCH 08/17] Some improvements both in elegance and performance in ctags vocab --- extra/ctags/ctags.factor | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/extra/ctags/ctags.factor b/extra/ctags/ctags.factor index 23d9aeb90c..2ec1208df9 100644 --- a/extra/ctags/ctags.factor +++ b/extra/ctags/ctags.factor @@ -19,19 +19,17 @@ IN: ctags ] "" make ; : ctag-strings ( seq1 -- seq2 ) - { } swap [ ctag suffix ] each ; + [ ctag ] map ; : ctags-write ( seq path -- ) [ ctag-strings ] dip ascii set-file-lines ; : (ctags) ( -- seq ) - { } all-words [ + all-words [ dup where [ - 2array suffix - ] [ - drop - ] if* - ] each ; + 2array + ] when* + ] map [ sequence? ] filter ; : ctags ( path -- ) (ctags) sort-keys swap ctags-write ; \ No newline at end of file From dd759b1e1356d5de8ad28419a90fdd5d7f507997 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Sat, 12 Jul 2008 02:47:48 +0200 Subject: [PATCH 09/17] Fix testsuite --- extra/ctags/etags/etags-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ctags/etags/etags-tests.factor b/extra/ctags/etags/etags-tests.factor index fbd9a65186..53e8f99aaf 100644 --- a/extra/ctags/etags/etags-tests.factor +++ b/extra/ctags/etags/etags-tests.factor @@ -38,7 +38,7 @@ IN: ctags.etags.tests [ { { if { "path" 1 } } } ctag-hash ] unit-test [ "if28,704" ] -[ "resource:core/kernel/kernel.factor" { if 28 } etag ] unit-test +[ "resource:core/kernel/kernel.factor" file>lines { if 28 } etag ] unit-test ! [ V{ " " "resource:core/kernel/kernel.factor,22" "if28,704" "unless31,755" } ] ! [ { { "resource:core/kernel/kernel.factor" From ca781ea739dd7426d07d283a7331040f37424aa7 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Sat, 12 Jul 2008 02:48:09 +0200 Subject: [PATCH 10/17] Simplify using iteration --- extra/ctags/etags/etags.factor | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/extra/ctags/etags/etags.factor b/extra/ctags/etags/etags.factor index 94928a263e..f2d7d7e174 100644 --- a/extra/ctags/etags/etags.factor +++ b/extra/ctags/etags/etags.factor @@ -28,16 +28,8 @@ IN: ctags.etags : ctag-hash ( seq -- hash ) H{ } clone swap [ swap ctag-add ] each ; -: line>bytes ( n seq -- bytes ) - nth length 1+ ; - -: lines>bytes ( n seq -- bytes ) - over zero? [ - line>bytes ] [ - [ - [ 1- ] dip lines>bytes - ] 2keep line>bytes + - ] if ; +: lines>bytes ( seq n -- bytes ) + head 0 [ length 1+ + ] reduce ; : file>lines ( resource -- lines ) ascii file-lines ; @@ -48,7 +40,7 @@ IN: ctags.etags 1 HEX: 7f % second dup number>string % 1 CHAR: , % - 2 - swap lines>bytes number>string % + 1- lines>bytes number>string % ] "" make ; : etag-entry ( alist -- alist array ) From 6c5e73898ff314dd99b57d996d099054ec7cd73f Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Sun, 13 Jul 2008 17:05:41 +0200 Subject: [PATCH 11/17] Added some helper functions that may be used both in ctags and etags --- extra/ctags/ctags.factor | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/extra/ctags/ctags.factor b/extra/ctags/ctags.factor index 2ec1208df9..e8c5608375 100644 --- a/extra/ctags/ctags.factor +++ b/extra/ctags/ctags.factor @@ -9,13 +9,22 @@ io.encodings.ascii math.parser vocabs definitions namespaces words sorting ; IN: ctags +: ctag-word ( ctag -- word ) + first ; + +: ctag-path ( ctag -- path ) + second first ; + +: ctag-lineno ( ctag -- n ) + second second ; + : ctag ( seq -- str ) [ - dup first ?word-name % + dup ctag-word ?word-name % "\t" % - second dup first normalize-path % + dup ctag-path normalize-path % "\t" % - second number>string % + ctag-lineno number>string % ] "" make ; : ctag-strings ( seq1 -- seq2 ) From f05aabdf28d23aa7503c462a1885d0d5e7be8d57 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Sun, 13 Jul 2008 17:11:11 +0200 Subject: [PATCH 12/17] Rework etags vocab. Remove use of local variable shuffle words, use combinators instead. Rename some words and update testsuite accordingly --- extra/ctags/etags/etags-tests.factor | 16 +++++----- extra/ctags/etags/etags.factor | 48 +++++++++++++--------------- 2 files changed, 30 insertions(+), 34 deletions(-) diff --git a/extra/ctags/etags/etags-tests.factor b/extra/ctags/etags/etags-tests.factor index 53e8f99aaf..8d5fc0ee02 100644 --- a/extra/ctags/etags/etags-tests.factor +++ b/extra/ctags/etags/etags-tests.factor @@ -1,4 +1,4 @@ -USING: kernel ctags.etags tools.test io.backend sequences arrays prettyprint hashtables assocs ; +USING: kernel ctags ctags.etags tools.test io.backend sequences arrays prettyprint hashtables assocs ; IN: ctags.etags.tests @@ -15,27 +15,27 @@ IN: ctags.etags.tests [ "path" ] [ { if { "path" 1 } } ctag-path ] unit-test [ V{ } ] -[ "path" H{ } clone ctag-at ] unit-test +[ "path" H{ } clone etag-at ] unit-test [ V{ if { "path" 1 } } ] -[ "path" H{ { "path" V{ if { "path" 1 } } } } ctag-at ] unit-test +[ "path" H{ { "path" V{ if { "path" 1 } } } } etag-at ] unit-test [ { if 28 } ] -[ { if { "resource:core/kernel/kernel.factor" 28 } } ctag-value ] unit-test +[ { if { "resource:core/kernel/kernel.factor" 28 } } etag-pair ] unit-test -[ V{ } ] [ { if { "path" 1 } } H{ } clone ctag-hashvalue ] unit-test +[ V{ } ] [ { if { "path" 1 } } H{ } clone etag-vector ] unit-test [ V{ if { "path" 1 } } ] [ { if { "path" 1 } } { { "path" V{ if { "path" 1 } } } } >hashtable - ctag-hashvalue + etag-vector ] unit-test [ H{ { "path" V{ { if 1 } } } } ] -[ { if { "path" 1 } } H{ } clone ctag-add ] unit-test +[ { if { "path" 1 } } H{ } clone [ etag-add ] keep ] unit-test [ H{ { "path" V{ { if 1 } } } } ] -[ { { if { "path" 1 } } } ctag-hash ] unit-test +[ { { if { "path" 1 } } } etag-hash ] unit-test [ "if28,704" ] [ "resource:core/kernel/kernel.factor" file>lines { if 28 } etag ] unit-test diff --git a/extra/ctags/etags/etags.factor b/extra/ctags/etags/etags.factor index f2d7d7e174..b3ad879481 100644 --- a/extra/ctags/etags/etags.factor +++ b/extra/ctags/etags/etags.factor @@ -8,25 +8,25 @@ io.encodings.ascii io.files math math.parser namespaces strings locals shuffle io.backend arrays ; IN: ctags.etags -: ctag-path ( alist -- path ) - second first ; - -: ctag-at ( key hash -- vector ) +: etag-at ( key hash -- vector ) at [ V{ } clone ] unless* ; -: ctag-hashvalue ( alist hash -- vector ) - [ ctag-path ] dip ctag-at ; +: etag-vector ( alist hash -- vector ) + [ ctag-path ] dip etag-at ; -: ctag-value ( ctag -- seq ) - dup [ first , second second , ] { } make ; +: etag-pair ( ctag -- seq ) + dup [ + first , + second second , + ] { } make ; -: ctag-add ( ctag hash -- hash ) - [ ctag-hashvalue ] 2keep [ - dup ctag-path [ ctag-value suffix ] dip - ] dip [ set-at ] keep ; +: etag-add ( ctag hash -- ) + [ etag-vector ] 2keep [ + [ etag-pair ] [ ctag-path ] bi [ suffix ] dip + ] dip set-at ; -: ctag-hash ( seq -- hash ) - H{ } clone swap [ swap ctag-add ] each ; +: etag-hash ( seq -- hash ) + H{ } clone swap [ swap [ etag-add ] keep ] each ; : lines>bytes ( seq n -- bytes ) head 0 [ length 1+ + ] reduce ; @@ -43,10 +43,7 @@ IN: ctags.etags 1- lines>bytes number>string % ] "" make ; -: etag-entry ( alist -- alist array ) - [ first ] keep swap [ file>lines ] keep 2array ; - -: vector-length ( vector -- n ) +: etag-length ( vector -- n ) 0 [ length + ] reduce ; :
( n path -- str ) @@ -60,15 +57,14 @@ IN: ctags.etags normalize-path
prefix 1 HEX: 0c prefix ; -SYMBOL: resource : etag-strings ( alist -- seq ) { } swap [ - etag-entry resource [ - second [ - resource get first swap etag - ] map dup vector-length - resource get second - ] with-variable + [ + [ first file>lines ] + [ second ] bi + [ etag ] with map + dup etag-length + ] keep first etag-header append ] each ; @@ -76,4 +72,4 @@ SYMBOL: resource [ etag-strings ] dip ascii set-file-lines ; : etags ( path -- ) - (ctags) sort-values ctag-hash >alist swap etags-write ; \ No newline at end of file + [ (ctags) sort-values etag-hash >alist ] dip etags-write ; \ No newline at end of file From a10fc1e00e9298c4c0dffa542a54cd0959b4b3ed Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Sun, 13 Jul 2008 18:33:37 +0200 Subject: [PATCH 13/17] Added documentation and tests for new words --- extra/ctags/ctags-docs.factor | 44 ++++++++++++++++++++++++++++++++-- extra/ctags/ctags-tests.factor | 18 +++++++++++++- 2 files changed, 59 insertions(+), 3 deletions(-) diff --git a/extra/ctags/ctags-docs.factor b/extra/ctags/ctags-docs.factor index 22d811ad3f..32f3e05c6e 100644 --- a/extra/ctags/ctags-docs.factor +++ b/extra/ctags/ctags-docs.factor @@ -1,4 +1,4 @@ -USING: help.syntax help.markup kernel prettyprint sequences strings ; +USING: help.syntax help.markup kernel prettyprint sequences strings words math ; IN: ctags ARTICLE: "ctags" "Ctags file" @@ -6,7 +6,10 @@ ARTICLE: "ctags" "Ctags file" { $subsection ctags } { $subsection ctags-write } { $subsection ctag-strings } -{ $subsection ctag } ; +{ $subsection ctag } +{ $subsection ctag-word } +{ $subsection ctag-path } +{ $subsection ctag-lineno } ; HELP: ctags ( path -- ) { $values { "path" "a pathname string" } } @@ -57,4 +60,41 @@ HELP: ctag ( seq -- str ) } } ; +HELP: ctag-lineno ( ctag -- n ) +{ $values { "ctag" sequence } + { "n" integer } } +{ $description "Provides de line number " { $snippet "n" } " from a sequence in ctag format " } +{ $examples + { $example + "USING: kernel ctags prettyprint ;" + "{ if { \"resource:extra/unix/unix.factor\" 91 } } ctag-lineno ." + "91" + } +} ; + +HELP: ctag-path ( ctag -- path ) +{ $values { "ctag" sequence } + { "path" string } } +{ $description "Provides a path string " { $snippet "path" } " from a sequence in ctag format" } +{ $examples + { $example + "USING: kernel ctags prettyprint ;" + "{ if { \"resource:extra/unix/unix.factor\" 91 } } ctag-path ." + "\"resource:extra/unix/unix.factor\"" + } +} ; + +HELP: ctag-word ( ctag -- word ) +{ $values { "ctag" sequence } + { "word" word } } +{ $description "Provides the " { $snippet "word" } " from a sequence in ctag format " } +{ $examples + { $example + "USING: kernel ctags prettyprint ;" + "{ if { \"resource:extra/unix/unix.factor\" 91 } } ctag-word ." + "if" + } +} ; + + ABOUT: "ctags" \ No newline at end of file diff --git a/extra/ctags/ctags-tests.factor b/extra/ctags/ctags-tests.factor index 6c73b58ecb..700b897657 100644 --- a/extra/ctags/ctags-tests.factor +++ b/extra/ctags/ctags-tests.factor @@ -1,6 +1,21 @@ USING: kernel ctags tools.test io.backend sequences arrays prettyprint ; IN: ctags.tests +[ t ] [ + 91 + { { if { "resource:extra/unix/unix.factor" 91 } } } ctag-lineno = +] unit-test + +[ t ] [ + "resource:extra/unix/unix.factor" + { { if { "resource:extra/unix/unix.factor" 91 } } } ctag-path = +] unit-test + +[ t ] [ + if + { { if { "resource:extra/unix/unix.factor" 91 } } } ctag-word = +] unit-test + [ t ] [ "if\t" "resource:extra/unix/unix.factor" normalize-path "\t91" 3append { if { "resource:extra/unix/unix.factor" 91 } } ctag = @@ -9,4 +24,5 @@ IN: ctags.tests [ t ] [ "if\t" "resource:extra/unix/unix.factor" normalize-path "\t91" 3append 1array { { if { "resource:extra/unix/unix.factor" 91 } } } ctag-strings = -] unit-test \ No newline at end of file +] unit-test + From 222aa829bcdf6ad0520254574f395d787416cf3d Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Sun, 13 Jul 2008 18:35:44 +0200 Subject: [PATCH 14/17] Add authors and summary and documentation files and polish testsuite --- extra/ctags/etags/authors.txt | 1 + extra/ctags/etags/etags-docs.factor | 39 +++++++++++ extra/ctags/etags/etags-tests.factor | 101 +++++++++++++++++---------- extra/ctags/etags/etags.factor | 6 +- extra/ctags/etags/summary.txt | 1 + 5 files changed, 107 insertions(+), 41 deletions(-) create mode 100644 extra/ctags/etags/authors.txt create mode 100644 extra/ctags/etags/etags-docs.factor create mode 100644 extra/ctags/etags/summary.txt diff --git a/extra/ctags/etags/authors.txt b/extra/ctags/etags/authors.txt new file mode 100644 index 0000000000..158cf94ea0 --- /dev/null +++ b/extra/ctags/etags/authors.txt @@ -0,0 +1 @@ +Alfredo Beaumont diff --git a/extra/ctags/etags/etags-docs.factor b/extra/ctags/etags/etags-docs.factor new file mode 100644 index 0000000000..c38404740a --- /dev/null +++ b/extra/ctags/etags/etags-docs.factor @@ -0,0 +1,39 @@ +USING: help.syntax help.markup kernel prettyprint sequences strings words math ; +IN: ctags.etags + +ARTICLE: "etags" "Etags file" +{ $emphasis "Etags" } " generates a index file of every factor word in etags format as supported by emacs and other editors. More information can be found at " { $url "http://en.wikipedia.org/wiki/Ctags#Etags_2" } "." +{ $subsection etags } +{ $subsection etags-write } +{ $subsection etag-strings } +{ $subsection etag-header } + +HELP: etags ( path -- ) +{ $values { "path" string } } +{ $description "Generates a index file in etags format and stores in " { $snippet "path" } "." } +{ $examples + { $unchecked-example + "USING: ctags.etags ;" + "\"ETAGS\" etags" + "" + } +} ; + +HELP: etags-write ( alist path -- ) +{ $values { "alist" sequence } + { "path" string } } +{ $description "Stores a " { $snippet "alist" } " in " { $snippet "path" } ". " { $snippet "alist" } " must be an association list with etags format: its key must be a resource path and its value a vector, containing pairs of words and lines" } +{ $examples + { $unchecked-example + "USING: kernel etags.ctags ;" + "{ { \"resource:extra/unix/unix.factor\" V{ { dup2 91 } } } } \"ETAGS\" etags-write" + "" + } +} ; + +HELP: etag-strings ( alist -- seq ) +{ $values { "alist" sequence } + { "seq" sequence } } +{ $description "Converts an " { $snippet "alist" } " with etag format (a path as key and a vector containing word/line pairs) in a " { $snippet "seq" } " of strings." } + +ABOUT: "etags" \ No newline at end of file diff --git a/extra/ctags/etags/etags-tests.factor b/extra/ctags/etags/etags-tests.factor index 8d5fc0ee02..6ab97e0566 100644 --- a/extra/ctags/etags/etags-tests.factor +++ b/extra/ctags/etags/etags-tests.factor @@ -1,47 +1,72 @@ USING: kernel ctags ctags.etags tools.test io.backend sequences arrays prettyprint hashtables assocs ; IN: ctags.etags.tests - -[ H{ { "path" V{ if { "path" 1 } } } } ] -[ H{ } clone dup V{ if { "path" 1 } } "path" rot set-at ] unit-test - -[ { "path" V{ if { "path" 1 } } } ] -[ H{ } clone dup { "path" V{ if { "path" 1 } } } "path" rot set-at "path" swap at ] unit-test - - -[ V{ if { "path" 1 } } ] -[ "path" H{ { "path" V{ if { "path" 1 } } } } at ] unit-test - -[ "path" ] [ { if { "path" 1 } } ctag-path ] unit-test - -[ V{ } ] -[ "path" H{ } clone etag-at ] unit-test - -[ V{ if { "path" 1 } } ] -[ "path" H{ { "path" V{ if { "path" 1 } } } } etag-at ] unit-test - -[ { if 28 } ] -[ { if { "resource:core/kernel/kernel.factor" 28 } } etag-pair ] unit-test - -[ V{ } ] [ { if { "path" 1 } } H{ } clone etag-vector ] unit-test - -[ V{ if { "path" 1 } } ] -[ { if { "path" 1 } } - { { "path" V{ if { "path" 1 } } } } >hashtable - etag-vector +! etag-at +[ t ] +[ + V{ } + "path" H{ } clone etag-at = ] unit-test -[ H{ { "path" V{ { if 1 } } } } ] -[ { if { "path" 1 } } H{ } clone [ etag-add ] keep ] unit-test +[ t ] +[ + V{ if { "path" 1 } } + "path" H{ { "path" V{ if { "path" 1 } } } } etag-at = +] unit-test -[ H{ { "path" V{ { if 1 } } } } ] -[ { { if { "path" 1 } } } etag-hash ] unit-test +! etag-vector +[ t ] +[ + V{ } + { if { "path" 1 } } H{ } clone etag-vector = +] unit-test -[ "if28,704" ] -[ "resource:core/kernel/kernel.factor" file>lines { if 28 } etag ] unit-test +[ t ] +[ + V{ if { "path" 1 } } + { if { "path" 1 } } + { { "path" V{ if { "path" 1 } } } } >hashtable + etag-vector = +] unit-test -! [ V{ " " "resource:core/kernel/kernel.factor,22" "if28,704" "unless31,755" } ] -! [ { { "resource:core/kernel/kernel.factor" -! V{ { if 28 } -! { unless 31 } } } } etag-strings ] unit-test +! etag-pair +[ t ] +[ + { if 28 } + { if { "resource:core/kernel/kernel.factor" 28 } } etag-pair = +] unit-test +! etag-add +[ t ] +[ + H{ { "path" V{ { if 1 } } } } + { if { "path" 1 } } H{ } clone [ etag-add ] keep = +] unit-test + +! etag-hash +[ t ] +[ + H{ { "path" V{ { if 1 } } } } + { { if { "path" 1 } } } etag-hash = +] unit-test + +! line-bytes (note that for each line implicit \n is counted) +[ t ] +[ + 17 + { "1234567890" "12345" } 2 lines>bytes = +] unit-test + +! etag +[ t ] +[ + "if2,11" + { "1234567890" "12345" } { if 2 } etag = +] unit-test + +! etag-length +[ t ] +[ + 14 + V{ "if2,11" "if2,11" } etag-length = +] unit-test diff --git a/extra/ctags/etags/etags.factor b/extra/ctags/etags/etags.factor index b3ad879481..8cc8c284b1 100644 --- a/extra/ctags/etags/etags.factor +++ b/extra/ctags/etags/etags.factor @@ -31,7 +31,7 @@ IN: ctags.etags : lines>bytes ( seq n -- bytes ) head 0 [ length 1+ + ] reduce ; -: file>lines ( resource -- lines ) +: file>lines ( path -- lines ) ascii file-lines ; : etag ( lines seq -- str ) @@ -46,7 +46,7 @@ IN: ctags.etags : etag-length ( vector -- n ) 0 [ length + ] reduce ; -:
( n path -- str ) +: (etag-header) ( n path -- str ) [ % 1 CHAR: , % @@ -54,7 +54,7 @@ IN: ctags.etags ] "" make ; : etag-header ( vec1 n resource -- vec2 ) - normalize-path
prefix + normalize-path (etag-header) prefix 1 HEX: 0c prefix ; : etag-strings ( alist -- seq ) diff --git a/extra/ctags/etags/summary.txt b/extra/ctags/etags/summary.txt new file mode 100644 index 0000000000..4766e20a87 --- /dev/null +++ b/extra/ctags/etags/summary.txt @@ -0,0 +1 @@ +Etags generator From fa7ab148581a666ab99d63a6a3ca8c85dbb04496 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Sun, 13 Jul 2008 18:44:45 +0200 Subject: [PATCH 15/17] Remove wordtimer vocab, shouldn't be on this branch --- extra/wordtimer/authors.txt | 1 - extra/wordtimer/summary.txt | 1 - extra/wordtimer/wordtimer-docs.factor | 41 ------------- extra/wordtimer/wordtimer-tests.factor | 10 ---- extra/wordtimer/wordtimer.factor | 81 -------------------------- 5 files changed, 134 deletions(-) delete mode 100644 extra/wordtimer/authors.txt delete mode 100644 extra/wordtimer/summary.txt delete mode 100644 extra/wordtimer/wordtimer-docs.factor delete mode 100644 extra/wordtimer/wordtimer-tests.factor delete mode 100644 extra/wordtimer/wordtimer.factor diff --git a/extra/wordtimer/authors.txt b/extra/wordtimer/authors.txt deleted file mode 100644 index 0be42b2faa..0000000000 --- a/extra/wordtimer/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Phil Dawes diff --git a/extra/wordtimer/summary.txt b/extra/wordtimer/summary.txt deleted file mode 100644 index efe591da27..0000000000 --- a/extra/wordtimer/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Microsecond precision code timer/profiler. diff --git a/extra/wordtimer/wordtimer-docs.factor b/extra/wordtimer/wordtimer-docs.factor deleted file mode 100644 index 47b85bb007..0000000000 --- a/extra/wordtimer/wordtimer-docs.factor +++ /dev/null @@ -1,41 +0,0 @@ -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" diff --git a/extra/wordtimer/wordtimer-tests.factor b/extra/wordtimer/wordtimer-tests.factor deleted file mode 100644 index 47287179ce..0000000000 --- a/extra/wordtimer/wordtimer-tests.factor +++ /dev/null @@ -1,10 +0,0 @@ -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 \ No newline at end of file diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor deleted file mode 100644 index 5da17e28d5..0000000000 --- a/extra/wordtimer/wordtimer.factor +++ /dev/null @@ -1,81 +0,0 @@ -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 ; \ No newline at end of file From 67216b034223fe5c47b558d211cde12ae100f501 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Sun, 13 Jul 2008 18:46:49 +0200 Subject: [PATCH 16/17] Revert "Remove wordtimer vocab, shouldn't be on this branch" This reverts commit fa7ab148581a666ab99d63a6a3ca8c85dbb04496. --- extra/wordtimer/authors.txt | 1 + extra/wordtimer/summary.txt | 1 + extra/wordtimer/wordtimer-docs.factor | 41 +++++++++++++ extra/wordtimer/wordtimer-tests.factor | 10 ++++ extra/wordtimer/wordtimer.factor | 81 ++++++++++++++++++++++++++ 5 files changed, 134 insertions(+) create mode 100644 extra/wordtimer/authors.txt create mode 100644 extra/wordtimer/summary.txt create mode 100644 extra/wordtimer/wordtimer-docs.factor create mode 100644 extra/wordtimer/wordtimer-tests.factor create mode 100644 extra/wordtimer/wordtimer.factor diff --git a/extra/wordtimer/authors.txt b/extra/wordtimer/authors.txt new file mode 100644 index 0000000000..0be42b2faa --- /dev/null +++ b/extra/wordtimer/authors.txt @@ -0,0 +1 @@ +Phil Dawes diff --git a/extra/wordtimer/summary.txt b/extra/wordtimer/summary.txt new file mode 100644 index 0000000000..efe591da27 --- /dev/null +++ b/extra/wordtimer/summary.txt @@ -0,0 +1 @@ +Microsecond precision code timer/profiler. diff --git a/extra/wordtimer/wordtimer-docs.factor b/extra/wordtimer/wordtimer-docs.factor new file mode 100644 index 0000000000..47b85bb007 --- /dev/null +++ b/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" diff --git a/extra/wordtimer/wordtimer-tests.factor b/extra/wordtimer/wordtimer-tests.factor new file mode 100644 index 0000000000..47287179ce --- /dev/null +++ b/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 \ No newline at end of file diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor new file mode 100644 index 0000000000..5da17e28d5 --- /dev/null +++ b/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 ; \ No newline at end of file From fafdb39627b31800e032b1fc6e937aae14a65950 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Sun, 13 Jul 2008 19:11:46 +0200 Subject: [PATCH 17/17] Documentation code fixed --- extra/ctags/etags/etags-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/ctags/etags/etags-docs.factor b/extra/ctags/etags/etags-docs.factor index c38404740a..5bd4e10b54 100644 --- a/extra/ctags/etags/etags-docs.factor +++ b/extra/ctags/etags/etags-docs.factor @@ -34,6 +34,6 @@ HELP: etags-write ( alist path -- ) HELP: etag-strings ( alist -- seq ) { $values { "alist" sequence } { "seq" sequence } } -{ $description "Converts an " { $snippet "alist" } " with etag format (a path as key and a vector containing word/line pairs) in a " { $snippet "seq" } " of strings." } +{ $description "Converts an " { $snippet "alist" } " with etag format (a path as key and a vector containing word/line pairs) in a " { $snippet "seq" } " of strings." } ; -ABOUT: "etags" \ No newline at end of file +ABOUT: "etags" ; \ No newline at end of file