sorting: moving compare-with from sorting.extras.

diff --git a/core/sorting/sorting-docs.factor b/core/sorting/sorting-docs.factor
index ddf887ce829914864ed06cd7f30a7d2aa71878c5..26f0ae9358ec25b3676482b999fd55a39520b54a 100644 (file)
--- a/core/sorting/sorting-docs.factor
+++ b/core/sorting/sorting-docs.factor
@@ -51,8 +51,12 @@ HELP: sort-pair
 { $values { "a" object } { "b" object } { "c" object } { "d" object } }
 { $description "If " { $snippet "a" } " is greater than " { $snippet "b" } ", exchanges " { $snippet "a" } " with " { $snippet "b" } "." } ;
 
+HELP: compare-with
+{ $values { "quots" { $sequence { $quotation ( obj1 obj2 -- <=> ) } } } }
+{ $description "Generate a chained comparator using the specified " { $snippet "quots" } " sequence of comparators." } ;
+
 HELP: midpoint@
 { $values { "seq" sequence } { "n" integer } }
 { $description "Outputs the index of the midpoint of " { $snippet "seq" } "." } ;
 
-{ <=> compare natural-sort sort-with inv-sort-with sort-keys sort-values } related-words
+{ <=> compare compare-with natural-sort sort-with inv-sort-with sort-keys sort-values } related-words

diff --git a/core/sorting/sorting-tests.factor b/core/sorting/sorting-tests.factor
index 5c2d0972eed42d380de28d5144a3beacc1a02b16..dd7b9b36a11765fcfd6d1d5df0e7d3dd843d42c2 100644 (file)
--- a/core/sorting/sorting-tests.factor
+++ b/core/sorting/sorting-tests.factor
@@ -25,3 +25,9 @@ unit-test
 [ { { 1 "a" } { 1 "b" } { 1 "c" } { 2 "d" } { 1 "e" } } sort-keys ] unit-test
 
 { } [ all-words natural-sort drop ] unit-test
+
+{ +gt+ } [ "lady" "bug" { [ length ] [ first ] } compare-with ] unit-test
+{ +lt+ } [ "bug" "lady" { [ length ] [ first ] } compare-with ] unit-test
+{ +eq+ } [ "bat" "bat" { [ length ] [ first ] } compare-with ] unit-test
+{ +lt+ } [ "bat" "cat" { [ length ] [ first ] } compare-with ] unit-test
+{ +gt+ } [ "fat" "cat" { [ length ] [ first ] } compare-with ] unit-test

diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor
index a7dcbf86b7ef84f83af7a35fdabefda65e501fed..ab7fbdc0806eb595292454258d8c4f08a4e99c26 100644 (file)
--- a/core/sorting/sorting.factor
+++ b/core/sorting/sorting.factor
@@ -171,3 +171,8 @@ M: hashtable sort-values
     >alist [ { array } declare second-unsafe ] sort-with ;
 
 : sort-pair ( a b -- c d ) 2dup after? [ swap ] when ;
+
+MACRO: compare-with ( quots -- <=> )
+    [ '[ _ bi@ <=> ] ]
+    [ '[ _ 2keep rot dup +eq+ eq? [ drop @ ] [ 2nip ] if ] ]
+    map-reduce ;

diff --git a/extra/sorting/extras/extras-tests.factor b/extra/sorting/extras/extras-tests.factor
index 78dadb6fe12578f772af80dea47645cff119766b..b15b2849a2b95ff9fedb0239c648643f37a8db4a 100644 (file)
--- a/extra/sorting/extras/extras-tests.factor
+++ b/extra/sorting/extras/extras-tests.factor
@@ -31,9 +31,3 @@ IN: sorting.extras
     10 <iota> >array randomize
     [ swap insort-right! ] each
 ] unit-test
-
-{ +gt+ } [ "lady" "bug" { [ length ] [ first ] } compare-with ] unit-test
-{ +lt+ } [ "bug" "lady" { [ length ] [ first ] } compare-with ] unit-test
-{ +eq+ } [ "bat" "bat" { [ length ] [ first ] } compare-with ] unit-test
-{ +lt+ } [ "bat" "cat" { [ length ] [ first ] } compare-with ] unit-test
-{ +gt+ } [ "fat" "cat" { [ length ] [ first ] } compare-with ] unit-test

diff --git a/extra/sorting/extras/extras.factor b/extra/sorting/extras/extras.factor
index 06b9e53b6d70c08d146804099d43cca416dce94b..949c54885bd9b3ad8c9b1139847a08444e351c37 100644 (file)
--- a/extra/sorting/extras/extras.factor
+++ b/extra/sorting/extras/extras.factor
@@ -35,8 +35,3 @@ IN: sorting.extras
 
 : insort-right! ( obj seq -- seq )
     [ bisect-right ] 2keep swapd [ insert-nth! ] keep ;
-
-MACRO: compare-with ( quots -- <=> )
-    [ '[ _ bi@ <=> ] ]
-    [ '[ _ 2keep rot dup +eq+ eq? [ drop @ ] [ 2nip ] if ] ]
-    map-reduce ;