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

diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor
index 9492304628c13e459ddcbfb7e3051232d5d6a35a..34fcf8e6bc6d70ff77e2f3f48090443a34263307 100755 (executable)
--- a/core/debugger/debugger.factor
+++ b/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 -- )

diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor
index d71749804b4f6da1de8eac66eb0c84137b5e25a8..90590fe565568c53ba48fbc54619bcb8e3b548cf 100755 (executable)
--- a/core/generic/math/math.factor
+++ b/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 ;

diff --git a/core/heaps/heaps.factor b/core/heaps/heaps.factor
index 54eb93a20196335dd8b1fa6549062b5b8be39383..57f0e0ac72b98bfc903dbabb25d50e67fa9453d8 100755 (executable)
--- a/core/heaps/heaps.factor
+++ b/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

diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor
index 2e1a69e407f3537b3aae28c8139107f21184c934..5896429ccfb6e17541837741a8a19901751b3ec0 100755 (executable)
--- a/core/inference/backend/backend.factor
+++ b/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 ;
 

diff --git a/core/math/order/order-docs.factor b/core/math/order/order-docs.factor
index 029d41efa8b96adbff9cc74ea2f43ba98bf40b0a..42a8d8123fb577294e4a55dae4360f2feab290a5 100644 (file)
--- a/core/math/order/order-docs.factor
+++ b/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

diff --git a/core/math/order/order-tests.factor b/core/math/order/order-tests.factor
index 6dbaf29e7cab33cd73233ffac61c3a5cee74ba54..665537be5da845de6428800242bbab87f1f629cf 100644 (file)
--- a/core/math/order/order-tests.factor
+++ b/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
 

diff --git a/core/math/order/order.factor b/core/math/order/order.factor
index eb781d1967dbf8fd1f191a0459a38a36c7a86dec..1262d89ee086201a125043b407d374718d8f2ee8 100644 (file)
--- a/core/math/order/order.factor
+++ b/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 -- ? ) > ;

diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor
index 6aafe2ded12227743f7283bc4745bc0e84924b62..fa8d50ea0ee28e795a89dbbed9ab229af8d6c1ab 100755 (executable)
--- a/core/sorting/sorting.factor
+++ b/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 -- )

diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index ad5a40ed6d952c1f23484dae7a792202c3e771f6..0dc5601cd011279d7129d9285bce501a533147bb 100755 (executable)
--- a/extra/sequences/lib/lib.factor
+++ b/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
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!