Inlining no-method when a generic word has no method

diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index e6c63f149ad827bef29e21ac0f112097e56c8d67..2f1e7fe9c677ac423dc6e3faf2e5fb7bcb940a84 100644 (file)
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -48,12 +48,12 @@ M: callable splicing-nodes splicing-body ;
         ] if
     ] [ 2drop undo-inlining ] if ;
 
-ERROR: bad-splitting class generic ;
+ERROR: bad-guarded-method-call class generic ;
 
-:: split-code ( class generic -- quot/f )
+:: guard-code ( class generic -- quot/f )
     class generic method :> my-method
-    my-method [ class generic bad-splitting ] unless
-    class generic my-method depends-on-method-is
+    my-method [ class generic bad-guarded-method-call ] unless
+    class generic my-method depends-on-method-identity
     generic dispatch# (picker) :> picker
     [
         picker call class instance?
@@ -61,19 +61,20 @@ ERROR: bad-splitting class generic ;
         [ generic no-method ] if
     ] ;
 
-:: split-method-call ( class generic -- quot/f )
+:: guarded-method-call ( class generic -- quot/f )
     class generic subclass-with-only-method [
-        [ class generic depends-on-single-method ]
-        [ generic split-code ] bi
+        [ class generic depends-on-single-method ] [
+            dup +no-method+ =
+            [ drop [ generic no-method ] ]
+            [ generic guard-code ] if
+        ] bi
     ] [ f ] if* ;
 
 : inlining-standard-method ( #call word -- class/f method/f )
-    dup "methods" word-prop assoc-empty? [ 2drop f f ] [
-        2dup [ in-d>> length ] [ dispatch# ] bi* <= [ 2drop f f ] [
-            [ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
-            [ swap nth value-info class>> dup ] dip
-            { [ method-for-class ] [ split-method-call ] } 2||
-        ] if
+    2dup [ in-d>> length ] [ dispatch# ] bi* <= [ 2drop f f ] [
+        [ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
+        [ swap nth value-info class>> dup ] dip
+        { [ method-for-class ] [ guarded-method-call ] } 2||
     ] if ;
 
 : inline-standard-method ( #call word -- ? )

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index d083b39b5bc98d14c4224d60fdabc0b7cb9ecada..c1be90a13a5efda14c3f363c48f97837cea404b2 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/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 classes.tuple eval ;
+strings.private classes.tuple eval generic.single ;
 FROM: math => float ;
 SPECIALIZED-ARRAY: double
 SPECIALIZED-ARRAY: void*
@@ -878,7 +878,8 @@ M: f whatever2 ; inline
 
 SYMBOL: not-an-assoc
 
-[ f ] [ [ not-an-assoc at ] { at* } inlined? ] unit-test
+[ t ] [ [ not-an-assoc at ] { at* } inlined? ] unit-test
+[ f ] [ [ not-an-assoc at ] { no-method } inlined? ] unit-test
 
 [ t ] [ [ { 1 2 3 } member? ] { member? } inlined? ] unit-test
 [ f ] [ [ { 1 2 3 } swap member? ] { member? } inlined? ] unit-test
@@ -890,7 +891,8 @@ SYMBOL: not-an-assoc
 [ f ] [ [ { } clone ] { clone (clone) } inlined? ] unit-test
 
 [ f ] [ [ instance? ] { instance? } inlined? ] unit-test
-[ f ] [ [ 5 instance? ] { instance? } inlined? ] unit-test
+[ t ] [ [ 5 instance? ] { instance? } inlined? ] unit-test
+[ f ] [ [ 5 instance? ] { no-method } inlined? ] unit-test
 [ t ] [ [ array instance? ] { instance? } inlined? ] unit-test
 
 [ t ] [ [ (( a b c -- c b a )) shuffle ] { shuffle } inlined? ] unit-test
@@ -1034,3 +1036,9 @@ UNION: ?fixnum fixnum POSTPONE: f ;
 [ V{ alien } ] [
     [ { byte-array } declare [ 10 bitand 2 + ] dip <displaced-alien> ] final-classes
 ] unit-test
+
+! Ensuring that calling a generic word on a class where it's undefined inlines no-method
+GENERIC: undefined-generic-test ( x -- y )
+
+[ t ] [ [ 1 undefined-generic-test ] { undefined-generic-test } inlined? ] unit-test
+[ f ] [ [ 1 undefined-generic-test ] { no-method } inlined? ] unit-test

diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor
index 5a7386700643a3236b48ea88887a5260427f331e..ba6043a13a911ad3a327566414e7b37c17b5f89d 100644 (file)
--- a/basis/stack-checker/dependencies/dependencies.factor
+++ b/basis/stack-checker/dependencies/dependencies.factor
@@ -151,26 +151,28 @@ TUPLE: depends-on-single-method method-class object-class generic ;
     [ nip [ depends-on-conditionally ] bi@ ]
     [ \ depends-on-single-method add-conditional-dependency ] 3bi ;
 
-:: 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 ;
+SYMBOL: +no-method+
+
+:: subclass-with-only-method ( class generic -- subclass/f/+no-method+ ) ! make it return +no-method+ sometimes
+    f generic method-classes
+    [| last-class new-class |
+        class new-class classes-intersect? [
+            last-class [ f f ] [ new-class t ] if
+        ] [ last-class t ] if
+    ] all?
+    [ +no-method+ or ] [ drop f ] if ;
 
 M: depends-on-single-method satisfied?
     [ method-class>> ] [ object-class>> ] [ generic>> ] tri
     subclass-with-only-method = ;
 
-TUPLE: depends-on-method-is class generic method ;
+TUPLE: depends-on-method-identity class generic method ;
 
-: depends-on-method-is ( class generic method -- )
+: depends-on-method-identity ( class generic method -- )
     [ [ depends-on-conditionally ] tri@ ]
-    [ \ depends-on-method-is add-conditional-dependency ] 3bi ;
+    [ \ depends-on-method-identity add-conditional-dependency ] 3bi ;
 
-M: depends-on-method-is satisfied?
+M: depends-on-method-identity satisfied?
     [ class>> ] [ generic>> method ] [ method>> ] tri = ;
 
 : init-dependencies ( -- )