steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

tools.completion: more <PRIVATE> words.

db4
John Benediktsson 2012-09-25 09:45:44 -07:00
parent 6303ed9106
commit bb580f2ef7
1 changed files with 14 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/tools/completion/completion.factor
View File

@ -15,8 +15,6 @@ IN: tools.completion
rot [ ch>lower ] [ ch>upper ] bi rot [ ch>lower ] [ ch>upper ] bi
'[ dup _ eq? [ drop t ] [ _ eq? ] if ] find-from drop ; '[ dup _ eq? [ drop t ] [ _ eq? ] if ] find-from drop ;
PRIVATE>
:: (fuzzy) ( accum i full ch -- accum i ? ) :: (fuzzy) ( accum i full ch -- accum i ? )
ch i full smart-index-from [ ch i full smart-index-from [
[ accum push ] [ accum push ]
@ -25,10 +23,14 @@ PRIVATE>
f -1 f f -1 f
] if* ; ] if* ;
PRIVATE>
: fuzzy ( full short -- indices ) : fuzzy ( full short -- indices )
dup [ length <vector> 0 ] curry 2dip dup [ length <vector> 0 ] curry 2dip
[ (fuzzy) ] with all? 2drop ; [ (fuzzy) ] with all? 2drop ;
<PRIVATE
: (runs) ( runs n seq -- runs n ) : (runs) ( runs n seq -- runs n )
[ [
[ [
@ -38,9 +40,13 @@ PRIVATE>
] keep pick last push ] keep pick last push
] each ; ] each ;
PRIVATE>
: runs ( seq -- newseq ) : runs ( seq -- newseq )
[ V{ } clone 1vector ] dip [ first ] keep (runs) drop ; [ V{ } clone 1vector ] dip [ first ] keep (runs) drop ;
<PRIVATE
: score-1 ( i full -- n ) : score-1 ( i full -- n )
{ {
{ [ over zero? ] [ 2drop 10 ] } { [ over zero? ] [ 2drop 10 ] }
@ -50,6 +56,8 @@ PRIVATE>
[ 2drop 1 ] [ 2drop 1 ]
} cond ; } cond ;
PRIVATE>
: score ( full fuzzy -- n ) : score ( full fuzzy -- n )
dup [ dup [
[ [ length ] bi@ - 15 swap [-] 3 /f ] 2keep [ [ length ] bi@ - 15 swap [-] 3 /f ] 2keep
@ -72,12 +80,16 @@ PRIVATE>
[ <reversed> ] bi@ [ <reversed> ] bi@
dupd fuzzy score max ; dupd fuzzy score max ;
<PRIVATE
: completion ( short candidate -- result ) : completion ( short candidate -- result )
[ second swap complete ] keep 2array ; [ second swap complete ] keep 2array ;
: completion, ( short candidate -- ) : completion, ( short candidate -- )
completion dup first 0 > [ , ] [ drop ] if ; completion dup first 0 > [ , ] [ drop ] if ;
PRIVATE>
: completions ( short candidates -- seq ) : completions ( short candidates -- seq )
[ ] [ [ ] [
[ [ completion, ] with each ] { } make [ [ completion, ] with each ] { } make