diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index a3209ea42c..6862232f2d 100755 --- 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 42a8d8123f..b761959a83 100644 --- 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 1262d89ee0..36624f5ca9 100644 --- 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 <=> (<=>) ;