Work in progress: record constant-folds of predicate words, and call-next-method invocations, in the same way that method inlining are recorded, for greater recompilation accuracy

basis/compiler/tests/redefine10.factor

@@ -1,19 +1,39 @@
-USING: eval tools.test compiler.units vocabs words kernel ;
+USING: eval tools.test compiler.units vocabs words kernel
+definitions sequences ;
 IN: compiler.tests.redefine10
 
-! Mixin redefinition did not recompile all necessary words.
-
-[ ] [ [ "compiler.tests.redefine10" forget-vocab ] with-compilation-unit ] unit-test
+! Mixin redefinition should update predicate call sites
 
 [ ] [
     "USING: kernel math classes ;
     IN: compiler.tests.redefine10
     MIXIN: my-mixin
     INSTANCE: fixnum my-mixin
-    : my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ;"
+    : my-inline-1 ( a -- b ) dup my-mixin instance? [ 1 + ] when ;
+    : my-inline-2 ( a -- b ) dup my-mixin? [ 1 + ] when ;
+    : my-inline-3 ( a -- b ) dup my-mixin? [ float? ] [ drop f ] if ;
+    : my-inline-4 ( a -- b ) dup float? [ my-mixin? ] [ drop f ] if ;
+    : my-inline-5 ( a -- b ) dup my-mixin? [ fixnum? ] [ drop f ] if ;
+    : my-inline-6 ( a -- b ) dup fixnum? [ my-mixin? ] [ drop f ] if ;"
     eval( -- )
 ] unit-test
 
+[ f ] [
+    5 "my-inline-3" "compiler.tests.redefine10" lookup execute
+] unit-test
+
+[ f ] [
+    5 "my-inline-4" "compiler.tests.redefine10" lookup execute
+] unit-test
+
+[ t ] [
+    5 "my-inline-5" "compiler.tests.redefine10" lookup execute
+] unit-test
+
+[ t ] [
+    5 "my-inline-6" "compiler.tests.redefine10" lookup execute
+] unit-test
+
 [ ] [
     "USE: math
     IN: compiler.tests.redefine10
@@ -22,5 +42,31 @@ IN: compiler.tests.redefine10
 ] unit-test
 
 [ 2.0 ] [
-    1.0 "my-inline" "compiler.tests.redefine10" lookup execute
+    1.0 "my-inline-1" "compiler.tests.redefine10" lookup execute
 ] unit-test
+
+[ 2.0 ] [
+    1.0 "my-inline-2" "compiler.tests.redefine10" lookup execute
+] unit-test
+
+[ t ] [
+    1.0 "my-inline-3" "compiler.tests.redefine10" lookup execute
+] unit-test
+
+[ t ] [
+    1.0 "my-inline-4" "compiler.tests.redefine10" lookup execute
+] unit-test
+
+[ f ] [
+    1.0 "my-inline-5" "compiler.tests.redefine10" lookup execute
+] unit-test
+
+[ f ] [
+    1.0 "my-inline-6" "compiler.tests.redefine10" lookup execute
+] unit-test
+
+[
+    {
+        "my-mixin" "my-inline-1" "my-inline-2"
+    } [ "compiler.tests.redefine10" lookup forget ] each
+] with-compilation-unit

basis/compiler/tests/redefine19.factor

@@ -0,0 +1,23 @@
+USING: kernel classes.mixin compiler.units tools.test generic ;
+IN: compiler.tests.redefine19
+
+GENERIC: g ( a -- b )
+
+MIXIN: m1 M: m1 g drop 1 ;
+MIXIN: m2 M: m2 g drop 2 ;
+
+TUPLE: c ;
+
+INSTANCE: c m2
+
+: foo ( -- b ) c new g ;
+
+[ 2 ] [ foo ] unit-test
+
+[ ] [ [ c m1 add-mixin-instance ] with-compilation-unit ] unit-test
+
+[ { m2 m1 } ] [ \ g order ] unit-test
+
+[ 1 ] [ foo ] unit-test
+
+[ ] [ [ c m1 remove-mixin-instance ] with-compilation-unit ] unit-test

basis/compiler/tests/redefine20.factor

@@ -0,0 +1,23 @@
+IN: compiler.tests.redefine20
+USING: kernel sequences compiler.units definitions classes.mixin
+tools.test ;
+
+GENERIC: cnm-recompile-test ( a -- b )
+
+M: object cnm-recompile-test drop object ;
+
+M: sequence cnm-recompile-test drop sequence ;
+
+TUPLE: funny ;
+
+M: funny cnm-recompile-test call-next-method ;
+
+[ object ] [ funny new cnm-recompile-test ] unit-test
+
+[ ] [ [ funny sequence add-mixin-instance ] with-compilation-unit ] unit-test
+
+[ sequence ] [ funny new cnm-recompile-test ] unit-test
+
+[ ] [ [ funny sequence remove-mixin-instance ] with-compilation-unit ] unit-test
+
+[ object ] [ funny new cnm-recompile-test ] unit-test

basis/compiler/tree/cleanup/cleanup.factor

@@ -36,24 +36,34 @@ GENERIC: cleanup* ( node -- node/nodes )
     #! do it since the logic is a bit more involved
     [ cleanup* ] map-flat ;
 
+! Constant folding
 : cleanup-folding? ( #call -- ? )
     node-output-infos
     [ f ] [ [ literal?>> ] all? ] if-empty ;
 
-: cleanup-folding ( #call -- nodes )
+: (cleanup-folding) ( #call -- nodes )
     #! Replace a #call having a known result with a #drop of its
     #! inputs followed by #push nodes for the outputs.
-    [ word>> inlined-dependency depends-on ]
     [
         [ node-output-infos ] [ out-d>> ] bi
         [ [ literal>> ] dip #push ] 2map
     ]
     [ in-d>> #drop ]
-    tri prefix ;
+    bi prefix ;
 
+: record-folding ( #call -- )
+    dup word>> predicate?
+    [ [ node-input-infos first class>> ] [ word>> ] bi depends-on-generic ]
+    [ word>> inlined-dependency depends-on ]
+    if ;
+
+: cleanup-folding ( #call -- nodes )
+    [ (cleanup-folding) ] [ record-folding ] bi ;
+
+! Method inlining
 : add-method-dependency ( #call -- )
     dup method>> word? [
-        [ word>> ] [ class>> ] bi depends-on-generic
+        [ class>> ] [ word>> ] bi depends-on-generic
     ] [ drop ] if ;
 
 : cleanup-inlining ( #call -- nodes )

basis/stack-checker/dependencies/dependencies.factor

@@ -29,9 +29,9 @@ SYMBOLS: inlined-dependency flushed-dependency called-dependency ;
 ! Generic words that the current quotation depends on
 SYMBOL: generic-dependencies
 
-: ?class-or ( class/f class -- class' )
-    swap [ class-or ] when* ;
+: ?class-or ( class class/f -- class' )
+    [ class-or ] when* ;
 
-: depends-on-generic ( generic class -- )
+: depends-on-generic ( class generic -- )
     generic-dependencies get dup
-    [ swap '[ _ ?class-or ] change-at ] [ 3drop ] if ;
+    [ [ ?class-or ] change-at ] [ 3drop ] if ;

basis/stack-checker/transforms/transforms.factor

@@ -128,7 +128,7 @@ IN: stack-checker.transforms
     [
         [ "method-class" word-prop ]
         [ "method-generic" word-prop ] bi
-        [ inlined-dependency depends-on ] bi@
+        depends-on-generic
     ] [
         [ next-method-quot ]
         [ '[ _ no-next-method ] ] bi or

core/compiler/units/units.factor

@@ -45,13 +45,17 @@ SYMBOL: compiler-impl
 
 HOOK: update-call-sites compiler-impl ( class generic -- words )
 
+: changed-call-sites ( class generic -- )
+    update-call-sites [ changed-definition ] each ;
+
 M: generic update-generic ( class generic -- )
-    [ update-call-sites [ changed-definition ] each ]
+    [ changed-call-sites ]
     [ remake-generic drop ]
     2bi ;
 
 M: sequence update-methods ( class seq -- )
-    implementors [ update-generic ] with each ;
+    [ [ predicate-word changed-call-sites ] with each ]
+    [ implementors [ update-generic ] with each ] 2bi ;
 
 HOOK: recompile compiler-impl ( words -- alist )