-! 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 kernel make math math.order math.parser
+sequences sorting.functor strings unicode ;
IN: sorting.human
-: find-numbers ( string -- seq )
- [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;
+: cut-find ( sequence pred -- before after )
+ [ drop ] [ find drop ] 2bi dup [ cut ] when ; inline
+
+: cut3 ( sequence pred -- first mid last )
+ [ cut-find ] keep [ not ] compose cut-find ; inline
+
+: find-sequences ( sequence pred quot -- sequences )
+ '[
+ [
+ _ cut3 [
+ [ , ]
+ [ [ @ , ] when* ] bi*
+ ] dip dup
+ ] loop drop
+ ] { } make ; inline
+
+: find-numbers ( sequence -- sequence' )
+ [ digit? ] [ string>number ] find-sequences ;
! For comparing integers or sequences
-TUPLE: hybrid obj ;
+TUPLE: alphanum obj ;
+
+: <alphanum> ( obj -- alphanum )
+ alphanum new
+ swap >>obj ; inline
+
+: <alphanum-insensitive> ( obj -- alphanum )
+ alphanum new
+ swap dup string? [ collation-key/nfd drop ] when >>obj ; inline
-M: hybrid <=>
+M: alphanum <=>
[ 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 [ <alphanum> ] map ] define-sorting >>
+<< "humani" [ find-numbers [ <alphanum-insensitive> ] map ] define-sorting >>