fuel.xref: refactor of normalize-loc and group-xrefs per mrjbq7s comments
parent
2b1e080ccd
commit
45ef36e42c
|
@ -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
|
IN: fuel.xref.tests
|
||||||
|
|
||||||
{ t } [
|
{ t } [
|
||||||
|
@ -12,3 +14,20 @@ IN: fuel.xref.tests
|
||||||
{ { } } [
|
{ { } } [
|
||||||
"i-dont-exist!" callees-xref
|
"i-dont-exist!" callees-xref
|
||||||
] unit-test
|
] 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
|
||||||
|
|
|
@ -10,11 +10,10 @@ IN: fuel.xref
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: normalize-loc ( seq -- path line )
|
: normalize-loc ( pair/f -- path line )
|
||||||
[ dup length 0 > [ first absolute-path ] [ drop f ] if ]
|
[ first2 [ absolute-path ] dip ] [ f f ] if* ;
|
||||||
[ dup length 1 > [ second ] when ] bi ;
|
|
||||||
|
|
||||||
: get-loc ( object -- loc ) normalize-loc 2array ;
|
: get-loc ( pair/f -- loc ) normalize-loc 2array ;
|
||||||
|
|
||||||
: word>xref ( word -- xref )
|
: word>xref ( word -- xref )
|
||||||
[ name>> ] [ vocabulary>> ] [ where normalize-loc ] tri 4array ;
|
[ name>> ] [ vocabulary>> ] [ where normalize-loc ] tri 4array ;
|
||||||
|
@ -26,9 +25,9 @@ IN: fuel.xref
|
||||||
[ word? ] filter [ word>xref ] map ;
|
[ word? ] filter [ word>xref ] map ;
|
||||||
|
|
||||||
: group-xrefs ( xrefs -- xrefs' )
|
: group-xrefs ( xrefs -- xrefs' )
|
||||||
natural-sort [ second 1array ] collect-by
|
natural-sort [ second ] collect-by
|
||||||
! Put the path to the vocab in the key
|
! Change key from 'name' to { name path }
|
||||||
[ [ [ third ] map-find drop suffix ] keep ] assoc-map
|
[ [ [ third ] map-find drop 2array ] keep ] assoc-map
|
||||||
>alist natural-sort ;
|
>alist natural-sort ;
|
||||||
|
|
||||||
: filter-prefix ( seq prefix -- seq )
|
: filter-prefix ( seq prefix -- seq )
|
||||||
|
|
Loading…
Reference in New Issue