Improving method inlining change, but there's still a bug

db4
Daniel Ehrenberg 2010-04-24 19:46:12 -05:00
parent 19a44d65df
commit f1d7a4e663
2 changed files with 28 additions and 31 deletions

View File

@ -47,36 +47,29 @@ M: callable splicing-nodes splicing-body ;
] if ] if
] [ 2drop undo-inlining ] if ; ] [ 2drop undo-inlining ] if ;
ERROR: bad-splitting class generic ;
:: split-code ( class generic -- quot/f ) :: split-code ( class generic -- quot/f )
class generic method-for-class :> method class generic method-for-class
method [ [ class generic bad-splitting ] unless
[
dup class instance? dup class instance?
[ method execute ] [ generic execute ]
[ generic no-method ] if [ generic no-method ] if
] and ; ] ;
: class-min ( class1 class2 -- class/f ? ) :: find-method-call ( class generic -- subclass/f )
2dup class<= [ drop t ] [ generic method-classes [ f ] [
2dup swap class<= f swap [| last-class new-class |
[ nip t ] [ 2drop f f ] if
] if ;
:: find-method-call ( class generic -- subclass/f ? )
object generic method-classes
[| last-class new-class |
class new-class classes-intersect? [ class new-class classes-intersect? [
class new-class class<= last-class [ f f ] [ new-class t ] if
[ object f ] [
last-class new-class class-min
] if
] [ last-class t ] if ] [ last-class t ] if
] all? ; ] all? swap and
] if-empty ;
:: split-method-call ( class generic -- quot/f ) :: split-method-call ( class generic -- quot/f )
class object = [ f ] [
class generic find-method-call class generic find-method-call
[ generic split-code ] [ drop f ] if [ generic split-code ] [ f ] if* ;
] if ;
: inlining-standard-method ( #call word -- class/f method/f ) : inlining-standard-method ( #call word -- class/f method/f )
dup "methods" word-prop assoc-empty? [ 2drop f f ] [ dup "methods" word-prop assoc-empty? [ 2drop f f ] [

View File

@ -142,14 +142,18 @@ IN: compiler.tree.propagation.transforms
] "custom-inlining" set-word-prop ] "custom-inlining" set-word-prop
:: inline-instance ( node -- quot/f ) :: inline-instance ( node -- quot/f )
node in-d>> first2 [ value-info ] bi@ literal>> :> ( obj klass ) node in-d>> first2 [ value-info ] bi@ literal>> :> ( obj class )
klass class? [ class class? [
{ {
[ klass \ f = not ] [ class \ f = not ]
[ obj class>> \ f class-not class-and klass class<= ] [ obj class>> \ f class-not class-and class class<= ]
} 0&& } 0&& [
[ [ drop >boolean ] ] ! TODO: replace this with an implicit null check when
[ klass "predicate" word-prop '[ drop @ ] ] if ! profitable, once Factor gets OSR implemented
[ drop >boolean ]
] [
class "predicate" word-prop '[ drop @ ]
] if
] [ f ] if ; ] [ f ] if ;
\ instance? [ inline-instance ] "custom-inlining" set-word-prop \ instance? [ inline-instance ] "custom-inlining" set-word-prop