From 3b795b6a079bccb7a7bb94d003bffd8279c8bfe5 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 19 Apr 2008 02:11:40 -0500
Subject: [PATCH] Fix class< bug

---
 core/classes/algebra/algebra-tests.factor | 44 ++++++++++++++++++++++-
 core/classes/algebra/algebra.factor       |  7 ++--
 2 files changed, 46 insertions(+), 5 deletions(-)

diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor
index d61b62af3b..dba97c16f5 100755
--- a/core/classes/algebra/algebra-tests.factor
+++ b/core/classes/algebra/algebra-tests.factor
@@ -4,7 +4,7 @@ kernel math namespaces parser prettyprint sequences strings
 tools.test vectors words quotations classes classes.algebra
 classes.private classes.union classes.mixin classes.predicate
 vectors definitions source-files compiler.units growable
-random inference effects kernel.private ;
+random inference effects kernel.private sbufs ;
 
 : class= [ class< ] 2keep swap class< and ;
 
@@ -144,6 +144,48 @@ UNION: z1 b1 c1 ;
 
 [ f ] [ null class-not null class= ] unit-test
 
+[ t ] [
+    fixnum class-not
+    fixnum fixnum class-not class-or
+    class<
+] unit-test
+
+! Test method inlining
+[ f ] [ fixnum { } min-class ] unit-test
+
+[ string ] [
+    \ string
+    [ integer string array reversed sbuf
+    slice vector quotation ]
+    sort-classes min-class
+] unit-test
+
+[ fixnum ] [
+    \ fixnum
+    [ fixnum integer object ]
+    sort-classes min-class
+] unit-test
+
+[ integer ] [
+    \ fixnum
+    [ integer float object ]
+    sort-classes min-class
+] unit-test
+
+[ object ] [
+    \ word
+    [ integer float object ]
+    sort-classes min-class
+] unit-test
+
+[ reversed ] [
+    \ reversed
+    [ integer reversed slice ]
+    sort-classes min-class
+] unit-test
+
+[ f ] [ null { number fixnum null } min-class ] unit-test
+
 ! Test for hangs?
 : random-class classes random ;
 
diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor
index b7a3e074e5..f2941e3cef 100755
--- a/core/classes/algebra/algebra.factor
+++ b/core/classes/algebra/algebra.factor
@@ -77,10 +77,10 @@ C: <anonymous-complement> anonymous-complement
         { [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement< ] }
         { [ over anonymous-union? ] [ left-anonymous-union< ] }
         { [ over anonymous-intersection? ] [ left-anonymous-intersection< ] }
-        { [ over anonymous-complement? ] [ 2drop f ] }
         { [ over members ] [ left-union-class< ] }
         { [ dup anonymous-union? ] [ right-anonymous-union< ] }
         { [ dup anonymous-intersection? ] [ right-anonymous-intersection< ] }
+        { [ over anonymous-complement? ] [ 2drop f ] }
         { [ dup anonymous-complement? ] [ class>> classes-intersect? not ] }
         { [ dup members ] [ right-union-class< ] }
         { [ over superclass ] [ superclass< ] }
@@ -193,9 +193,8 @@ C: <anonymous-complement> anonymous-complement
     [ ] unfold nip ;
 
 : min-class ( class seq -- class/f )
-    [ dupd classes-intersect? ] subset dup empty? [
-        2drop f
-    ] [
+    over [ classes-intersect? ] curry subset
+    dup empty? [ 2drop f ] [
         tuck [ class< ] with all? [ peek ] [ drop f ] if
     ] if ;