From 6f2c4fc02a137c92edc0ae7a677f9e0bcc11f3fb Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sat, 4 Apr 2009 00:02:15 -0500
Subject: [PATCH] slim down the sorting.functor using more combinators

---
 basis/sorting/functor/functor.factor   |  8 ------
 basis/sorting/human/human-docs.factor  | 35 --------------------------
 basis/sorting/human/human-tests.factor |  4 +--
 basis/sorting/slots/slots.factor       | 10 ++++++--
 basis/sorting/title/title-tests.factor |  4 +--
 5 files changed, 12 insertions(+), 49 deletions(-)

diff --git a/basis/sorting/functor/functor.factor b/basis/sorting/functor/functor.factor
index 022ef3fb0d..7f46af4c92 100644
--- a/basis/sorting/functor/functor.factor
+++ b/basis/sorting/functor/functor.factor
@@ -7,18 +7,10 @@ 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 606eef670a..4bb62b1313 100644
--- a/basis/sorting/human/human-docs.factor
+++ b/basis/sorting/human/human-docs.factor
@@ -25,46 +25,11 @@ HELP: human>=<
 }
 { $description "Compares two objects using the " { $link human<=> } " word and inverts the result." } ;
 
-HELP: human-compare
-{ $values
-     { "obj1" object } { "obj2" object } { "quot" quotation }
-     { "<=>" "an ordering specifier" }
-}
-{ $description "Compares the results of applying the quotation to both objects via <=>." } ;
-
-HELP: human-sort
-{ $values
-     { "seq" sequence }
-     { "sortedseq" sequence }
-}
-{ $description "Sorts a sequence of objects by comparing the magnitude of any integers in the input string using the <=> word." } ;
-
-HELP: human-sort-keys
-{ $values
-     { "seq" "an alist" }
-     { "sortedseq" "a new sorted sequence" }
-}
-{ $description "Sorts the elements comparing first elements of pairs using the " { $link human<=> } " word." } ;
-
-HELP: human-sort-values
-{ $values
-     { "seq" "an alist" }
-     { "sortedseq" "a new sorted sequence" }
-}
-{ $description "Sorts the elements comparing second elements of pairs using the " { $link human<=> } " word." } ;
-
-{ <=> >=< human-compare human-sort human-sort-keys human-sort-values } related-words
-
 ARTICLE: "sorting.human" "Human-friendly sorting"
 "The " { $vocab-link "sorting.human" } " vocabulary sorts by numbers as a human would -- by comparing their magnitudes -- rather than in a lexicographic way. For example, sorting a1, a10, a03, a2 with human sort returns a1, a2, a03, a10, while sorting with natural sort returns a03, a1, a10, a2." $nl
 "Comparing two objects:"
 { $subsection human<=> }
 { $subsection human>=< }
-{ $subsection human-compare }
-"Sort a sequence:"
-{ $subsection human-sort }
-{ $subsection human-sort-keys }
-{ $subsection human-sort-values }
 "Splitting a string into substrings and integers:"
 { $subsection find-numbers } ;
 
diff --git a/basis/sorting/human/human-tests.factor b/basis/sorting/human/human-tests.factor
index 0e20b54c2f..519e0064b6 100644
--- a/basis/sorting/human/human-tests.factor
+++ b/basis/sorting/human/human-tests.factor
@@ -1,6 +1,6 @@
-USING: sorting.human tools.test ;
+USING: sorting.human tools.test sorting.slots ;
 IN: sorting.human.tests
 
 \ human-sort must-infer
 
-[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } human-sort ] unit-test
+[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } { human<=> } sort-by ] unit-test
diff --git a/basis/sorting/slots/slots.factor b/basis/sorting/slots/slots.factor
index 2dccc60821..26458bb22c 100644
--- a/basis/sorting/slots/slots.factor
+++ b/basis/sorting/slots/slots.factor
@@ -7,8 +7,8 @@ IN: sorting.slots
 
 <PRIVATE
 
-: short-circuit-comparator ( word -- quot )
-    execute dup +eq+ eq? [ drop f ] when ; inline
+: short-circuit-comparator ( obj1 obj2 word --  comparator/? )
+    execute dup +eq+ eq? [ drop f ] when ;
 
 : slot-comparator ( seq -- quot )
     [
@@ -34,6 +34,12 @@ MACRO: compare-seq ( seq -- quot )
 : sort-by ( seq sort-seq -- sortedseq )
     '[ _ compare-seq ] sort ;
 
+: sort-keys-by ( seq sort-seq -- sortedseq )
+    '[ [ first ] bi@ _ compare-seq ] sort ;
+
+: sort-values-by ( seq sort-seq -- sortedseq )
+    '[ [ second ] bi@ _ compare-seq ] sort ;
+
 MACRO: split-by-slots ( accessor-seqs -- quot )
     [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
     '[ [ _ 2&& ] slice monotonic-slice ] ;
diff --git a/basis/sorting/title/title-tests.factor b/basis/sorting/title/title-tests.factor
index 34d9e90b38..65a58e463d 100644
--- a/basis/sorting/title/title-tests.factor
+++ b/basis/sorting/title/title-tests.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test sorting.title ;
+USING: tools.test sorting.title sorting.slots ;
 IN: sorting.title.tests
 
 : sort-me ( -- seq )
@@ -36,5 +36,5 @@ IN: sorting.title.tests
         "la vida loca"
     }
 ] [
-    sort-me title-sort
+    sort-me { title<=> } sort-by
 ] unit-test