Improving method inlining change, but there's still a bug
parent
19a44d65df
commit
f1d7a4e663
basis/compiler/tree/propagation
inlining
transforms
|
@ -47,36 +47,29 @@ M: callable splicing-nodes splicing-body ;
|
|||
] if
|
||||
] [ 2drop undo-inlining ] if ;
|
||||
|
||||
ERROR: bad-splitting class generic ;
|
||||
|
||||
:: split-code ( class generic -- quot/f )
|
||||
class generic method-for-class :> method
|
||||
method [
|
||||
class generic method-for-class
|
||||
[ class generic bad-splitting ] unless
|
||||
[
|
||||
dup class instance?
|
||||
[ method execute ]
|
||||
[ generic execute ]
|
||||
[ 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 ;
|
||||
|
||||
:: find-method-call ( class generic -- subclass/f ? )
|
||||
object generic method-classes
|
||||
[| last-class new-class |
|
||||
class new-class classes-intersect? [
|
||||
class new-class class<=
|
||||
[ object f ] [
|
||||
last-class new-class class-min
|
||||
] if
|
||||
] [ last-class t ] if
|
||||
] all? ;
|
||||
:: find-method-call ( 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 ;
|
||||
|
||||
:: split-method-call ( class generic -- quot/f )
|
||||
class object = [ f ] [
|
||||
class generic find-method-call
|
||||
[ generic split-code ] [ drop f ] if
|
||||
] if ;
|
||||
class generic find-method-call
|
||||
[ generic split-code ] [ f ] if* ;
|
||||
|
||||
: inlining-standard-method ( #call word -- class/f method/f )
|
||||
dup "methods" word-prop assoc-empty? [ 2drop f f ] [
|
||||
|
|
|
@ -142,14 +142,18 @@ IN: compiler.tree.propagation.transforms
|
|||
] "custom-inlining" set-word-prop
|
||||
|
||||
:: inline-instance ( node -- quot/f )
|
||||
node in-d>> first2 [ value-info ] bi@ literal>> :> ( obj klass )
|
||||
klass class? [
|
||||
node in-d>> first2 [ value-info ] bi@ literal>> :> ( obj class )
|
||||
class class? [
|
||||
{
|
||||
[ klass \ f = not ]
|
||||
[ obj class>> \ f class-not class-and klass class<= ]
|
||||
} 0&&
|
||||
[ [ drop >boolean ] ]
|
||||
[ klass "predicate" word-prop '[ drop @ ] ] if
|
||||
[ class \ f = not ]
|
||||
[ obj class>> \ f class-not class-and class class<= ]
|
||||
} 0&& [
|
||||
! TODO: replace this with an implicit null check when
|
||||
! profitable, once Factor gets OSR implemented
|
||||
[ drop >boolean ]
|
||||
] [
|
||||
class "predicate" word-prop '[ drop @ ]
|
||||
] if
|
||||
] [ f ] if ;
|
||||
|
||||
\ instance? [ inline-instance ] "custom-inlining" set-word-prop
|
||||
|
|
Loading…
Reference in New Issue