Clean up human sort, move it to basis

diff --git a/basis/sorting/human/human-tests.factor b/basis/sorting/human/human-tests.factor
new file mode 100644 (file)
index 0000000..0e20b54
--- /dev/null
+++ b/basis/sorting/human/human-tests.factor
@@ -0,0 +1,6 @@
+USING: sorting.human tools.test ;
+IN: sorting.human.tests
+
+\ human-sort must-infer
+
+[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } human-sort ] unit-test

diff --git a/basis/sorting/human/human.factor b/basis/sorting/human/human.factor
new file mode 100644 (file)
index 0000000..1c2ba41
--- /dev/null
+++ b/basis/sorting/human/human.factor
@@ -0,0 +1,10 @@
+! Copyright (C) 2008 Doug Coleman, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: peg.ebnf math.parser kernel assocs sorting ;
+IN: sorting.human
+
+: find-numbers ( string -- seq )
+    [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;
+
+: human-sort ( seq -- seq' )
+    [ dup find-numbers ] { } map>assoc sort-values keys ;

diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index 0ce4f56f7afaee2912d72b1f94ab651c3610a7d5..690d7f4b76d5e44a5d0a35d6b377df85f90686d4 100755 (executable)
--- a/extra/sequences/lib/lib.factor
+++ b/extra/sequences/lib/lib.factor
@@ -131,23 +131,6 @@ PRIVATE>
 : power-set ( seq -- subsets )
     2 over length exact-number-strings swap [ switches ] curry map ;
 
-: cut-find ( seq pred -- before after )
-    dupd find drop dup [ cut ] when ;
-
-: cut3 ( seq pred -- first mid last )
-    [ cut-find ] keep [ not ] compose cut-find ;
-
-: (cut-all) ( seq pred quot -- )
-    [ >r cut3 r> dip >r >r , r> [ , ] when* r> ] 2keep
-    pick [ (cut-all) ] [ 3drop ] if ;
-
-: cut-all ( seq pred quot -- first mid last )
-    [ (cut-all) ] { } make ;
-
-: human-sort ( seq -- newseq )
-    [ dup [ digit? ] [ string>number ] cut-all ] { } map>assoc
-    sort-values keys ;
-
 : ?first ( seq -- first/f ) 0 swap ?nth ; inline
 : ?second ( seq -- second/f ) 1 swap ?nth ; inline
 : ?third ( seq -- third/f ) 2 swap ?nth ; inline
@@ -164,14 +147,6 @@ USE: continuations
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! List the positions of obj in seq
-
-: indices ( seq obj -- seq )
-  >r dup length swap r>
-  [ = [ ] [ drop f ] if ] curry
-  2map
-  sift ;
-
 <PRIVATE
 : (attempt-each-integer) ( i n quot -- result )
     [