add invert-comparison word

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

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

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 <=> (<=>) ;