diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index ad3de5d8f7..07ff719d09 100644 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/basis/compiler/tree/propagation/inlining/inlining.factor @@ -55,18 +55,23 @@ M: callable splicing-nodes splicing-body ; [ generic no-method ] if ] and ; +: class-min ( class1 class2 -- class/f ? ) + 2dup class<= [ drop t ] [ + 2dup swap class<= + [ nip t ] [ 2drop f f ] if + ] if ; + :: split-method-call ( class generic -- quot/f ) class object = [ f ] [ object generic method-classes [| last-class new-class | class new-class classes-intersect? [ new-class class class<= [ - last-class new-class class<= - last-class new-class ? f - ] [ object t ] if - ] [ last-class f ] if - ] any? - [ drop f ] [ generic split-code ] if + last-class new-class class-min + ] [ object f ] if + ] [ last-class t ] if + ] all? + [ generic split-code ] [ drop f ] if ] if ; : inlining-standard-method ( #call word -- class/f method/f ) diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 8c470bf6a2..4fc623b7dc 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -693,7 +693,7 @@ M: fixnum bad-generic 1 fixnum+fast ; inline [ V{ fixnum } ] [ [ bad-behavior ] final-classes ] unit-test -[ V{ number } ] [ +[ V{ integer } ] [ [ 0 10 [ bad-generic dup 123 bitand drop bad-generic 1 + ] times ] final-classes @@ -994,3 +994,6 @@ UNION: ?fixnum fixnum POSTPONE: f ; [ t ] [ 1 instance-test-2 ] unit-test [ f ] [ 1.1 instance-test-2 ] unit-test [ t ] [ f instance-test-3 ] unit-test + +[ t ] [ [ { ?fixnum } declare >fixnum ] { >fixnum } inlined? ] unit-test +[ f ] [ [ { integer } declare >fixnum ] { >fixnum } inlined? ] unit-test