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

Better inlining heuristic

db4
Slava Pestov 2008-02-06 14:59:53 -06:00
parent 31b863f8b2
commit b18a463285
3 changed files with 29 additions and 6 deletions
core
compiler/test
optimizer/backend

11
core/compiler/test/optimizer.factor
View File

@ -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

2
core/compiler/test/redefine.factor
View File

@ -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

22
core/optimizer/backend/backend.factor
View File

@ -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