]> gitweb.factorcode.org Git - factor.git/commitdiff
fix multi-methods for <=>
authorDoug Coleman <doug.coleman@gmail.com>
Mon, 28 Apr 2008 03:44:42 +0000 (22:44 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Mon, 28 Apr 2008 03:44:42 +0000 (22:44 -0500)
extra/multi-methods/multi-methods.factor
extra/multi-methods/tests/topological-sort.factor

index 07d110b01a6f5c12a370e84ab7ef088ed30fa9cc..d5a698f5f8609c36cb30264fd7680983ad191612 100755 (executable)
@@ -73,7 +73,7 @@ SYMBOL: total
 ! Part II: Topologically sorting specializers
 : maximal-element ( seq quot -- n elt )
     dupd [
-        swapd [ call 0 < ] 2curry filter empty?
+        swapd [ call +lt+ = ] 2curry filter empty?
     ] 2curry find [ "Topological sort failed" throw ] unless* ;
     inline
 
@@ -82,16 +82,16 @@ SYMBOL: total
     [ dupd maximal-element >r over delete-nth r> ] curry
     [ ] unfold nip ; inline
 
-: classes< ( seq1 seq2 -- -1/0/1 )
+: classes< ( seq1 seq2 -- lt/eq/gt )
     [
         {
-            { [ 2dup eq? ] [ 0 ] }
-            { [ 2dup [ class< ] 2keep swap class< and ] [ 0 ] }
-            { [ 2dup class< ] [ -1 ] }
-            { [ 2dup swap class< ] [ 1 ] }
-            [ 0 ]
+            { [ 2dup eq? ] [ +eq+ ] }
+            { [ 2dup [ class< ] 2keep swap class< and ] [ +eq+ ] }
+            { [ 2dup class< ] [ +lt+ ] }
+            { [ 2dup swap class< ] [ +gt+ ] }
+            [ +eq+ ]
         } cond 2nip
-    ] 2map [ zero? not ] find nip 0 or ;
+    ] 2map [ zero? not ] find nip +eq+ or ;
 
 : sort-methods ( alist -- alist' )
     [ [ first ] bi@ classes< ] topological-sort ;
index cea70227596b09f97bcf5dc1fd6a55442ab4a094..f1618374ef0ffbc9f04400b3d4f7345384f55fbd 100644 (file)
@@ -6,14 +6,14 @@ IN: multi-methods.tests
     { 6 4 5 1 3 2 } [ <=> ] topological-sort
 ] unit-test
 
-[ -1 ] [
+[ +lt+ ] [
     { fixnum array } { number sequence } classes<
 ] unit-test
 
-[ 0 ] [
+[ +eq+ ] [
     { number sequence } { number sequence } classes<
 ] unit-test
 
-[ 1 ] [
+[ +gt+ ] [
     { object object } { number sequence } classes<
 ] unit-test