Adding dependency checking and proper handing of dispatch# to the new method inlining

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -182,11 +182,16 @@ M: fixnum annotate-entry-test-1 drop ;
 
 : annotate-entry-test-2 ( from to -- obj ) 0 -rot (annotate-entry-test-2) ; inline
 
-[ f ] [
+[ t ] [
     [ { bignum } declare annotate-entry-test-2 ]
     \ annotate-entry-test-1 inlined?
 ] unit-test
 
+[ f ] [
+    [ { bignum } declare annotate-entry-test-2 ]
+    M\ fixnum annotate-entry-test-1 inlined?
+] unit-test
+
 [ t ] [
     [ { float } declare 10 [ 2.3 * ] times >float ]
     \ >float inlined?

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -5,6 +5,7 @@ math.partial-dispatch generic generic.standard generic.single generic.math
 classes.algebra classes.union sets quotations assocs combinators
 combinators.short-circuit words namespaces continuations classes
 fry hints locals
+stack-checker.dependencies
 compiler.tree
 compiler.tree.builder
 compiler.tree.recursive
@@ -50,26 +51,20 @@ M: callable splicing-nodes splicing-body ;
 ERROR: bad-splitting class generic ;
 
 :: split-code ( class generic -- quot/f )
-    class generic method-for-class
-    [ class generic bad-splitting ] unless
+    class generic method-for-class :> method
+    method [ class generic bad-splitting ] unless
+    generic dispatch# (picker) :> picker
     [
-        dup class instance?
-        [ generic execute ]
+        picker call class instance?
+        [ method execute ]
         [ generic no-method ] if
     ] ;
 
-:: find-method-call ( class generic -- subclass/f )
-    generic method-classes [ f ] [
-        f swap [| last-class new-class |
-            class new-class classes-intersect? [
-                last-class [ f f ] [ new-class t ] if
-            ] [ last-class t ] if
-        ] all? swap and
-    ] if-empty ;
-
 :: split-method-call ( class generic -- quot/f )
-    class generic find-method-call
-    [ generic split-code ] [ f ] if* ;
+    class generic subclass-with-only-method [
+        class generic depends-on-single-method
+        generic split-code
+    ] [ f ] if* ;
 
 : inlining-standard-method ( #call word -- class/f method/f )
     dup "methods" word-prop assoc-empty? [ 2drop f f ] [

basis/compiler/tree/propagation/propagation-tests.factor

@@ -9,7 +9,7 @@ compiler.tree.debugger compiler.tree.checker slots.private words
 hashtables classes assocs locals specialized-arrays system
 sorting math.libm math.floats.private math.integers.private
 math.intervals quotations effects alien alien.data sets
-strings.private ;
+strings.private classes.tuple ;
 FROM: math => float ;
 SPECIALIZED-ARRAY: double
 SPECIALIZED-ARRAY: void*
@@ -863,11 +863,11 @@ TUPLE: foo bar ;
 GENERIC: whatever ( x -- y )
 M: number whatever drop foo ; inline
 
-[ t ] [ [ 1 whatever new ] { new } inlined? ] unit-test
+[ t ] [ [ 1 whatever new ] { new } M\ tuple-class new suffix inlined? ] unit-test
 
 : that-thing ( -- class ) foo ;
 
-[ f ] [ [ that-thing new ] { new } inlined? ] unit-test
+[ f ] [ [ that-thing new ] { new } M\ tuple-class new suffix inlined? ] unit-test
 
 GENERIC: whatever2 ( x -- y )
 M: number whatever2 drop H{ { 1 1 } { 2 2 } { 3 3 } { 4 4 } { 5 6 } } ; inline

basis/stack-checker/dependencies/dependencies.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs accessors classes classes.algebra fry
 generic kernel math namespaces sequences words sets
-combinators.short-circuit classes.tuple alien.c-types ;
+combinators.short-circuit classes.tuple alien.c-types
+locals ;
 FROM: classes.tuple.private => tuple-layout ;
 FROM: assocs => change-at ;
 FROM: namespaces => set ;
@@ -144,6 +145,24 @@ TUPLE: depends-on-final class ;
 M: depends-on-final satisfied?
     class>> { [ class? ] [ final-class? ] } 1&& ;
 
+TUPLE: depends-on-single-method class generic ;
+
+: depends-on-single-method ( class generic -- )
+    [ nip depends-on-conditionally ]
+    [ \ depends-on-single-method add-conditional-dependency ] 2bi ;
+
+:: subclass-with-only-method ( class generic -- subclass/f )
+    generic method-classes [ f ] [
+        f swap [| last-class new-class |
+            class new-class classes-intersect? [
+                last-class [ f f ] [ new-class t ] if
+            ] [ last-class t ] if
+        ] all? swap and
+    ] if-empty ;
+
+M: depends-on-single-method satisfied?
+    [ class>> ] [ generic>> ] bi subclass-with-only-method >boolean ;
+
 : init-dependencies ( -- )
     H{ } clone dependencies set
     H{ } clone generic-dependencies set