steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixing optimization for improved method inlining

db4
Daniel Ehrenberg 2010-04-19 16:37:35 -05:00
parent 02bd3d7142
commit 416707f327
2 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
basis/compiler/tree/propagation/inlining/inlining.factor
View File

@ -55,18 +55,23 @@ M: callable splicing-nodes splicing-body ;
[ generic no-method ] if [ generic no-method ] if
] and ; ] 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 ) :: split-method-call ( class generic -- quot/f )
class object = [ f ] [ class object = [ f ] [
object generic method-classes object generic method-classes
[| last-class new-class | [| last-class new-class |
class new-class classes-intersect? [ class new-class classes-intersect? [
new-class class class<= [ new-class class class<= [
last-class new-class class<= last-class new-class class-min
last-class new-class ? f ] [ object f ] if
] [ object t ] if ] [ last-class t ] if
] [ last-class f ] if ] all?
] any? [ generic split-code ] [ drop f ] if
[ drop f ] [ generic split-code ] if
] if ; ] if ;
: inlining-standard-method ( #call word -- class/f method/f ) : inlining-standard-method ( #call word -- class/f method/f )

5
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -693,7 +693,7 @@ M: fixnum bad-generic 1 fixnum+fast ; inline
[ V{ fixnum } ] [ [ bad-behavior ] final-classes ] unit-test [ V{ fixnum } ] [ [ bad-behavior ] final-classes ] unit-test
[ V{ number } ] [ [ V{ integer } ] [
[ [
0 10 [ bad-generic dup 123 bitand drop bad-generic 1 + ] times 0 10 [ bad-generic dup 123 bitand drop bad-generic 1 + ] times
] final-classes ] final-classes
@ -994,3 +994,6 @@ UNION: ?fixnum fixnum POSTPONE: f ;
[ t ] [ 1 instance-test-2 ] unit-test [ t ] [ 1 instance-test-2 ] unit-test
[ f ] [ 1.1 instance-test-2 ] unit-test [ f ] [ 1.1 instance-test-2 ] unit-test
[ t ] [ f instance-test-3 ] 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