]> gitweb.factorcode.org Git - factor.git/commitdiff
Add more class algebra opeations
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 22 Jul 2008 06:27:52 +0000 (01:27 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 22 Jul 2008 06:27:52 +0000 (01:27 -0500)
core/classes/algebra/algebra-tests.factor
core/classes/algebra/algebra.factor
core/generic/math/math.factor

index 665fc86ebbe8c6f0bd5055f49c7e21a59ce657fd..350c2fd66fc21ce415b8c559ef209fb95bfc1f8c 100755 (executable)
@@ -13,8 +13,6 @@ IN: classes.algebra.tests
 \ flatten-class must-infer\r
 \ flatten-builtin-class must-infer\r
 \r
-: class= ( cls1 cls2 -- ? ) [ class<= ] [ swap class<= ] 2bi and ;\r
-\r
 : class-and* ( cls1 cls2 cls3 -- ? ) >r class-and r> class= ;\r
 \r
 : class-or* ( cls1 cls2 cls3 -- ? ) >r class-or r> class= ;\r
index 00657f48c446e65ac356a2b8ba4d1b621852634a..23695c06f8a18dca1538ad72d2c7db49777ccdf6 100755 (executable)
@@ -186,6 +186,9 @@ M: anonymous-complement (classes-intersect?)
         [ [ rank-class ] bi@ < ]\r
     } cond ;\r
 \r
+: class= ( first second -- ? )\r
+    [ class<= ] [ swap class<= ] 2bi and ;\r
+\r
 : largest-class ( seq -- n elt )\r
     dup [ [ class< ] with contains? not ] curry find-last\r
     [ "Topological sort failed" throw ] unless* ;\r
index 1c1368a6c22991fcacaaeb3e04015af8f36f7178..834e19d9d9b11ec20c3fe9ad87ca684ca99ff7d9 100755 (executable)
@@ -22,8 +22,14 @@ PREDICATE: math-class < class
         [ drop { 100 100 } ]
     } cond ;
     
-: math-class-max ( class class -- class )
-    [ [ math-precedence ] compare +gt+ eq? ] most ;
+: math-class<=> ( class1 class2 -- class )
+    [ math-precedence ] compare +gt+ eq? ;
+
+: math-class-max ( class1 class2 -- class )
+    [ math-class<=> ] most ;
+
+: math-class-min ( class1 class2 -- class )
+    [ swap math-class<=> ] most ;
 
 : (math-upgrade) ( max class -- quot )
     dupd = [ drop [ ] ] [ "coercer" word-prop [ ] or ] if ;