diff --git a/basis/sorting/functor/authors.txt b/basis/sorting/functor/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/sorting/functor/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/sorting/functor/functor.factor b/basis/sorting/functor/functor.factor new file mode 100644 index 0000000000..022ef3fb0d --- /dev/null +++ b/basis/sorting/functor/functor.factor @@ -0,0 +1,24 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: functors kernel math.order sequences sorting ; +IN: sorting.functor + +FUNCTOR: define-sorting ( NAME QUOT -- ) + +NAME<=> DEFINES ${NAME}<=> +NAME>=< DEFINES ${NAME}>=< +NAME-compare DEFINES ${NAME}-compare +NAME-sort DEFINES ${NAME}-sort +NAME-sort-keys DEFINES ${NAME}-sort-keys +NAME-sort-values DEFINES ${NAME}-sort-values + +WHERE + +: NAME<=> ( obj1 obj2 -- <=> ) QUOT bi@ <=> ; +: NAME>=< ( obj1 obj2 -- >=< ) NAME<=> invert-comparison ; +: NAME-compare ( obj1 obj2 quot -- <=> ) bi@ NAME<=> ; inline +: NAME-sort ( seq -- sortedseq ) [ NAME<=> ] sort ; +: NAME-sort-keys ( seq -- sortedseq ) [ [ first ] NAME-compare ] sort ; +: NAME-sort-values ( seq -- sortedseq ) [ [ second ] NAME-compare ] sort ; + +;FUNCTOR diff --git a/basis/sorting/human/human-docs.factor b/basis/sorting/human/human-docs.factor index 5952b3e3f9..606eef670a 100644 --- a/basis/sorting/human/human-docs.factor +++ b/basis/sorting/human/human-docs.factor @@ -35,7 +35,7 @@ HELP: human-compare HELP: human-sort { $values { "seq" sequence } - { "seq'" sequence } + { "sortedseq" sequence } } { $description "Sorts a sequence of objects by comparing the magnitude of any integers in the input string using the <=> word." } ; diff --git a/basis/sorting/human/human.factor b/basis/sorting/human/human.factor index c07ed8758b..b3dae45a9b 100644 --- a/basis/sorting/human/human.factor +++ b/basis/sorting/human/human.factor @@ -1,22 +1,9 @@ ! Copyright (C) 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: peg.ebnf math.parser kernel assocs sorting fry -math.order sequences ascii splitting.monotonic ; +USING: math.parser peg.ebnf sorting.functor ; IN: sorting.human : find-numbers ( string -- seq ) [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ; -: human<=> ( obj1 obj2 -- <=> ) [ find-numbers ] bi@ <=> ; - -: human>=< ( obj1 obj2 -- >=< ) human<=> invert-comparison ; inline - -: human-compare ( obj1 obj2 quot -- <=> ) bi@ human<=> ; inline - -: human-sort ( seq -- seq' ) [ human<=> ] sort ; - -: human-sort-keys ( seq -- sortedseq ) - [ [ first ] human-compare ] sort ; - -: human-sort-values ( seq -- sortedseq ) - [ [ second ] human-compare ] sort ; +<< "human" [ find-numbers ] define-sorting >> diff --git a/basis/sorting/slots/slots.factor b/basis/sorting/slots/slots.factor index 56b6a115f0..bce9442e44 100644 --- a/basis/sorting/slots/slots.factor +++ b/basis/sorting/slots/slots.factor @@ -20,7 +20,7 @@ PRIVATE> MACRO: compare-slots ( sort-specs -- <=> ) #! sort-spec: { accessors comparator } - [ slot-comparator ] map '[ _ 2|| +eq+ or ] ; + '[ _ [ slot-comparator ] map 2|| +eq+ or ] ; : sort-by-slots ( seq sort-specs -- seq' ) '[ _ compare-slots ] sort ; diff --git a/basis/sorting/title/authors.txt b/basis/sorting/title/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/sorting/title/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/sorting/title/title-tests.factor b/basis/sorting/title/title-tests.factor new file mode 100644 index 0000000000..34d9e90b38 --- /dev/null +++ b/basis/sorting/title/title-tests.factor @@ -0,0 +1,40 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test sorting.title ; +IN: sorting.title.tests + +: sort-me ( -- seq ) + { + "The Beatles" + "A river runs through it" + "Another" + "la vida loca" + "Basketball" + "racquetball" + "Los Fujis" + "los Fujis" + "La cucaracha" + "a day to remember" + "of mice and men" + "on belay" + "for the horde" + } ; +[ + { + "Another" + "Basketball" + "The Beatles" + "La cucaracha" + "a day to remember" + "for the horde" + "Los Fujis" + "los Fujis" + "of mice and men" + "on belay" + "racquetball" + "A river runs through it" + "la vida loca" + } +] [ + sort-me title-sort +] unit-test diff --git a/basis/sorting/title/title.factor b/basis/sorting/title/title.factor new file mode 100644 index 0000000000..dbdbf8a8fb --- /dev/null +++ b/basis/sorting/title/title.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: sorting.functor regexp kernel accessors sequences +unicode.case ; +IN: sorting.title + +<< "title" [ >lower dup R/ ^(the|a|an|el|la|los|las|il) / first-match [ to>> tail-slice ] when* ] define-sorting >> diff --git a/extra/html/parser/state/state-tests.factor b/extra/html/parser/state/state-tests.factor index 75db1a373e..c8a8a95892 100644 --- a/extra/html/parser/state/state-tests.factor +++ b/extra/html/parser/state/state-tests.factor @@ -99,3 +99,6 @@ IN: html.parser.state.tests [ "" ] [ "abc" dup "abc" take-sequence drop take-rest ] unit-test + +[ f ] +[ "abc" "abcdefg" take-sequence ] unit-test diff --git a/extra/html/parser/state/state.factor b/extra/html/parser/state/state.factor index 5f845ce810..2bcd08be5f 100644 --- a/extra/html/parser/state/state.factor +++ b/extra/html/parser/state/state.factor @@ -51,9 +51,16 @@ TUPLE: state-parser sequence n ; : take-while ( state-parser quot: ( obj -- ? ) -- sequence/f ) [ not ] compose take-until ; inline +: ( from to seq -- slice/f ) + 3dup { + [ 2drop 0 < ] + [ [ drop ] 2dip length > ] + [ drop > ] + } 3|| [ 3drop f ] [ slice boa ] if ; inline + :: take-sequence ( state-parser sequence -- obj/f ) - state-parser [ n>> dup sequence length + ] [ sequence>> ] bi - sequence sequence= [ + state-parser [ n>> dup sequence length + ] [ sequence>> ] bi + sequence sequence= [ sequence state-parser [ sequence length + ] change-n drop ] [