Cleaning up mixins

core/classes/classes-tests.factor

@@ -2,7 +2,7 @@ USING: alien arrays definitions generic assocs hashtables io
 kernel math namespaces parser prettyprint sequences strings
 tools.test vectors words quotations classes io.streams.string
 classes.private classes.union classes.mixin classes.predicate
-vectors definitions ;
+vectors definitions source-files ;
 IN: temporary
 
 H{ } "s" set
@@ -176,6 +176,8 @@ FORGET: forget-class-bug-2
 
 DEFER: mixin-forget-test-g
 
+[ "mixin-forget-test" forget-source ] with-compilation-unit
+
 [ ] [
     {
         "USING: sequences ;"

core/classes/classes.factor

@@ -263,7 +263,7 @@ PRIVATE>
         uncache-classes
         dupd (define-class)
     ] keep cache-classes
-    r> [ changed-class ] [ drop ] if ;
+    r> [ update-methods ] [ drop ] if ;
 
 GENERIC: class ( object -- class ) inline
 

core/classes/mixin/mixin.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes classes.union words kernel sequences
-definitions prettyprint.backend combinators ;
+definitions prettyprint.backend combinators arrays ;
 IN: classes.mixin
 
 PREDICATE: union-class mixin-class "mixin" word-prop ;
@@ -52,6 +52,10 @@ M: mixin-instance equal?
         { [ t ] [ t ] }
     } cond 2nip ;
 
+M: mixin-instance hashcode*
+    { mixin-instance-class mixin-instance-mixin } get-slots
+    2array hashcode* ;
+
 : <mixin-instance> ( class mixin -- definition )
     { set-mixin-instance-class set-mixin-instance-mixin }
     mixin-instance construct ;
@@ -71,5 +75,5 @@ M: mixin-instance definition drop f ;
 
 M: mixin-instance forget
     dup mixin-instance-class
-    swap mixin-instance-mixin
+    swap mixin-instance-mixin dup mixin-class?
-    remove-mixin-instance ;
+    [ remove-mixin-instance ] [ 2drop ] if ;

core/definitions/definitions.factor

@@ -47,7 +47,7 @@ M: object redefined* drop ;
 GENERIC: update-methods ( class -- )
 
 SYMBOL: changed-words
-SYMBOL: changed-classes
+! SYMBOL: changed-classes
 SYMBOL: old-definitions
 SYMBOL: new-definitions
 
@@ -94,19 +94,19 @@ TUPLE: no-compilation-unit word ;
     [ no-compilation-unit ] unless*
     set-at ;
 
-: changed-class ( class -- )
+! : changed-class ( class -- )
-    dup changed-classes get
+!     dup changed-classes get
-    [ no-compilation-unit ] unless*
+!     [ no-compilation-unit ] unless*
-    set-at ;
+!     set-at ;
 
 : with-compilation-unit ( quot -- )
     [
         H{ } clone changed-words set
-        H{ } clone changed-classes set
+        ! H{ } clone changed-classes set
         <definitions> new-definitions set
         <definitions> old-definitions set
         [
-            changed-classes get keys [ update-methods ] each
+            ! changed-classes get keys [ update-methods ] each
             changed-words get keys recompile-hook get call
         ] [ ] cleanup
     ] with-scope ; inline