compiler.tree.propagation: remove method inlining heuristic
parent
630ffb8ae6
commit
3047d4a451
|
@ -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?
|
||||||
|
|
|
@ -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 ]
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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) ;
|
||||||
|
|
Loading…
Reference in New Issue