From 77d45d654ab664282c6ea70e359d4525a9c8b7f0 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Tue, 8 Jul 2008 20:01:28 +0100
Subject: [PATCH 01/14] 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 <phil@phildawes.net>
Date: Tue, 8 Jul 2008 20:32:34 +0100
Subject: [PATCH 02/14] 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 <phil@phildawes.net>
Date: Tue, 8 Jul 2008 20:50:49 +0100
Subject: [PATCH 03/14] 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 <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 10 Jul 2008 13:11:43 -0500
Subject: [PATCH 04/14] 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 <alfredo.beaumont@gmail.com>
Date: Thu, 10 Jul 2008 23:59:43 +0200
Subject: [PATCH 05/14] 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 <alfredo.beaumont@gmail.com>
+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 <string> %
+ second dup number>string %
+ 1 CHAR: , <string> %
+ 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: , <string> %
+ 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 <string> 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 <alfredo.beaumont@gmail.com>
Date: Fri, 11 Jul 2008 10:32:15 +0200
Subject: [PATCH 06/14] 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 )
+: <header> ( n path -- str )
[
%
1 CHAR: , <string> %
number>string %
] "" make ;
+: etag-header ( vec1 n resource -- vec2 )
+ normalize-path <header> prefix
+ 1 HEX: 0c <string> 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 <string> 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 <alfredo.beaumont@gmail.com>
Date: Fri, 11 Jul 2008 10:53:51 +0200
Subject: [PATCH 07/14] 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 <alfredo.beaumont@gmail.com>
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 <string> %
second dup number>string %
1 CHAR: , <string> %
- 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 <alfredo.beaumont@gmail.com>
Date: Fri, 11 Jul 2008 16:16:01 +0200
Subject: [PATCH 08/14] 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 <alfredo.beaumont@gmail.com>
Date: Sat, 12 Jul 2008 02:47:48 +0200
Subject: [PATCH 09/14] 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 <alfredo.beaumont@gmail.com>
Date: Sat, 12 Jul 2008 02:48:09 +0200
Subject: [PATCH 10/14] 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 <string> %
second dup number>string %
1 CHAR: , <string> %
- 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 <alfredo.beaumont@gmail.com>
Date: Sun, 13 Jul 2008 17:05:41 +0200
Subject: [PATCH 11/14] 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 <alfredo.beaumont@gmail.com>
Date: Sun, 13 Jul 2008 17:11:11 +0200
Subject: [PATCH 12/14] 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 ;
: <header> ( n path -- str )
@@ -60,15 +57,14 @@ IN: ctags.etags
normalize-path <header> prefix
1 HEX: 0c <string> 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 <alfredo.beaumont@gmail.com>
Date: Sun, 13 Jul 2008 18:33:37 +0200
Subject: [PATCH 13/14] 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 <alfredo.beaumont@gmail.com>
Date: Sun, 13 Jul 2008 18:35:44 +0200
Subject: [PATCH 14/14] 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 ;
-: <header> ( n path -- str )
+: (etag-header) ( n path -- str )
[
%
1 CHAR: , <string> %
@@ -54,7 +54,7 @@ IN: ctags.etags
] "" make ;
: etag-header ( vec1 n resource -- vec2 )
- normalize-path <header> prefix
+ normalize-path (etag-header) prefix
1 HEX: 0c <string> 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