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
 | 
			
		||||
 | 
			
		||||
{ 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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue