Human sort is unusable with pegs (too slow). Make a case-insensitive version humani<=>

diff --git a/basis/sorting/human/human-tests.factor b/basis/sorting/human/human-tests.factor
index 68ddf8c3c9ee538e49bc9d289330b2c8864a0566..6f057ecd3b92a40bfd533ff14b7eeaeaa9326119 100644 (file)
--- a/basis/sorting/human/human-tests.factor
+++ b/basis/sorting/human/human-tests.factor
@@ -12,3 +12,10 @@ IN: sorting.human.tests
 
 [ { "4dup" "4nip" "5drop" "nip" "nip2" "nipd" } ]
 [ { "nip" "4dup" "4nip" "5drop" "nip2" "nipd" } [ human<=> ] sort ] unit-test
+
+
+{ { "Abc" "abc" "def" "gh" } }
+[ { "abc" "Abc" "def" "gh" } [ human<=> ] sort ] unit-test
+
+{ { "abc" "Abc" "def" "gh" } }
+[ { "abc" "Abc" "def" "gh" } [ humani<=> ] sort ] unit-test

diff --git a/basis/sorting/human/human.factor b/basis/sorting/human/human.factor
index 7487f559ed36b83000236c4b644f834ae0e4a73d..a839958b5e82b64dd852a91d816b0864859b49a9 100644 (file)
--- a/basis/sorting/human/human.factor
+++ b/basis/sorting/human/human.factor
@@ -1,21 +1,47 @@
-! Copyright (C) 2008 Doug Coleman, Slava Pestov.
+! Copyright (C) 2008, 2010 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math math.order math.parser peg.ebnf
-sequences sorting.functor ;
+USING: accessors fry kernel make math math.order math.parser
+sequences sorting.functor strings unicode.case
+unicode.categories ;
 IN: sorting.human
 
-: find-numbers ( string -- seq )
-    [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;
+: cut-find ( seq pred -- before after )
+    [ drop ] [ find drop ] 2bi dup [ cut ] when ; inline
+
+: cut3 ( seq pred -- first mid last )
+    [ cut-find ] keep [ not ] compose cut-find ; inline
+
+: find-sequences ( sequence pred quot -- seq )
+    '[
+        [
+            _ cut3 [
+                [ , ]
+                [ [ @ , ] when* ] bi*
+            ] dip dup
+        ] loop drop
+    ] { } make ; inline
+
+: find-numbers ( seq -- newseq )
+    [ digit? ] [ string>number ] find-sequences ;
 
 ! For comparing integers or sequences
 TUPLE: hybrid obj ;
 
+: <hybrid> ( obj -- hybrid )
+    hybrid new
+        swap >>obj ; inline
+
+: <hybrid-insensitive> ( obj -- hybrid )
+    hybrid new
+        swap dup string? [ >case-fold ] when >>obj ; inline
+
 M: hybrid <=>
     [ obj>> ] bi@
     2dup [ integer? ] bi@ xor [
-        drop integer? [ +lt+ ] [ +gt+ ] if
+        drop integer? +lt+ +gt+ ?
     ] [
         <=>
     ] if ;
 
-<< "human" [ find-numbers [ hybrid boa ] map ] define-sorting >>
+<< "human" [ find-numbers [ <hybrid> ] map ] define-sorting >>
+<< "humani" [ find-numbers [ <hybrid-insensitive> ] map ] define-sorting >>