Better inlining heuristic
parent
31b863f8b2
commit
b18a463285
|
@ -2,7 +2,7 @@ USING: arrays compiler generic hashtables inference kernel
|
|||
kernel.private math optimizer prettyprint sequences sbufs
|
||||
strings tools.test vectors words sequences.private quotations
|
||||
optimizer.backend classes inference.dataflow tuples.private
|
||||
continuations ;
|
||||
continuations growable ;
|
||||
IN: temporary
|
||||
|
||||
[ H{ { 1 5 } { 3 4 } { 2 5 } } ] [
|
||||
|
@ -291,3 +291,12 @@ TUPLE: silly-tuple a b ;
|
|||
: construct-empty-bug construct-empty ;
|
||||
|
||||
[ ] [ [ construct-empty ] dataflow optimize drop ] unit-test
|
||||
|
||||
! Make sure we have sane heuristics
|
||||
: should-inline? method method-word flat-length 10 <= ;
|
||||
|
||||
[ t ] [ \ fixnum \ shift should-inline? ] unit-test
|
||||
[ f ] [ \ array \ equal? should-inline? ] unit-test
|
||||
[ f ] [ \ sequence \ hashcode* should-inline? ] unit-test
|
||||
[ t ] [ \ array \ nth-unsafe should-inline? ] unit-test
|
||||
[ t ] [ \ growable \ nth-unsafe should-inline? ] unit-test
|
||||
|
|
|
@ -235,7 +235,7 @@ DEFER: flushable-test-2
|
|||
: bx ax ;
|
||||
[ \ bx forget ] with-compilation-unit
|
||||
|
||||
[ f ] [ \ bx \ ax compiled-usage contains? ] unit-test
|
||||
[ f ] [ \ bx \ ax compiled-usage key? ] unit-test
|
||||
|
||||
DEFER: defer-redefine-test-2
|
||||
|
||||
|
|
|
@ -245,18 +245,32 @@ M: #dispatch optimize-node*
|
|||
: dispatching-class ( node word -- class )
|
||||
[ dispatch# node-class# ] keep specific-method ;
|
||||
|
||||
: flat-length ( seq -- n )
|
||||
! A heuristic to avoid excessive inlining
|
||||
DEFER: (flat-length)
|
||||
|
||||
: word-flat-length ( word -- n )
|
||||
dup get over inline? not or
|
||||
[ drop 1 ] [ dup dup set word-def (flat-length) ] if ;
|
||||
|
||||
: (flat-length) ( seq -- n )
|
||||
[
|
||||
dup quotation? over array? or
|
||||
[ flat-length ] [ drop 1 ] if
|
||||
{
|
||||
{ [ dup quotation? ] [ (flat-length) 1+ ] }
|
||||
{ [ dup array? ] [ (flat-length) ] }
|
||||
{ [ dup word? ] [ word-flat-length ] }
|
||||
{ [ t ] [ drop 1 ] }
|
||||
} cond
|
||||
] map sum ;
|
||||
|
||||
: flat-length ( seq -- n )
|
||||
[ word-def (flat-length) ] with-scope ;
|
||||
|
||||
: will-inline-method ( node word -- method-spec/t quot/t )
|
||||
#! t indicates failure
|
||||
tuck dispatching-class dup [
|
||||
swap [ 2array ] 2keep
|
||||
method method-word
|
||||
dup word-def flat-length 5 >=
|
||||
dup flat-length 10 >=
|
||||
[ 1quotation ] [ word-def ] if
|
||||
] [
|
||||
2drop t t
|
||||
|
|
Loading…
Reference in New Issue