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

db4
Björn Lindqvist 2014-11-18 02:52:58 +01:00 committed by John Benediktsson
parent 2b1e080ccd
commit 45ef36e42c
2 changed files with 26 additions and 8 deletions

View File

@ -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

View File

@ -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 )