sorting: move compare-with back to sorting.extras

diff --git a/core/sorting/sorting-docs.factor b/core/sorting/sorting-docs.factor
index 0df1d919188198706f42f5b5b7db1db9cab4ad79..ce284c5938749993ba0180a799291f434a23e7fd 100644 (file)
--- a/core/sorting/sorting-docs.factor
+++ b/core/sorting/sorting-docs.factor
@@ -51,12 +51,8 @@ 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 compare-with natural-sort sort-with inv-sort-with sort-keys sort-values } related-words
+{ <=> compare 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 b7daab03d3f1230f9a67751de5ce6954db55c957..3f84bd4abc679965760e57b3525d650128361b59 100644 (file)
--- a/core/sorting/sorting-tests.factor
+++ b/core/sorting/sorting-tests.factor
@@ -25,9 +25,3 @@ unit-test
 [ { { 1 "a" } { 1 "b" } { 1 "c" } { 2 "d" } { 1 "e" } } sort-keys ] unit-test
 
 [ all-words natural-sort ] must-not-fail
-
-{ +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 7abeae68956f7ba1cd0eb95802f63616a319816f..f2e50daef2c8cfc382e2c05ef1672faf1a88031b 100644 (file)
--- a/core/sorting/sorting.factor
+++ b/core/sorting/sorting.factor
@@ -171,8 +171,3 @@ 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-docs.factor b/extra/sorting/extras/extras-docs.factor
index 9b54e02a036889e1933528403ee46f4b4c2d91d9..1ae4202aa2fd7bebc903e8428620c203600fb726 100644 (file)
--- a/extra/sorting/extras/extras-docs.factor
+++ b/extra/sorting/extras/extras-docs.factor
@@ -4,3 +4,7 @@ IN: sorting.extras
 HELP: map-sort
 { $values { "seq" sequence } { "quot" { $quotation ( ... elt -- ... key ) } } { "sortedseq" "a new sorted sequence" } }
 { $description "Sort the elements of " { $snippet "seq" } " a sequence using " { $snippet "quot" } " as a key function." } ;
+
+HELP: compare-with
+{ $values { "quots" { $sequence { $quotation ( obj1 obj2 -- <=> ) } } } }
+{ $description "Generate a chained comparator using the specified " { $snippet "quots" } " sequence of comparators." } ;

diff --git a/extra/sorting/extras/extras-tests.factor b/extra/sorting/extras/extras-tests.factor
index b15b2849a2b95ff9fedb0239c648643f37a8db4a..78dadb6fe12578f772af80dea47645cff119766b 100644 (file)
--- a/extra/sorting/extras/extras-tests.factor
+++ b/extra/sorting/extras/extras-tests.factor
@@ -31,3 +31,9 @@ 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 9dcb43aa390ab7b424ea987b5ee2988c25f46fe3..ae90b05109da4d47d3fc810c180a5b7974396135 100644 (file)
--- a/extra/sorting/extras/extras.factor
+++ b/extra/sorting/extras/extras.factor
@@ -35,3 +35,8 @@ 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 ;