diff --git a/basis/sorting/human/human-tests.factor b/basis/sorting/human/human-tests.factor index 68ddf8c3c9..6f057ecd3b 100644 --- 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 7487f559ed..a839958b5e 100644 --- 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 >>