From 0582f45fcb0464590ebe8621786be90f7d834927 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 22 Jul 2008 01:27:52 -0500
Subject: [PATCH] Add more class algebra opeations
---
core/classes/algebra/algebra-tests.factor | 2 --
core/classes/algebra/algebra.factor | 3 +++
core/generic/math/math.factor | 10 ++++++++--
3 files changed, 11 insertions(+), 4 deletions(-)
diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor
index 665fc86ebb..350c2fd66f 100755
--- a/core/classes/algebra/algebra-tests.factor
+++ b/core/classes/algebra/algebra-tests.factor
@@ -13,8 +13,6 @@ IN: classes.algebra.tests
\ flatten-class must-infer
\ flatten-builtin-class must-infer
-: class= ( cls1 cls2 -- ? ) [ class<= ] [ swap class<= ] 2bi and ;
-
: class-and* ( cls1 cls2 cls3 -- ? ) >r class-and r> class= ;
: class-or* ( cls1 cls2 cls3 -- ? ) >r class-or r> class= ;
diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor
index 00657f48c4..23695c06f8 100755
--- a/core/classes/algebra/algebra.factor
+++ b/core/classes/algebra/algebra.factor
@@ -186,6 +186,9 @@ M: anonymous-complement (classes-intersect?)
[ [ rank-class ] bi@ < ]
} cond ;
+: class= ( first second -- ? )
+ [ class<= ] [ swap class<= ] 2bi and ;
+
: largest-class ( seq -- n elt )
dup [ [ class< ] with contains? not ] curry find-last
[ "Topological sort failed" throw ] unless* ;
diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor
index 1c1368a6c2..834e19d9d9 100755
--- a/core/generic/math/math.factor
+++ b/core/generic/math/math.factor
@@ -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 ;