More changes so that mixins trigger even less recompilation

basis/compiler/compiler.factor

@@ -3,18 +3,16 @@
 USING: accessors kernel namespaces arrays sequences io words fry
 continuations vocabs assocs dlists definitions math graphs generic
 generic.single combinators deques search-deques macros
-source-files.errors combinators.short-circuit
+source-files.errors combinators.short-circuit classes.algebra
 
 stack-checker stack-checker.dependencies stack-checker.inlining
 stack-checker.errors
 
-compiler.errors compiler.units compiler.utilities
+compiler.errors compiler.units compiler.utilities compiler.crossref
 
 compiler.tree.builder
 compiler.tree.optimizer
 
-compiler.crossref
-
 compiler.cfg
 compiler.cfg.builder
 compiler.cfg.optimizer
@@ -183,6 +181,12 @@ t compile-dependencies? set-global
 
 SINGLETON: optimizing-compiler
 
+M: optimizing-compiler update-call-sites ( class generic -- words )
+    #! Words containing call sites with inferred type 'class'
+    #! which inlined a method on 'generic'
+    compiled-generic-usage swap
+    '[ nip _ classes-intersect? ] assoc-filter keys ;
+
 M: optimizing-compiler recompile ( words -- alist )
     [
         <hashed-dlist> compile-queue set
@@ -197,9 +201,7 @@ M: optimizing-compiler recompile ( words -- alist )
     "--- compile done" compiler-message ;
 
 M: optimizing-compiler to-recompile ( -- words )
-    changed-definitions get compiled-usages
+    changed-definitions get compiled-usages assoc-combine keys ;
-    changed-generics get compiled-generic-usages
-    append assoc-combine keys ;
 
 M: optimizing-compiler process-forgotten-words
     [ delete-compiled-xref ] each ;

basis/compiler/crossref/crossref.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs classes.algebra compiler.units definitions graphs
 grouping kernel namespaces sequences words
@@ -32,16 +32,6 @@ compiled-generic-crossref [ H{ } clone ] initialize
 : compiled-generic-usage ( word -- assoc )
     compiled-generic-crossref get at ;
 
-: (compiled-generic-usages) ( generic class -- assoc )
-    [ compiled-generic-usage ] dip
-    [
-        2dup [ valid-class? ] both?
-        [ classes-intersect? ] [ 2drop f ] if nip
-    ] curry assoc-filter ;
-
-: compiled-generic-usages ( assoc -- assocs )
-    [ (compiled-generic-usages) ] { } assoc>map ;
-
 : (compiled-xref) ( word dependencies word-prop variable -- )
     [ [ concat ] dip set-word-prop ] [ get add-vertex* ] bi-curry* 2bi ;
 

core/classes/classes.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2009 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions assocs kernel kernel.private
 slots.private namespaces make sequences strings words words.symbol
@@ -133,12 +133,14 @@ M: sequence implementors [ implementors ] gather ;
     dup deferred? [ define-symbol ] [ drop ] if ;
 
 : (define-class) ( word props -- )
+    reset-caches
+    [ drop update-map- ]
+    [
         [
             {
-            [ dup class? [ drop ] [ [ implementors-map+ ] [ new-class ] bi ] if ]
+                [ dup class? [ drop ] [ implementors-map+ ] if ]
                 [ reset-class ]
                 [ ?define-symbol ]
-            [ changed-definition ]
                 [ ]
             } cleave
         ] dip [ assoc-union ] curry change-props
@@ -146,6 +148,9 @@ M: sequence implementors [ implementors ] gather ;
         [ 1quotation "predicate" set-word-prop ]
         [ swap "predicating" set-word-prop ]
         [ drop t "class" set-word-prop ]
+        2tri
+    ]
+    [ drop update-map+ ]
     2tri ;
 
 PRIVATE>
@@ -161,13 +166,7 @@ GENERIC: update-methods ( class seq -- )
     [ nip [ update-class ] each ] [ update-methods ] 2bi ;
 
 : define-class ( word superclass members participants metaclass -- )
-    #! If it was already a class, update methods after.
+    make-class-props [ (define-class) ] [ drop changed-definition ] 2bi ;
-    reset-caches
-    make-class-props
-    [ drop update-map- ]
-    [ (define-class) ]
-    [ drop update-map+ ]
-    2tri ;
 
 : forget-predicate ( class -- )
     dup "predicate" word-prop

core/classes/mixin/mixin.factor

@@ -26,10 +26,12 @@ M: mixin-class rank-class drop 3 ;
     dup mixin-class? [
         drop
     ] [
+        {
             [ { } redefine-mixin-class ]
             [ H{ } clone "instances" set-word-prop ]
+            [ changed-definition ]
             [ update-classes ]
-        tri
+        } cleave
     ] if ;
 
 TUPLE: check-mixin-class class ;
@@ -46,18 +48,18 @@ TUPLE: check-mixin-class class ;
     [ [ members swap bootstrap-word ] dip call ] [ drop ] 2bi
     swap redefine-mixin-class ; inline
 
-: update-mixin-class ( member mixin -- )
-    class-usages
-    [ update-methods ]
-    [ [ update-class ] each ]
-    [ implementors [ remake-generic ] each ]
-    tri ;
-
 : (add-mixin-instance) ( class mixin -- )
-    [ [ suffix ] change-mixin-class ]
+    #! Call update-methods before adding the member:
-    [ [ f ] 2dip "instances" word-prop set-at ]
+    #! - Call sites of generics specializing on 'mixin'
-    [ update-mixin-class ]
+    #! where the inferred type is 'class' are updated,
-    2tri ;
+    #! - Call sites where the inferred type is a subtype
+    #! of 'mixin' disjoint from 'class' are not updated
+    dup class-usages {
+        [ nip update-methods ]
+        [ drop [ suffix ] change-mixin-class ]
+        [ drop [ f ] 2dip "instances" word-prop set-at ]
+        [ 2nip [ update-class ] each ]
+    } 3cleave ;
 
 GENERIC# add-mixin-instance 1 ( class mixin -- )
 
@@ -65,15 +67,19 @@ M: class add-mixin-instance
     [ 2drop ] [ (add-mixin-instance) ] if-mixin-member? ;
 
 : (remove-mixin-instance) ( class mixin -- )
-    [ [ swap remove ] change-mixin-class ]
+    #! Call update-methods after removing the member:
-    [ "instances" word-prop delete-at ]
+    #! - Call sites of generics specializing on 'mixin'
-    [ update-mixin-class ]
+    #! where the inferred type is 'class' are updated,
-    2tri ;
+    #! - Call sites where the inferred type is a subtype
+    #! of 'mixin' disjoint from 'class' are not updated
+    dup class-usages {
+        [ drop [ swap remove ] change-mixin-class ]
+        [ drop "instances" word-prop delete-at ]
+        [ 2nip [ update-class ] each ]
+        [ nip update-methods ]
+    } 3cleave ;
 
 : remove-mixin-instance ( class mixin -- )
-    #! The order of the three clauses is important here. The last
-    #! one must come after the other two so that the entries it
-    #! adds to changed-generics are not overwritten.
     [ (remove-mixin-instance) ] [ 2drop ] if-mixin-member? ;
 
 M: mixin-class class-forgotten remove-mixin-instance ;

core/classes/union/union.factor

@@ -1,8 +1,8 @@
 ! 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
+classes.private classes.algebra classes.algebra.private
-quotations ;
+namespaces arrays math quotations definitions ;
 IN: classes.union
 
 PREDICATE: union-class < class
@@ -26,12 +26,15 @@ PREDICATE: union-class < class
 M: union-class update-class define-union-predicate ;
 
 : (define-union-class) ( class members -- )
-    f swap f union-class define-class ;
+    f swap f union-class make-class-props (define-class) ;
 
 PRIVATE>
 
 : define-union-class ( class members -- )
-    [ (define-union-class) ] [ drop update-classes ] 2bi ;
+    [ (define-union-class) ]
+    [ drop changed-definition ]
+    [ drop update-classes ]
+    2tri ;
 
 M: union-class rank-class drop 2 ;
 

core/compiler/units/units.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel continuations assocs namespaces
 sequences words vocabs definitions hashtables init sets
@@ -43,6 +43,16 @@ PRIVATE>
 
 SYMBOL: compiler-impl
 
+HOOK: update-call-sites compiler-impl ( class generic -- words )
+
+M: generic update-generic ( class generic -- )
+    [ update-call-sites [ changed-definition ] each ]
+    [ remake-generic drop ]
+    2bi ;
+
+M: sequence update-methods ( class seq -- )
+    implementors [ update-generic ] with each ;
+
 HOOK: recompile compiler-impl ( words -- alist )
 
 HOOK: to-recompile compiler-impl ( -- words )
@@ -52,12 +62,14 @@ HOOK: process-forgotten-words compiler-impl ( words -- )
 : compile ( words -- ) recompile modify-code-heap ;
 
 ! Non-optimizing compiler
-M: f recompile
+M: f update-call-sites
-    [ dup def>> ] { } map>assoc ;
+    2drop { } ;
 
 M: f to-recompile
-    changed-definitions get [ drop word? ] assoc-filter
+    changed-definitions get [ drop word? ] assoc-filter keys ;
-    changed-generics get assoc-union keys ;
+
+M: f recompile
+    [ dup def>> ] { } map>assoc ;
 
 M: f process-forgotten-words drop ;
 
@@ -148,25 +160,21 @@ PRIVATE>
 : with-nested-compilation-unit ( quot -- )
     [
         H{ } clone changed-definitions set
-        H{ } clone changed-generics set
         H{ } clone changed-effects set
         H{ } clone outdated-generics set
         H{ } clone outdated-tuples set
         H{ } clone new-words set
-        H{ } clone new-classes set
         [ finish-compilation-unit ] [ ] cleanup
     ] with-scope ; inline
 
 : with-compilation-unit ( quot -- )
     [
         H{ } clone changed-definitions set
-        H{ } clone changed-generics set
         H{ } clone changed-effects set
         H{ } clone outdated-generics set
         H{ } clone forgotten-definitions set
         H{ } clone outdated-tuples set
         H{ } clone new-words set
-        H{ } clone new-classes set
         <definitions> new-definitions set
         <definitions> old-definitions set
         [ finish-compilation-unit ] [ ] cleanup

core/definitions/definitions.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2009 Slava Pestov.
+! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences namespaces assocs math accessors ;
 IN: definitions
@@ -17,26 +17,16 @@ SYMBOL: changed-definitions
 
 SYMBOL: changed-effects
 
-SYMBOL: changed-generics
-
 SYMBOL: outdated-generics
 
 SYMBOL: new-words
 
-SYMBOL: new-classes
-
 : new-word ( word -- )
     dup new-words get set-in-unit ;
 
 : new-word? ( word -- ? )
     new-words get key? ;
 
-: new-class ( word -- )
-    dup new-classes get set-in-unit ;
-
-: new-class? ( word -- ? )
-    new-classes get key? ;
-
 GENERIC: where ( defspec -- loc )
 
 M: object where drop f ;

core/generic/generic.factor

@@ -87,21 +87,16 @@ TUPLE: check-method class generic ;
         \ check-method boa throw
     ] unless ; inline
 
-: changed-generic ( class generic -- )
-    changed-generics get
-    [ [ [ class-or ] when* ] change-at ] [ no-compilation-unit ] if* ;
-
 : remake-generic ( generic -- )
     dup outdated-generics get set-in-unit ;
 
 : remake-generics ( -- )
     outdated-generics get keys [ generic? ] filter [ make-generic ] each ;
 
+GENERIC: update-generic ( class generic -- )
+
 : with-methods ( class generic quot -- )
-    [ drop changed-generic ]
+    [ "methods" word-prop ] prepose [ update-generic ] 2bi ; inline
-    [ [ "methods" word-prop ] dip call ]
-    [ drop remake-generic drop ]
-    3tri ; inline
 
 : method-word-name ( class generic -- string )
     [ name>> ] bi@ "=>" glue ;
@@ -174,11 +169,6 @@ M: method-body forget*
         [ call-next-method ] bi
     ] if ;
 
-M: sequence update-methods ( class seq -- )
-    implementors [
-        [ changed-generic ] [ remake-generic drop ] 2bi
-    ] with each ;
-
 : define-generic ( word combination effect -- )
     [ nip swap set-stack-effect ]
     [