<=> outputs +lt+ +eq+ +gt+

core/debugger/debugger.factor

@@ -97,10 +97,10 @@ M: relative-overflow summary
 
 : assert-depth ( quot -- )
     >r datastack r> swap slip >r datastack r>
-    2dup [ length ] compare sgn {
-        { -1 [ trim-datastacks nip relative-underflow ] }
-        { 0 [ 2drop ] }
-        { 1 [ trim-datastacks drop relative-overflow ] }
+    2dup [ length ] compare {
+        { +lt+ [ trim-datastacks nip relative-underflow ] }
+        { +eq+ [ 2drop ] }
+        { +gt+ [ trim-datastacks drop relative-overflow ] }
     } case ; inline
 
 : expired-error. ( obj -- )

core/generic/math/math.factor

@@ -23,7 +23,7 @@ PREDICATE: math-class < class
     } cond ;
     
 : math-class-max ( class class -- class )
-    [ [ math-precedence ] compare 0 > ] most ;
+    [ [ math-precedence ] compare +gt+ eq? ] most ;
 
 : (math-upgrade) ( max class -- quot )
     dupd = [ drop [ ] ] [ "coercer" word-prop [ ] or ] if ;

core/heaps/heaps.factor

@@ -92,11 +92,11 @@ M: priority-queue heap-size ( heap -- n )
 
 GENERIC: heap-compare ( pair1 pair2 heap -- ? )
 
-: (heap-compare) drop [ entry-key ] compare 0 ; inline
+: (heap-compare) drop [ entry-key ] compare ; inline
 
-M: min-heap heap-compare (heap-compare) > ;
+M: min-heap heap-compare (heap-compare) +gt+ eq? ;
 
-M: max-heap heap-compare (heap-compare) < ;
+M: max-heap heap-compare (heap-compare) +lt+ eq? ;
 
 : heap-bounds-check? ( m heap -- ? )
     heap-size >= ; inline

core/inference/backend/backend.factor

@@ -60,7 +60,7 @@ M: object value-literal \ literal-expected inference-warning ;
 : value-vector ( n -- vector ) [ drop <computed> ] V{ } map-as ;
 
 : add-inputs ( seq stack -- n stack )
-    tuck [ length ] compare dup 0 >
+    tuck [ length ] bi@ - dup 0 >
     [ dup value-vector [ swapd push-all ] keep ]
     [ drop 0 swap ] if ;
 

core/math/order/order-docs.factor

@@ -9,17 +9,26 @@ HELP: <=>
     $nl
     "The output value is one of the following:"
     { $list
-        { "positive - indicating that " { $snippet "obj1" } " follows " { $snippet "obj2" } }
-        { "zero - indicating that " { $snippet "obj1" } " is equal to " { $snippet "obj2" } }
-        { "negative - indicating that " { $snippet "obj1" } " precedes " { $snippet "obj2" } }
+        { { $link +lt+ } " - indicating that " { $snippet "obj1" } " precedes " { $snippet "obj2" } }
+        { { $link +eq+ } " - indicating that " { $snippet "obj1" } " is equal to " { $snippet "obj2" } }
+        { { $link +gt+ } " - indicating that " { $snippet "obj1" } " follows " { $snippet "obj2" } }
     }
     "The default implementation treats the two objects as sequences, and recursively compares their elements. So no extra work is required to compare sequences lexicographically."
 } ;
 
+HELP: +lt+
+{ $description "Returned by " { $link <=> } " when the first object is strictly less than the second object." } ;
+
+HELP: +eq+
+{ $description "Returned by " { $link <=> } " when the first object is equal to the second object." } ;
+
+HELP: +gt+
+{ $description "Returned by " { $link <=> } " when the first object is strictly greater than the second object." } ;
+
 HELP: compare
-{ $values { "obj1" object } { "obj2" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } { "n" integer } }
+{ $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 <=> } "." }
-{ $examples { $example "USING: kernel math.order prettyprint sequences ;" "\"hello\" \"hi\" [ length ] compare ." "3" }
+{ $examples { $example "USING: kernel math.order prettyprint sequences ;" "\"hello\" \"hi\" [ length ] compare ." "+gt+" }
 } ;
 
 HELP: max

core/math/order/order-tests.factor

@@ -1,6 +1,9 @@
 USING: kernel math.order tools.test ;
 IN: math.order.tests
 
-[ -1 ] [ "ab" "abc" <=> ] unit-test
-[ 1 ] [ "abc" "ab" <=> ] unit-test
+[ +lt+ ] [ "ab" "abc" <=> ] unit-test
+[ +gt+ ] [ "abc" "ab" <=> ] unit-test
+[ +lt+ ] [ 3 4 <=> ] unit-test
+[ +eq+ ] [ 4 4 <=> ] unit-test
+[ +gt+ ] [ 4 3 <=> ] unit-test
 

core/math/order/order.factor

@@ -3,20 +3,26 @@
 USING: kernel math ;
 IN: math.order
 
+SYMBOL: +lt+
+SYMBOL: +eq+
+SYMBOL: +gt+
+
 GENERIC: <=> ( obj1 obj2 -- n )
 
-M: real <=> - ;
-M: integer <=> - ;
+: (<=>) - dup 0 < [ drop +lt+ ] [ zero? +eq+ +gt+ ? ] if ;
+
+M: real <=> (<=>) ;
+M: integer <=> (<=>) ;
 
 GENERIC: before? ( obj1 obj2 -- ? )
 GENERIC: after? ( obj1 obj2 -- ? )
 GENERIC: before=? ( obj1 obj2 -- ? )
 GENERIC: after=? ( obj1 obj2 -- ? )
 
-M: object before? ( obj1 obj2 -- ? ) <=> 0 < ;
-M: object after? ( obj1 obj2 -- ? ) <=> 0 > ;
-M: object before=? ( obj1 obj2 -- ? ) <=> 0 <= ;
-M: object after=? ( obj1 obj2 -- ? ) <=> 0 >= ;
+M: object before? ( obj1 obj2 -- ? ) <=> +lt+ eq? ;
+M: object after? ( obj1 obj2 -- ? ) <=> +gt+ eq? ;
+M: object before=? ( obj1 obj2 -- ? ) <=> +gt+ eq? not ;
+M: object after=? ( obj1 obj2 -- ? ) <=> +lt+ eq? not ;
 
 M: real before? ( obj1 obj2 -- ? ) < ;
 M: real after? ( obj1 obj2 -- ? ) > ;

core/sorting/sorting.factor

@@ -17,7 +17,7 @@ DEFER: sort
     dup slice-from 1+ swap set-slice-from ; inline
 
 : smallest ( iter1 iter2 quot -- elt )
-    >r over this over this r> call 0 <
+    >r over this over this r> call +lt+ eq?
     -rot ? [ this ] keep next ; inline
 
 : (merge) ( iter1 iter2 quot accum -- )

extra/sequences/lib/lib.factor

@@ -66,9 +66,9 @@ MACRO: firstn ( n -- )
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: higher ( a b quot -- c ) [ compare 0 > ] curry most ; inline
+: higher ( a b quot -- c ) [ compare +gt+ eq? ] curry most ; inline
 
-: lower  ( a b quot -- c ) [ compare 0 < ] curry most ; inline
+: lower  ( a b quot -- c ) [ compare +lt+ eq? ] curry most ; inline
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!