New compiled crossref implementation

basis/compiler/compiler.factor

@@ -42,12 +42,17 @@ SYMBOL: +failed+
     [ compiled-unxref ]
     [
         dup crossref?
-        [ dependencies get compiled-xref ] [ drop ] if
+        [
+            dependencies get
+            generic-dependencies get
+            compiled-xref
+        ] [ drop ] if
     ] tri ;
 
 : (compile) ( word -- )
     '[
         H{ } clone dependencies set
+        H{ } clone generic-dependencies set
 
         , {
             [ compile-begins ]

basis/compiler/tests/insane.factor

@@ -1,4 +1,5 @@
 IN: compiler.tests
-USING: words kernel stack-checker alien.strings tools.test ;
+USING: words kernel stack-checker alien.strings tools.test
+compiler.units ;
 
-[ ] [ \ if redefined [ string>alien ] infer. ] unit-test
+[ ] [ [ \ if redefined ] with-compilation-unit [ string>alien ] infer. ] unit-test

basis/compiler/tests/redefine11.factor

@@ -0,0 +1,32 @@
+USING: eval tools.test compiler.units vocabs multiline words
+kernel classes.mixin arrays ;
+IN: compiler.tests
+
+! Mixin redefinition did not recompile all necessary words.
+
+[ ] [ [ "compiler.tests.redefine11" forget-vocab ] with-compilation-unit ] unit-test
+
+[ ] [
+    <"
+    USING: kernel math classes arrays ;
+    IN: compiler.tests.redefine11
+    MIXIN: my-mixin
+    INSTANCE: array my-mixin
+    INSTANCE: fixnum my-mixin
+    GENERIC: my-generic ( a -- b )
+    M: my-mixin my-generic drop 0 ;
+    M: object my-generic drop 1 ;
+    : my-inline ( -- b ) { } my-generic ;
+    "> eval
+] unit-test
+
+[ ] [
+    [
+        array "my-mixin" "compiler.tests.redefine11" lookup
+        remove-mixin-instance
+    ] with-compilation-unit
+] unit-test
+
+[ 1 ] [
+    "my-inline" "compiler.tests.redefine11" lookup execute
+] unit-test

basis/compiler/tests/redefine9.factor

@@ -29,7 +29,7 @@ IN: compiler.tests
 ] unit-test
 
 [
-    "my-tuple" "compiler.tests.redefine9" lookup
+    "my-tuple" "compiler.tests.redefine9" lookup boa
     "my-generic" "compiler.tests.redefine9" lookup
     execute
 ] [ no-math-method? ] must-fail-with

basis/compiler/tree/cleanup/cleanup.factor

@@ -52,7 +52,7 @@ GENERIC: cleanup* ( node -- node/nodes )
 
 : add-method-dependency ( #call -- )
     dup method>> word? [
-        [ method>> ] [ class>> <method-dependency> ] bi depends-on
+        [ word>> ] [ class>> ] bi depends-on-generic
     ] [ drop ] if ;
 
 : cleanup-inlining ( #call -- nodes )

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -5,6 +5,8 @@ math.partial-dispatch math.intervals math.parser math.order
 layouts words sequences sequences.private arrays assocs classes
 classes.algebra combinators generic.math splitting fry locals
 classes.tuple alien.accessors classes.tuple.private slots.private
+definitions
+stack-checker.state
 compiler.tree.comparisons
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes
@@ -280,6 +282,14 @@ generic-comparison-ops [
 ] +constraints+ set-word-prop
 
 \ instance? [
+    ! We need to force the caller word to recompile when the class
+    ! is redefined, since now we're making assumptions but the
+    ! class definition itself.
     dup literal>> class?
-    [ literal>> predicate-output-infos ] [ 2drop object-info ] if
+    [
+        literal>>
+        [ inlined-dependency depends-on ]
+        [ predicate-output-infos ]
+        bi
+    ] [ 2drop object-info ] if
 ] +outputs+ set-word-prop

basis/compiler/tree/propagation/simple/simple.factor

@@ -2,9 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry accessors kernel sequences sequences.private assocs words
 namespaces classes.algebra combinators classes classes.tuple
-classes.tuple.private continuations arrays byte-arrays strings
-math math.partial-dispatch math.private slots generic
+classes.tuple.private continuations arrays
+math math.partial-dispatch math.private slots generic definitions
 generic.standard generic.math
+stack-checker.state
 compiler.tree
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes
@@ -32,7 +33,14 @@ M: #push propagate-before
     [ set-value-info ] 2each ;
 
 M: #declare propagate-before
-    declaration>> [ <class-info> swap refine-value-info ] assoc-each ;
+    #! We need to force the caller word to recompile when the
+    #! classes mentioned in the declaration are redefined, since
+    #! now we're making assumptions but their definitions.
+    declaration>> [
+        [ inlined-dependency depends-on ]
+        [ <class-info> swap refine-value-info ]
+        bi
+    ] assoc-each ;
 
 : predicate-constraints ( value class boolean-value -- constraint )
     [ [ is-instance-of ] dip t--> ]
@@ -74,7 +82,11 @@ M: #declare propagate-before
     } cond 2nip ;
 
 : propagate-predicate ( #call word -- infos )
-    [ in-d>> first value-info ] [ "predicating" word-prop ] bi*
+    #! We need to force the caller word to recompile when the class
+    #! is redefined, since now we're making assumptions but the
+    #! class definition itself.
+    [ in-d>> first value-info ]
+    [ "predicating" word-prop dup inlined-dependency depends-on ] bi*
     predicate-output-infos 1array ;
 
 : default-output-value-infos ( #call word -- infos )

basis/help/syntax/syntax.factor

@@ -18,5 +18,5 @@ IN: help.syntax
 : ABOUT:
     scan-object
     in get vocab
-    dup +inlined+ changed-definition
+    dup changed-definition
     set-vocab-help ; parsing

basis/hints/hints.factor

@@ -55,7 +55,7 @@ IN: hints
 
 : HINTS:
     scan-word
-    [ inlined-dependency changed-definition ]
+    [ redefined ]
     [ parse-definition "specializer" set-word-prop ] bi ;
     parsing
 

basis/stack-checker/backend/backend.factor

@@ -8,29 +8,6 @@ sets generic.standard.engines.tuple stack-checker.state
 stack-checker.visitor stack-checker.errors ;
 IN: stack-checker.backend
 
-! Word properties we use
-SYMBOL: visited
-
-: reset-on-redefine { "inferred-effect" "cannot-infer" } ; inline
-
-: (redefined) ( word -- )
-    dup visited get key? [ drop ] [
-        [ reset-on-redefine reset-props ]
-        [ visited get conjoin ]
-        [
-            crossref get at keys
-            [ word? ] filter
-            [
-                [ reset-on-redefine [ word-prop ] with contains? ]
-                [ inline? ]
-                bi or
-            ] filter
-            [ (redefined) ] each
-        ] tri
-    ] if ;
-
-M: word redefined H{ } clone visited [ (redefined) ] with-variable ;
-
 : push-d ( obj -- ) meta-d get push ;
 
 : pop-d  ( -- obj )
@@ -175,6 +152,7 @@ M: object apply-object push-literal ;
             init-known-values
             stack-visitor off
             dependencies off
+            generic-dependencies off
             [ [ def>> ] [ ] [ ] tri infer-quot-recursive end-infer ]
             [ finish-word current-effect ]
             bi

basis/stack-checker/state/state.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs namespaces sequences kernel definitions math
-effects accessors words stack-checker.errors
+effects accessors words fry classes.algebra stack-checker.errors
 compiler.units ;
 IN: stack-checker.state
 
@@ -89,8 +89,15 @@ SYMBOL: meta-r
 SYMBOL: dependencies
 
 : depends-on ( word how -- )
-    [ strongest-dependency ] curry
-    dependencies get dup [ swap change-at ] [ 3drop ] if ;
+    dependencies get dup
+    [ swap '[ , strongest-dependency ] change-at ] [ 3drop ] if ;
+
+! Generic words that the current quotation depends on
+SYMBOL: generic-dependencies
+
+: depends-on-generic ( generic class -- )
+    generic-dependencies get dup
+    [ swap '[ null or , class-or ] change-at ] [ 3drop ] if ;
 
 ! Words we've inferred the stack effect of, for rollback
 SYMBOL: recorded

basis/tools/deploy/deploy-tests.factor

@@ -35,13 +35,13 @@ namespaces continuations layouts accessors ;
 
 [ t ] [ 1200000 small-enough? ] unit-test
 
-[ ] [ "tetris" shake-and-bake ] unit-test
-
-[ t ] [ 1500000 small-enough? ] unit-test
-
-[ ] [ "bunny" shake-and-bake ] unit-test
-
-[ t ] [ 2500000 small-enough? ] unit-test
+! [ ] [ "tetris" shake-and-bake ] unit-test
+! 
+! [ t ] [ 1500000 small-enough? ] unit-test
+! 
+! [ ] [ "bunny" shake-and-bake ] unit-test
+! 
+! [ t ] [ 2500000 small-enough? ] unit-test
 
 {
     "tools.deploy.test.1"

basis/tools/deploy/test/2/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-word-defs? f }
-    { deploy-random? f }
-    { deploy-name "tools.deploy.test.2" }
-    { deploy-threads? t }
-    { deploy-compiler? t }
     { deploy-math? t }
-    { deploy-c-types? f }
-    { deploy-io 2 }
-    { deploy-reflection 1 }
+    { deploy-compiler? t }
+    { deploy-reflection 2 }
     { deploy-ui? f }
-    { "stop-after-last-window?" t }
     { deploy-word-props? f }
+    { deploy-threads? t }
+    { deploy-c-types? f }
+    { deploy-random? f }
+    { "stop-after-last-window?" t }
+    { deploy-name "tools.deploy.test.2" }
+    { deploy-io 2 }
+    { deploy-word-defs? f }
 }

core/assocs/assocs.factor

@@ -110,6 +110,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
     2dup [ assoc-size ] bi@ + pick new-assoc
     [ rot update ] keep [ swap update ] keep ;
 
+: assoc-combine ( seq -- union )
+    H{ } clone [ dupd update ] reduce ;
+
 : assoc-diff ( assoc1 assoc2 -- diff )
     [ nip key? not ] curry assoc-filter ;
 

core/bootstrap/primitives.factor

@@ -35,6 +35,7 @@ H{ } clone sub-primitives set
 H{ } clone dictionary set
 H{ } clone new-classes set
 H{ } clone changed-definitions set
+H{ } clone changed-generics set
 H{ } clone forgotten-definitions set
 H{ } clone root-cache set
 H{ } clone source-files set

core/classes/classes.factor

@@ -122,6 +122,7 @@ M: sequence implementors [ implementors ] gather ;
     dup class? [ dup [ implementors-map+ ] [ new-class ] bi ] unless
     dup reset-class
     dup deferred? [ dup define-symbol ] when
+    dup redefined
     dup props>>
     r> assoc-union >>props
     dup predicate-word

core/classes/mixin/mixin.factor

@@ -63,8 +63,10 @@ TUPLE: check-mixin-class mixin ;
 
 : remove-mixin-instance ( class mixin -- )
     [
-        [ [ swap remove ] change-mixin-class ] keep
-        update-classes
+        [ class-usages update-methods ]
+        [ [ swap remove ] change-mixin-class ]
+        [ nip update-classes ]
+        2tri
     ] [ 2drop ] if-mixin-member? ;
 
 M: mixin-class class-forgotten remove-mixin-instance ;

core/classes/tuple/tuple.factor

@@ -227,9 +227,8 @@ M: tuple-class update-class
         2drop
         [
             [ update-tuples-after ]
-            [ inlined-dependency changed-definition ]
             [ redefined ]
-            tri
+            bi
         ] each-subclass
     ]
     [ define-new-tuple-class ]

core/compiler/units/units-tests.factor

@@ -7,5 +7,3 @@ USING: definitions compiler.units tools.test arrays sequences ;
 [ inlined-dependency ] [ called-dependency inlined-dependency strongest-dependency ] unit-test
 [ flushed-dependency ] [ called-dependency flushed-dependency strongest-dependency ] unit-test
 [ called-dependency ] [ called-dependency f strongest-dependency ] unit-test
-[ T{ method-dependency f array } ] [ called-dependency T{ method-dependency f array } strongest-dependency ] unit-test
-[ T{ method-dependency f sequence } ] [ T{ method-dependency f sequence } T{ method-dependency f array } strongest-dependency ] unit-test

core/compiler/units/units.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel continuations assocs namespaces
+USING: accessors arrays kernel continuations assocs namespaces
 sequences words vocabs definitions hashtables init sets
-math.order classes.algebra ;
+math.order classes classes.algebra ;
 IN: compiler.units
 
 SYMBOL: old-definitions
@@ -74,48 +74,50 @@ SYMBOL: outdated-tuples
 SYMBOL: update-tuples-hook
 
 : strongest-dependency ( how1 how2 -- how )
-    [ called-dependency or ] bi@
-    2dup [ method-dependency? ] both?
-    [ [ class>> ] bi@ class-or <method-dependency> ] [ max ] if ;
+    [ called-dependency or ] bi@ max ;
 
 : weakest-dependency ( how1 how2 -- how )
-    [ inlined-dependency or ] bi@
-    2dup [ method-dependency? ] both?
-    [ [ class>> ] bi@ class-and <method-dependency> ] [ min ] if ;
-
-: relevant-dependency? ( how to -- ? )
-    #! Note that an intersection check alone is not enough,
-    #! since we're also interested in empty mixins.
-    2dup [ method-dependency? ] both? [
-        [ class>> ] bi@
-        [ classes-intersect? ] [ class<= ] 2bi or
-    ] [ after=? ] if ;
+    [ inlined-dependency or ] bi@ min ;
 
 : compiled-usage ( word -- assoc )
     compiled-crossref get at ;
 
-: (compiled-usages) ( word dependency -- assoc )
+: (compiled-usages) ( word -- assoc )
     #! If the word is not flushable anymore, we have to recompile
     #! all words which flushable away a call (presumably when the
     #! word was still flushable). If the word is flushable, we
     #! don't have to recompile words that folded this away.
-    [ drop compiled-usage ]
-    [
-        swap "flushable" word-prop inlined-dependency flushed-dependency ?
-        weakest-dependency
-    ] 2bi
-    [ relevant-dependency? nip ] curry assoc-filter ;
+    [ compiled-usage ]
+    [ "flushable" word-prop inlined-dependency flushed-dependency ? ] bi
+    [ after=? nip ] curry assoc-filter ;
 
-: compiled-usages ( assoc -- seq )
-    clone [
-        dup [
-            [ (compiled-usages) ] dip swap update
-        ] curry assoc-each
-    ] keep keys ;
+: compiled-usages ( assoc -- assocs )
+    [ drop word? ] assoc-filter
+    [ [ drop (compiled-usages) ] { } assoc>map ] keep suffix ;
+
+: compiled-generic-usage ( word -- assoc )
+    compiled-generic-crossref get at ;
+
+: (compiled-generic-usages) ( generic class -- assoc )
+    dup class? [
+        [ compiled-generic-usage ] dip
+        [ [ classes-intersect? ] [ null class<= ] bi or nip ]
+        curry assoc-filter
+    ] [ 2drop f ] if ;
+
+: compiled-generic-usages ( assoc -- assocs )
+    [ (compiled-generic-usages) ] { } assoc>map ;
+
+: words-only ( assoc -- assoc' )
+    [ drop word? ] assoc-filter ;
+
+: to-recompile ( -- seq )
+    changed-definitions get compiled-usages
+    changed-generics get compiled-generic-usages
+    append assoc-combine keys ;
 
 : call-recompile-hook ( -- )
-    changed-definitions get [ drop word? ] assoc-filter
-    compiled-usages recompile-hook get call ;
+    to-recompile recompile-hook get call ;
 
 : call-update-tuples-hook ( -- )
     update-tuples-hook get call ;
@@ -134,6 +136,7 @@ SYMBOL: update-tuples-hook
 : with-nested-compilation-unit ( quot -- )
     [
         H{ } clone changed-definitions set
+        H{ } clone changed-generics set
         H{ } clone outdated-tuples set
         H{ } clone new-classes set
         [ finish-compilation-unit ] [ ] cleanup
@@ -142,6 +145,7 @@ SYMBOL: update-tuples-hook
 : with-compilation-unit ( quot -- )
     [
         H{ } clone changed-definitions set
+        H{ } clone changed-generics set
         H{ } clone forgotten-definitions set
         H{ } clone outdated-tuples set
         H{ } clone new-classes set

core/definitions/definitions.factor

@@ -9,21 +9,15 @@ SINGLETON: inlined-dependency
 SINGLETON: flushed-dependency
 SINGLETON: called-dependency
 
-TUPLE: method-dependency class ;
-C: <method-dependency> method-dependency
-
 UNION: dependency
 inlined-dependency
 flushed-dependency
-called-dependency
-method-dependency ;
+called-dependency ;
 
 M: dependency <=>
     [
-        dup method-dependency? [ drop method-dependency ] when
         {
             called-dependency
-            method-dependency
             flushed-dependency
             inlined-dependency
         } index
@@ -31,8 +25,14 @@ M: dependency <=>
 
 SYMBOL: changed-definitions
 
-: changed-definition ( defspec how -- )
-    swap changed-definitions get
+: changed-definition ( defspec -- )
+    inlined-dependency swap changed-definitions get
+    [ set-at ] [ no-compilation-unit ] if* ;
+
+SYMBOL: changed-generics
+
+: changed-generic ( class generic -- )
+    changed-generics get
     [ set-at ] [ no-compilation-unit ] if* ;
 
 SYMBOL: new-classes

core/generic/generic.factor

@@ -53,21 +53,12 @@ GENERIC: next-method-quot* ( class generic combination -- quot )
 TUPLE: check-method class generic ;
 
 : check-method ( class generic -- class generic )
-    over class? over generic? and [
+    2dup [ class? ] [ generic? ] bi* and [
         \ check-method boa throw
     ] unless ; inline
 
-: affected-methods ( class generic -- seq )
-    "methods" word-prop swap
-    [ nip [ classes-intersect? ] [ class<= ] 2bi or ] curry assoc-filter
-    values ;
-
-: update-generic ( class generic -- )
-    [ affected-methods ] [ drop <method-dependency> ] 2bi
-    [ changed-definition ] curry each ;
-
 : with-methods ( class generic quot -- )
-    [ drop update-generic ]
+    [ drop changed-generic ]
     [ [ "methods" word-prop ] dip call ]
     [ drop make-generic drop ]
     3tri ; inline
@@ -167,7 +158,7 @@ M: method-body smart-usage
 
 M: sequence update-methods ( class seq -- )
     implementors [
-        [ update-generic ] [ make-generic drop ] 2bi
+        [ changed-generic ] [ make-generic drop ] 2bi
     ] with each ;
 
 : define-generic ( word combination -- )

core/words/words.factor

@@ -101,45 +101,79 @@ SYMBOL: compiled-crossref
 
 compiled-crossref global [ H{ } assoc-like ] change-at
 
-: compiled-xref ( word dependencies -- )
-    [ drop crossref? ] assoc-filter
-    [ "compiled-uses" set-word-prop ]
-    [ compiled-crossref get add-vertex* ]
-    2bi ;
+SYMBOL: compiled-generic-crossref
+
+compiled-generic-crossref global [ H{ } assoc-like ] change-at
+
+: (compiled-xref) ( word dependencies word-prop variable -- )
+    [ [ set-word-prop ] curry ]
+    [ [ get add-vertex* ] curry ]
+    bi* 2bi ;
+
+: compiled-xref ( word dependencies generic-dependencies -- )
+    [ [ drop crossref? ] assoc-filter ] bi@
+    [ over ] dip
+    [ "compiled-uses" compiled-crossref (compiled-xref) ]
+    [ "compiled-generic-uses" compiled-generic-crossref (compiled-xref) ]
+    2bi* ;
+
+: (compiled-unxref) ( word word-prop variable -- )
+    [ [ [ dupd word-prop ] dip get remove-vertex* ] 2curry ]
+    [ drop [ f swap set-word-prop ] curry ]
+    2bi bi ;
 
 : compiled-unxref ( word -- )
-    [
-        dup "compiled-uses" word-prop
-        compiled-crossref get remove-vertex*
-    ]
-    [ f "compiled-uses" set-word-prop ] bi ;
+    [ "compiled-uses" compiled-crossref (compiled-unxref) ]
+    [ "compiled-generic-uses" compiled-generic-crossref (compiled-unxref) ]
+    bi ;
 
 : delete-compiled-xref ( word -- )
-    dup compiled-unxref
-    compiled-crossref get delete-at ;
+    [ compiled-unxref ]
+    [ compiled-crossref get delete-at ]
+    [ compiled-generic-crossref get delete-at ]
+    tri ;
 
-GENERIC: redefined ( word -- )
+GENERIC: inline? ( word -- ? )
 
-M: object redefined drop ;
+M: word inline? "inline" word-prop ;
+
+SYMBOL: visited
+
+: reset-on-redefine { "inferred-effect" "cannot-infer" } ; inline
+
+: (redefined) ( word -- )
+    dup visited get key? [ drop ] [
+        [ reset-on-redefine reset-props ]
+        [ visited get conjoin ]
+        [
+            crossref get at keys
+            [ word? ] filter
+            [
+                [ reset-on-redefine [ word-prop ] with contains? ]
+                [ inline? ]
+                bi or
+            ] filter
+            [ (redefined) ] each
+        ] tri
+    ] if ;
+
+: redefined ( word -- )
+    [ H{ } clone visited [ (redefined) ] with-variable ]
+    [ changed-definition ]
+    bi ;
 
 : define ( word def -- )
     [ ] like
     over unxref
     over redefined
     >>def
-    dup inlined-dependency changed-definition
     dup crossref? [ dup xref ] when drop ;
 
 : set-stack-effect ( effect word -- )
     2dup "declared-effect" word-prop = [ 2drop ] [
         swap
         [ "declared-effect" set-word-prop ]
-        [
-            drop
-            dup primitive? [ drop ] [
-                [ redefined ] [ inlined-dependency changed-definition ] bi
-            ] if
-        ] 2bi
+        [ drop dup primitive? [ dup redefined ] unless drop ] 2bi
     ] if ;
 
 : define-declared ( word def effect -- )
@@ -211,10 +245,6 @@ ERROR: bad-create name vocab ;
 : constructor-word ( name vocab -- word )
     >r "<" swap ">" 3append r> create ;
 
-GENERIC: inline? ( word -- ? )
-
-M: word inline? "inline" word-prop ;
-
 PREDICATE: parsing-word < word "parsing" word-prop ;
 
 : delimiter? ( obj -- ? )