add invert-comparison word

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index a3209ea42c9a216215fddf15442c82f295ea36a8..6862232f2df756072196c9ec4b7da8e96b7883ff 100755 (executable)
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -254,6 +254,7 @@ $nl
 "Some types of objects also have an intrinsic order allowing sorting using " { $link natural-sort } ":"
 { $subsection <=> }
 { $subsection compare }
+{ $subsection invert-comparison }
 "Utilities for comparing objects:"
 { $subsection after? }
 { $subsection before? }

diff --git a/core/math/order/order-docs.factor b/core/math/order/order-docs.factor
index 42a8d8123fb577294e4a55dae4360f2feab290a5..b761959a830c71824aa47bec01a21d9a51547268 100644 (file)
--- a/core/math/order/order-docs.factor
+++ b/core/math/order/order-docs.factor
@@ -25,6 +25,13 @@ HELP: +eq+
 HELP: +gt+
 { $description "Returned by " { $link <=> } " when the first object is strictly greater than the second object." } ;
 
+HELP: invert-comparison
+{ $values { "symbol" "a comparison symbol, +lt+, +eq+, or +gt+" }
+          { "new-symbol" "a comparison symbol, +lt+, +eq+, or +gt+" } }
+{ $description "Invert the comparison symbol returned by " { $link <=> } ". The output for the symbol " { $snippet "+eq+" } " is itself." }
+{ $examples
+    { $example "USING: math.order prettyprint ;" "+lt+ invert-comparison ." "+gt+" } } ;
+
 HELP: compare
 { $values { "obj1" object } { "obj2" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } { "symbol" "a comparison symbol, +lt+, +eq+, or +gt+" } }
 { $description "Compares the results of applying the quotation to both objects via " { $link <=> } "." }

diff --git a/core/math/order/order.factor b/core/math/order/order.factor
index 1262d89ee086201a125043b407d374718d8f2ee8..36624f5ca9eb1ce86d0c63da2d612105c2af54cd 100644 (file)
--- a/core/math/order/order.factor
+++ b/core/math/order/order.factor
@@ -11,6 +11,9 @@ GENERIC: <=> ( obj1 obj2 -- n )
 
 : (<=>) - dup 0 < [ drop +lt+ ] [ zero? +eq+ +gt+ ? ] if ;
 
+: invert-comparison ( symbol -- new-symbol )
+    dup +lt+ eq? [ drop +gt+ ] [ +eq+ eq? +eq+ +lt+ ? ] if ;
+
 M: real <=> (<=>) ;
 M: integer <=> (<=>) ;