Trying to fix mixin semantics

basis/grouping/grouping.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2009 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.order strings arrays vectors sequences
 sequences.private accessors fry ;
@@ -20,14 +20,16 @@ M: chunking-seq set-nth group@ <slice> 0 swap copy ;
 
 M: chunking-seq like drop { } like ; inline
 
-INSTANCE: chunking-seq sequence
-
 MIXIN: subseq-chunking
 
+INSTANCE: subseq-chunking sequence
+
 M: subseq-chunking nth group@ subseq ; inline
 
 MIXIN: slice-chunking
 
+INSTANCE: slice-chunking sequence
+
 M: slice-chunking nth group@ <slice> ; inline
 
 M: slice-chunking nth-unsafe group@ slice boa ; inline

core/classes/algebra/algebra-tests.factor

@@ -79,9 +79,9 @@ INSTANCE: union-with-one-member mixin-with-one-member
 
 [ t ] [ a1 b1 class-or a1 c1 class-or class-and a1 class<= ] unit-test
 
-[ t ] [ growable tuple sequence class-and class<= ] unit-test
+[ f ] [ growable tuple sequence class-and class<= ] unit-test
 
-[ t ] [ growable assoc class-and tuple class<= ] unit-test
+[ f ] [ growable assoc class-and tuple class<= ] unit-test
 
 [ t ] [ object \ f \ f class-not class-or class<= ] unit-test
 
@@ -130,6 +130,11 @@ INSTANCE: union-with-one-member mixin-with-one-member
 [ t ] [ a union-with-one-member class<= ] unit-test
 [ f ] [ union-with-one-member class-not integer class<= ] unit-test
 
+MIXIN: empty-mixin
+
+[ f ] [ empty-mixin class-not null class<= ] unit-test
+[ f ] [ empty-mixin null class<= ] unit-test
+
 ! class-and
 : class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;
 
@@ -146,8 +151,6 @@ INSTANCE: union-with-one-member mixin-with-one-member
 [ t ] [ slice     reversed null   class-and* ] unit-test
 [ t ] [ \ f class-not \ f      null   class-and* ] unit-test
 
-[ t ] [ vector virtual-sequence null class-and* ] unit-test
-
 [ t ] [ vector array class-not vector class-and* ] unit-test
 
 ! class-or
@@ -160,7 +163,8 @@ INSTANCE: union-with-one-member mixin-with-one-member
 
 ! classes-intersect?
 [ t ] [ both tuple classes-intersect? ] unit-test
-[ f ] [ vector virtual-sequence classes-intersect? ] unit-test
+
+[ t ] [ vector virtual-sequence classes-intersect? ] unit-test
 
 [ t ] [ number vector class-or sequence classes-intersect? ] unit-test
 
@@ -188,11 +192,11 @@ INSTANCE: union-with-one-member mixin-with-one-member
 [ t ] [ union-with-one-member object classes-intersect? ] unit-test
 
 [ t ] [ a mixin-with-one-member classes-intersect? ] unit-test
-[ f ] [ fixnum mixin-with-one-member classes-intersect? ] unit-test
+[ t ] [ fixnum mixin-with-one-member classes-intersect? ] unit-test
 [ t ] [ object mixin-with-one-member classes-intersect? ] unit-test
 
 [ t ] [ mixin-with-one-member a classes-intersect? ] unit-test
-[ f ] [ mixin-with-one-member fixnum classes-intersect? ] unit-test
+[ t ] [ mixin-with-one-member fixnum classes-intersect? ] unit-test
 [ t ] [ mixin-with-one-member object classes-intersect? ] unit-test
 
 ! class=

core/classes/algebra/algebra.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel classes combinators accessors sequences arrays
 vectors assocs namespaces words sorting layouts math hashtables
@@ -34,12 +34,9 @@ DEFER: (class-or)
 
 GENERIC: (flatten-class) ( class -- )
 
-: normalize-class ( class -- class' )
+GENERIC: normalize-class ( class -- class' )
-    {
+
-        { [ dup members ] [ members <anonymous-union> normalize-class ] }
+M: object normalize-class ;
-        { [ dup participants ] [ participants <anonymous-intersection> normalize-class ] }
-        [ ]
-    } cond ;
 
 PRIVATE>
 
@@ -93,6 +90,9 @@ M: word valid-class? drop f ;
 : left-anonymous-union<= ( first second -- ? )
     [ members>> ] dip [ class<= ] curry all? ;
 
+: right-union<= ( first second -- ? )
+    members [ class<= ] with any? ;
+
 : right-anonymous-union<= ( first second -- ? )
     members>> [ class<= ] with any? ;
 
@@ -117,7 +117,7 @@ M: word valid-class? drop f ;
             [ class-not normalize-class ] map
             <anonymous-union>
         ] }
-        [ <anonymous-complement> ]
+        [ drop object ]
     } cond ;
 
 : left-anonymous-complement<= ( first second -- ? )
@@ -147,6 +147,7 @@ PREDICATE: empty-intersection < anonymous-intersection participants>> empty? ;
                 { [ over anonymous-union? ] [ left-anonymous-union<= ] }
                 { [ over anonymous-intersection? ] [ left-anonymous-intersection<= ] }
                 { [ over nontrivial-anonymous-complement? ] [ left-anonymous-complement<= ] }
+                { [ dup members ] [ right-union<= ] }
                 { [ dup anonymous-union? ] [ right-anonymous-union<= ] }
                 { [ dup anonymous-intersection? ] [ right-anonymous-intersection<= ] }
                 { [ dup anonymous-complement? ] [ class>> classes-intersect? not ] }

core/classes/intersection/intersection.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: words accessors sequences kernel assocs combinators classes
 classes.algebra classes.algebra.private classes.builtin
@@ -33,6 +33,9 @@ M: intersection-class rank-class drop 2 ;
 M: intersection-class instance?
     "participants" word-prop [ instance? ] with all? ;
 
+M: intersection-class normalize-class
+    participants <anonymous-intersection> normalize-class ;
+
 M: intersection-class (flatten-class)
     participants <anonymous-intersection> (flatten-class) ;
 

core/classes/mixin/mixin-tests.factor

@@ -38,8 +38,8 @@ MIXIN: mx1
 INSTANCE: integer mx1
 
 [ t ] [ integer mx1 class<= ] unit-test
-[ t ] [ mx1 integer class<= ] unit-test
+[ f ] [ mx1 integer class<= ] unit-test
-[ t ] [ mx1 number class<= ] unit-test
+[ f ] [ mx1 number class<= ] unit-test
 
 "IN: classes.mixin.tests USE: arrays INSTANCE: array mx1" eval( -- )
 

core/classes/mixin/mixin.factor

@@ -1,11 +1,17 @@
-! Copyright (C) 2004, 2009 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: classes classes.union words kernel sequences
+USING: classes classes.algebra classes.algebra.private
-definitions combinators arrays assocs generic accessors ;
+classes.union words kernel sequences definitions combinators
+arrays assocs generic accessors ;
 IN: classes.mixin
 
 PREDICATE: mixin-class < union-class "mixin" word-prop ;
 
+M: mixin-class normalize-class ;
+
+M: mixin-class (classes-intersect?)
+    members [ classes-intersect? ] with any? ;
+
 M: mixin-class reset-class
     [ call-next-method ] [ { "mixin" } reset-props ] bi ;
 
@@ -53,13 +59,6 @@ TUPLE: check-mixin-class class ;
 GENERIC# add-mixin-instance 1 ( class mixin -- )
 
 M: class add-mixin-instance
-    #! Note: we call update-classes on the new member, not the
-    #! mixin. This ensures that we only have to update the
-    #! methods whose specializer intersects the new member, not
-    #! the entire mixin (since the other mixin members are not
-    #! affected at all). Also, all usages of the mixin will get
-    #! updated by transitivity; the mixins usages appear in
-    #! class-usages of the member, now that it's been added.
     [ 2drop ] [
         [ (add-mixin-instance) ] 2keep
         [ nip ] [ [ new-class? ] either? ] 2bi

core/classes/union/union.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: words sequences kernel assocs combinators classes
 classes.algebra classes.algebra.private namespaces arrays math
@@ -34,5 +34,8 @@ M: union-class rank-class drop 2 ;
 M: union-class instance?
     "members" word-prop [ instance? ] with any? ;
 
+M: union-class normalize-class
+    members <anonymous-union> normalize-class ;
+
 M: union-class (flatten-class)
     members <anonymous-union> (flatten-class) ;