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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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 kernel.private math optimizer prettyprint sequences sbufs
strings tools.test vectors words sequences.private quotations strings tools.test vectors words sequences.private quotations
optimizer.backend classes inference.dataflow tuples.private optimizer.backend classes inference.dataflow tuples.private
continuations ; continuations growable ;
IN: temporary IN: temporary
[ H{ { 1 5 } { 3 4 } { 2 5 } } ] [ [ H{ { 1 5 } { 3 4 } { 2 5 } } ] [
@ -291,3 +291,12 @@ TUPLE: silly-tuple a b ;
: construct-empty-bug construct-empty ; : construct-empty-bug construct-empty ;
[ ] [ [ construct-empty ] dataflow optimize drop ] unit-test [ ] [ [ 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 ax ;
[ \ bx forget ] with-compilation-unit [ \ 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 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 ) : dispatching-class ( node word -- class )
[ dispatch# node-class# ] keep specific-method ; [ 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 ; ] map sum ;
: flat-length ( seq -- n )
[ word-def (flat-length) ] with-scope ;
: will-inline-method ( node word -- method-spec/t quot/t ) : will-inline-method ( node word -- method-spec/t quot/t )
#! t indicates failure #! t indicates failure
tuck dispatching-class dup [ tuck dispatching-class dup [
swap [ 2array ] 2keep swap [ 2array ] 2keep
method method-word method method-word
dup word-def flat-length 5 >= dup flat-length 10 >=
[ 1quotation ] [ word-def ] if [ 1quotation ] [ word-def ] if
] [ ] [
2drop t t 2drop t t