diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index e6c63f149a..2f1e7fe9c6 100644 --- 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>> ] [ [ 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>> ] [ [ 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 d083b39b5b..c1be90a13a 100644 --- 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 ] 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 5a73867006..ba6043a13a 100644 --- 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 ( -- )