fuel.xref: refactor of normalize-loc and group-xrefs per mrjbq7s comments

diff --git a/extra/fuel/xref/xref-tests.factor b/extra/fuel/xref/xref-tests.factor
index a30581ae0e65ab8092d0b82d91ca8c1198d107f9..1beea0c744b71ff9866eb140bdcd90c98783eab6 100644 (file)
--- a/extra/fuel/xref/xref-tests.factor
+++ b/extra/fuel/xref/xref-tests.factor
@@ -1,4 +1,6 @@
-USING: fuel.xref kernel sequences tools.test ;
+USING: arrays definitions fuel.xref fuel.xref.private io.pathnames kernel math
+sequences sets tools.test ;
+QUALIFIED: tools.crossref
 IN: fuel.xref.tests
 
 { t } [
@@ -12,3 +14,20 @@ IN: fuel.xref.tests
 { { } } [
     "i-dont-exist!" callees-xref
 ] unit-test
+
+: random-word ( -- )
+    3 dup 2drop
+    3 1array drop ;
+
+{ 2 } [
+    \ random-word tools.crossref:uses format-xrefs group-xrefs
+    members length
+] unit-test
+
+{ f f } [
+    \ drop where normalize-loc
+] unit-test
+
+{ t t } [
+    \ where where normalize-loc [ absolute-path? ] [ integer? ] bi*
+] unit-test

diff --git a/extra/fuel/xref/xref.factor b/extra/fuel/xref/xref.factor
index 5ca5911cf4c3545952d0ce2a62b84569ea0d83d8..1111a3eafddf5810433c475ca69db0a17e87ac33 100644 (file)
--- a/extra/fuel/xref/xref.factor
+++ b/extra/fuel/xref/xref.factor
@@ -10,11 +10,10 @@ IN: fuel.xref
 
 <PRIVATE
 
-: normalize-loc ( seq -- path line )
-    [ dup length 0 > [ first absolute-path ] [ drop f ] if ]
-    [ dup length 1 > [ second ] when ] bi ;
+: normalize-loc ( pair/f -- path line )
+    [ first2 [ absolute-path ] dip ] [ f f ] if* ;
 
-: get-loc ( object -- loc ) normalize-loc 2array ;
+: get-loc ( pair/f -- loc ) normalize-loc 2array ;
 
 : word>xref ( word -- xref )
     [ name>> ] [ vocabulary>> ] [ where normalize-loc ] tri 4array ;
@@ -26,9 +25,9 @@ IN: fuel.xref
     [ word? ] filter [ word>xref ] map ;
 
 : group-xrefs ( xrefs -- xrefs' )
-    natural-sort [ second 1array ] collect-by
-    ! Put the path to the vocab in the key
-    [ [ [ third ] map-find drop suffix ] keep ] assoc-map
+    natural-sort [ second ] collect-by
+    ! Change key from 'name' to { name path }
+    [ [ [ third ] map-find drop 2array ] keep ] assoc-map
     >alist natural-sort ;
 
 : filter-prefix ( seq prefix -- seq )