compiler.tree.propagation: remove method inlining heuristic

db4
Slava Pestov 2009-08-17 22:29:05 -05:00
parent 630ffb8ae6
commit 3047d4a451
5 changed files with 28 additions and 107 deletions

View File

@ -41,13 +41,13 @@ IN: compiler.tree.cleanup.tests
GENERIC: mynot ( x -- y ) GENERIC: mynot ( x -- y )
M: f mynot drop t ; M: f mynot drop t ; inline
M: object mynot drop f ; M: object mynot drop f ; inline
GENERIC: detect-f ( x -- y ) GENERIC: detect-f ( x -- y )
M: f detect-f ; M: f detect-f ; inline
[ t ] [ [ t ] [
[ dup [ mynot ] [ ] if detect-f ] \ detect-f inlined? [ dup [ mynot ] [ ] if detect-f ] \ detect-f inlined?
@ -55,9 +55,9 @@ M: f detect-f ;
GENERIC: xyz ( n -- n ) GENERIC: xyz ( n -- n )
M: integer xyz ; M: integer xyz ; inline
M: object xyz ; M: object xyz ; inline
[ t ] [ [ t ] [
[ { integer } declare xyz ] \ xyz inlined? [ { integer } declare xyz ] \ xyz inlined?

View File

@ -153,7 +153,7 @@ ERROR: uninferable ;
: (value>quot) ( value-info -- quot ) : (value>quot) ( value-info -- quot )
dup class>> { dup class>> {
{ \ quotation [ literal>> dup remember-inlining '[ drop @ ] ] } { \ quotation [ literal>> dup add-to-history '[ drop @ ] ] }
{ \ curry [ { \ curry [
slots>> third (value>quot) slots>> third (value>quot)
'[ [ obj>> ] [ quot>> @ ] bi ] '[ [ obj>> ] [ quot>> @ ] bi ]

View File

@ -3,8 +3,8 @@
USING: accessors kernel arrays sequences math math.order USING: accessors kernel arrays sequences math math.order
math.partial-dispatch generic generic.standard generic.single generic.math math.partial-dispatch generic generic.standard generic.single generic.math
classes.algebra classes.union sets quotations assocs combinators classes.algebra classes.union sets quotations assocs combinators
words namespaces continuations classes fry combinators.smart hints combinators.short-circuit words namespaces continuations classes
locals fry hints locals
compiler.tree compiler.tree
compiler.tree.builder compiler.tree.builder
compiler.tree.recursive compiler.tree.recursive
@ -14,19 +14,6 @@ compiler.tree.propagation.info
compiler.tree.propagation.nodes ; compiler.tree.propagation.nodes ;
IN: compiler.tree.propagation.inlining IN: compiler.tree.propagation.inlining
! We count nodes up-front; if there are relatively few nodes,
! we are more eager to inline
SYMBOL: node-count
: count-nodes ( nodes -- n )
0 swap [ drop 1 + ] each-node ;
: compute-node-count ( nodes -- ) count-nodes node-count set ;
! We try not to inline the same word too many times, to avoid
! combinatorial explosion
SYMBOL: inlining-count
! Splicing nodes ! Splicing nodes
: splicing-call ( #call word -- nodes ) : splicing-call ( #call word -- nodes )
[ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ; [ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ;
@ -101,99 +88,28 @@ M: callable splicing-nodes splicing-body ;
dupd inlining-math-partial eliminate-dispatch ; dupd inlining-math-partial eliminate-dispatch ;
! Method body inlining ! Method body inlining
SYMBOL: recursive-calls
DEFER: (flat-length)
: word-flat-length ( word -- n )
{
! special-case
{ [ dup { dip 2dip 3dip } memq? ] [ drop 1 ] }
! not inline
{ [ dup inline? not ] [ drop 1 ] }
! recursive and inline
{ [ dup recursive-calls get key? ] [ drop 10 ] }
! inline
[ [ recursive-calls get conjoin ] [ def>> (flat-length) ] bi ]
} cond ;
: (flat-length) ( seq -- n )
[
{
{ [ dup quotation? ] [ (flat-length) 2 + ] }
{ [ dup array? ] [ (flat-length) ] }
{ [ dup word? ] [ word-flat-length ] }
[ drop 0 ]
} cond
] sigma ;
: flat-length ( word -- n )
H{ } clone recursive-calls [
[ recursive-calls get conjoin ]
[ def>> (flat-length) 5 /i ]
bi
] with-variable ;
: classes-known? ( #call -- ? )
in-d>> [
value-info class>>
[ class-types length 1 = ]
[ union-class? not ]
bi and
] any? ;
: node-count-bias ( -- n )
45 node-count get [-] 8 /i ;
: body-length-bias ( word -- n )
[ flat-length ] [ inlining-count get at 0 or ] bi
over 2 <= [ drop ] [ 2/ 1 + * ] if 24 swap [-] 4 /i ;
: inlining-rank ( #call word -- n )
[
[ classes-known? 2 0 ? ]
[
[ body-length-bias ]
[ "specializer" word-prop 1 0 ? ]
[ method-body? 1 0 ? ]
tri
node-count-bias
loop-nesting get 0 or 2 *
] bi*
] sum-outputs ;
: should-inline? ( #call word -- ? )
dup inline? [ 2drop t ] [ inlining-rank 5 >= ] if ;
SYMBOL: history SYMBOL: history
: already-inlined? ( obj -- ? ) history get memq? ; : already-inlined? ( obj -- ? ) history get memq? ;
: add-to-history ( obj -- ) history [ swap suffix ] change ; : add-to-history ( obj -- ) history [ swap suffix ] change ;
: remember-inlining ( word -- )
[ inlining-count get inc-at ]
[ add-to-history ]
bi ;
:: inline-word ( #call word -- ? ) :: inline-word ( #call word -- ? )
word already-inlined? [ f ] [ word already-inlined? [ f ] [
#call word splicing-body [ #call word splicing-body [
[ [
word remember-inlining word add-to-history
[ ] [ count-nodes ] [ (propagate) ] tri dup (propagate)
] with-scope ] with-scope
[ #call (>>body) ] [ node-count +@ ] bi* t #call (>>body) t
] [ f ] if* ] [ f ] if*
] if ; ] if ;
: inline-method-body ( #call word -- ? )
2dup should-inline? [ inline-word ] [ 2drop f ] if ;
: always-inline-word? ( word -- ? ) : always-inline-word? ( word -- ? )
{ curry compose } memq? ; { curry compose } memq? ;
: never-inline-word? ( word -- ? ) : never-inline-word? ( word -- ? )
[ deferred? ] [ "default" word-prop ] [ \ call eq? ] tri or or ; { [ deferred? ] [ "default" word-prop ] [ \ call eq? ] } 1|| ;
: custom-inlining? ( word -- ? ) : custom-inlining? ( word -- ? )
"custom-inlining" word-prop ; "custom-inlining" word-prop ;
@ -217,7 +133,7 @@ SYMBOL: history
{ [ dup always-inline-word? ] [ inline-word ] } { [ dup always-inline-word? ] [ inline-word ] }
{ [ dup standard-generic? ] [ inline-standard-method ] } { [ dup standard-generic? ] [ inline-standard-method ] }
{ [ dup math-generic? ] [ inline-math-method ] } { [ dup math-generic? ] [ inline-math-method ] }
{ [ dup method-body? ] [ inline-method-body ] } { [ dup inline? ] [ inline-word ] }
[ 2drop f ] [ 2drop f ]
} cond ; } cond ;

View File

@ -56,9 +56,9 @@ IN: compiler.tree.propagation.tests
[ float ] [ [ { float real } declare + ] final-math-class ] unit-test [ float ] [ [ { float real } declare + ] final-math-class ] unit-test
[ rational ] [ [ { ratio ratio } declare + ] final-math-class ] unit-test ! [ rational ] [ [ { ratio ratio } declare + ] final-math-class ] unit-test
[ rational ] [ [ { rational ratio } declare + ] final-math-class ] unit-test ! [ rational ] [ [ { rational ratio } declare + ] final-math-class ] unit-test
[ number ] [ [ { complex complex } declare + ] final-math-class ] unit-test [ number ] [ [ { complex complex } declare + ] final-math-class ] unit-test
@ -444,6 +444,13 @@ TUPLE: mixed-mutable-immutable { x integer } { y sequence read-only } ;
] final-classes ] final-classes
] unit-test ] unit-test
[ V{ f { } } ] [
[
T{ mixed-mutable-immutable f 3 { } }
[ x>> ] [ y>> ] bi
] final-literals
] unit-test
! Recursive propagation ! Recursive propagation
: recursive-test-1 ( a -- b ) recursive-test-1 ; inline recursive : recursive-test-1 ( a -- b ) recursive-test-1 ; inline recursive
@ -502,8 +509,8 @@ TUPLE: mixed-mutable-immutable { x integer } { y sequence read-only } ;
] unit-test ] unit-test
GENERIC: iterate ( obj -- next-obj ? ) GENERIC: iterate ( obj -- next-obj ? )
M: fixnum iterate f ; M: fixnum iterate f ; inline
M: array iterate first t ; M: array iterate first t ; inline
: dead-loop ( obj -- final-obj ) : dead-loop ( obj -- final-obj )
iterate [ dead-loop ] when ; inline recursive iterate [ dead-loop ] when ; inline recursive
@ -567,7 +574,7 @@ M: array iterate first t ;
] unit-test ] unit-test
GENERIC: bad-generic ( a -- b ) GENERIC: bad-generic ( a -- b )
M: fixnum bad-generic 1 fixnum+fast ; M: fixnum bad-generic 1 fixnum+fast ; inline
: bad-behavior ( -- b ) 4 bad-generic ; inline recursive : bad-behavior ( -- b ) 4 bad-generic ; inline recursive
[ V{ fixnum } ] [ [ bad-behavior ] final-classes ] unit-test [ V{ fixnum } ] [ [ bad-behavior ] final-classes ] unit-test
@ -740,7 +747,7 @@ TUPLE: foo bar ;
[ t ] [ [ foo new ] { new } inlined? ] unit-test [ t ] [ [ foo new ] { new } inlined? ] unit-test
GENERIC: whatever ( x -- y ) GENERIC: whatever ( x -- y )
M: number whatever drop foo ; M: number whatever drop foo ; inline
[ t ] [ [ 1 whatever new ] { new } inlined? ] unit-test [ t ] [ [ 1 whatever new ] { new } inlined? ] unit-test
@ -749,8 +756,8 @@ M: number whatever drop foo ;
[ f ] [ [ that-thing new ] { new } inlined? ] unit-test [ f ] [ [ that-thing new ] { new } inlined? ] unit-test
GENERIC: whatever2 ( x -- y ) GENERIC: whatever2 ( x -- y )
M: number whatever2 drop H{ { 1 1 } { 2 2 } { 3 3 } { 4 4 } { 5 6 } } ; M: number whatever2 drop H{ { 1 1 } { 2 2 } { 3 3 } { 4 4 } { 5 6 } } ; inline
M: f whatever2 ; M: f whatever2 ; inline
[ t ] [ [ 1 whatever2 at ] { at* hashcode* } inlined? ] unit-test [ t ] [ [ 1 whatever2 at ] { at* hashcode* } inlined? ] unit-test
[ f ] [ [ whatever2 at ] { at* hashcode* } inlined? ] unit-test [ f ] [ [ whatever2 at ] { at* hashcode* } inlined? ] unit-test

View File

@ -19,6 +19,4 @@ IN: compiler.tree.propagation
H{ } clone copies set H{ } clone copies set
H{ } clone 1array value-infos set H{ } clone 1array value-infos set
H{ } clone 1array constraints set H{ } clone 1array constraints set
H{ } clone inlining-count set
dup compute-node-count
dup (propagate) ; dup (propagate) ;