Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / extra / ctags / etags / etags.factor

diff --git a/extra/ctags/etags/etags.factor b/extra/ctags/etags/etags.factor
index 94928a263eb8d1a8c83a51b2e321e275c2a6a98b..615b38daf6d94ea1ca57f4349405707432e2f141 100644 (file)
--- a/extra/ctags/etags/etags.factor
+++ b/extra/ctags/etags/etags.factor
@@ -4,60 +4,49 @@
 ! 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 arrays ;
+io.encodings.ascii io.files math math.parser namespaces make
+strings shuffle io.backend arrays present ;
 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 ;
-
-: line>bytes ( n seq -- bytes )
-  nth length 1+ ;
+: etag-hash ( seq -- hash )
+  H{ } clone swap [ swap [ etag-add ] keep ] each ;
 
-: 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 )
+: file>lines ( path -- lines )
   ascii file-lines ;
 
 : etag ( lines seq -- str )
   [
-    dup first ?word-name %
+    dup first present %
     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 )
-  [ first ] keep swap [ file>lines ] keep 2array ;
-
-: vector-length ( vector -- n )
+: etag-length ( vector -- n )
   0 [ length + ] reduce ;
 
-: <header> ( n path -- str )
+: (etag-header) ( n path -- str )
   [
     %
     1 CHAR: , <string> %
@@ -65,18 +54,17 @@ IN: ctags.etags
   ] "" make ;
 
 : etag-header ( vec1 n resource -- vec2 )
-  normalize-path <header> prefix
+  normalize-path (etag-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 ;
 
@@ -84,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 ;