Merge branch 'master' of git://factorcode.org/git/factor

basis/sorting/functor/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

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

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." } ;
 

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 >>

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 ;

basis/sorting/title/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

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

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 >>

extra/html/parser/state/state-tests.factor

@@ -99,3 +99,6 @@ IN: html.parser.state.tests
 
 [ "" ]
 [ "abc" <state-parser> dup "abc" take-sequence drop take-rest ] unit-test
+
+[ f ]
+[ "abc" <state-parser> "abcdefg" take-sequence ] unit-test

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
 
+: <safe-slice> ( 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 <slice>
-    sequence sequence= [
+    state-parser [ n>> dup sequence length + ] [ sequence>> ] bi
+    <safe-slice> sequence sequence= [
         sequence
         state-parser [ sequence length + ] change-n drop
     ] [