tools.completion: slightly faster.

diff --git a/basis/tools/completion/completion.factor b/basis/tools/completion/completion.factor
index 2f9ae4cb7dbafbe1cd2af6c82809aa2021f0eef3..1968b26d2e4d1edb764d5b1ec43b514a2a8aebaa 100644 (file)
--- a/basis/tools/completion/completion.factor
+++ b/basis/tools/completion/completion.factor
@@ -1,32 +1,30 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs colors combinators
-combinators.short-circuit fry io.directories io.files
-io.files.info io.pathnames kernel locals make math math.order
-sequences sequences.private sorting splitting
-splitting.monotonic unicode unicode.data vectors vocabs
-vocabs.hierarchy ;
+combinators.short-circuit io.directories io.files io.files.info
+io.pathnames kernel locals make math math.order sequences
+sequences.private sorting splitting splitting.monotonic unicode
+unicode.data vectors vocabs vocabs.hierarchy ;
 IN: tools.completion
 
 <PRIVATE
 
-: smart-index-from ( obj i seq -- n/f )
+: fuzzy-index-from ( ch i seq -- n/f )
     rot [ ch>lower ] [ ch>upper ] bi
     '[ dup _ eq? [ drop t ] [ _ eq? ] if ] find-from drop ;
 
-:: (fuzzy) ( accum i full ch -- accum i ? )
-    ch i full smart-index-from [
+:: (fuzzy) ( accum i ch full -- accum i ? )
+    ch i full fuzzy-index-from [
         [ accum push ]
         [ accum swap 1 + t ] bi
     ] [
-        f -1 f
+        f f f
     ] if* ; inline
 
 PRIVATE>
 
 : fuzzy ( full short -- indices )
-    dup [ length <vector> 0 ] curry 2dip
-    [ (fuzzy) ] with all? 2drop ;
+    [ V{ } clone 0 ] 2dip swap '[ _ (fuzzy) ] all? 2drop ;
 
 : runs ( seq -- newseq )
     [ 1 - = ] monotonic-split-slice ;
@@ -36,7 +34,7 @@ PRIVATE>
 : score-1 ( i full -- n )
     {
         { [ over zero? ] [ 2drop 10 ] }
-        { [ 2dup length 1 - number= ] [ 2drop 4 ] }
+        { [ 2dup length 1 - = ] [ 2drop 4 ] }
         { [ 2dup [ 1 - ] dip nth-unsafe Letter? not ] [ 2drop 10 ] }
         { [ 2dup [ 1 + ] dip nth-unsafe Letter? not ] [ 2drop 4 ] }
         [ 2drop 1 ]
@@ -45,30 +43,32 @@ PRIVATE>
 PRIVATE>
 
 : score ( full fuzzy -- n )
-    dup [
+    [
         [ [ length ] bi@ - 15 swap [-] 3 /f ] 2keep
         runs [
             [ 0 [ pick score-1 max ] reduce nip ] keep
             length * +
         ] with each
     ] [
-        2drop 0
-    ] if ;
+        drop 0
+    ] if* ;
 
 : rank-completions ( results -- newresults )
-    [ 0 [ first max ] reduce 4 /f ] keep
-    dup length 25 >
-    [ [ first-unsafe < ] with filter ] [ nip ] if
-    sort-keys <reversed> values ;
+    dup length 25 > [
+        [ [ first ] [ max ] map-reduce 4 /f ] keep
+        [ first < ] with filter
+    ] when sort-keys <reversed> values ;
 
 : complete ( full short -- score )
-    2dup [ <reversed> ] bi@ [ dupd fuzzy score ] 2bi@ max ;
+    [ dupd fuzzy score ] 2keep pick 0 > [
+        [ <reversed> ] bi@ dupd fuzzy score max
+    ] [ 2drop ] if ;
 
-: completion ( short candidate -- result )
-    [ second swap complete ] keep 2array ; inline
+: completion ( short candidate -- score result )
+    [ second swap complete ] keep ; inline
 
 : completion, ( short candidate -- )
-    completion dup first-unsafe 0 > [ , ] [ drop ] if ;
+    completion over 0 > [ 2array , ] [ 2drop ] if ;
 
 : completions ( short candidates -- seq )
     [ ] [
@@ -90,13 +90,11 @@ PRIVATE>
         drop vocabs-matching keys [
             [ vocab-words ] [ vocab-name ] bi ":" append
             [ over name>> append ] curry { } map>assoc
-        ] map! concat
+        ] map concat
     ] [ drop f ] if* ;
 
 : words-matching ( str -- seq )
-    [ all-words named ]
-    [ qualified-named [ append ] unless-empty ] bi
-    completions ;
+    all-words named over qualified-named [ append ] unless-empty completions ;
 
 : chars-matching ( str -- seq )
     name-map keys dup zip completions ;