More optimization intended to reduce compile time. Another 10% speedup on compiling empty PEG parser

- new map-flat combinator replaces usages of 'map flatten' in compiler
- compiler.tree.def-use.simplified uses an explicit accumulator instead of flatten
- compiler.tree.tuple-unboxing uses an explicit accumulator instead of flatten
- fix inlining regression from last time: custom inlining results would sometimes be discarded
- compiler.tree's 3each and 3map combinators rewritten to not use flip
- rewrite math.partial-dispatch without locals (purely stylistic, no performance increase)
- hand-optimize flip for common arrays-of-arrays case
- don't run escape analysis and tuple unboxing if there are no allocations in the IR
db4
Slava Pestov 2008-12-06 11:17:19 -06:00
parent a56d480aa6
commit 145b635eb6
18 changed files with 164 additions and 70 deletions

View File

@ -60,7 +60,7 @@ nl
"." write flush
{
new-sequence nth push pop peek
new-sequence nth push pop peek flip
} compile-uncompiled
"." write flush

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel sequences sequences.deep
USING: accessors arrays kernel sequences compiler.utilities
compiler.cfg.instructions cpu.architecture ;
IN: compiler.cfg.two-operand
@ -55,6 +55,6 @@ M: insn convert-two-operand* ;
: convert-two-operand ( mr -- mr' )
[
two-operand? [
[ convert-two-operand* ] map flatten
[ convert-two-operand* ] map-flat
] when
] change-instructions ;

View File

@ -1,10 +1,11 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences sequences.deep combinators fry
USING: kernel accessors sequences combinators fry
classes.algebra namespaces assocs words math math.private
math.partial-dispatch math.intervals classes classes.tuple
classes.tuple.private layouts definitions stack-checker.state
stack-checker.branches
compiler.utilities
compiler.tree
compiler.tree.combinators
compiler.tree.propagation.info
@ -33,7 +34,7 @@ GENERIC: cleanup* ( node -- node/nodes )
: cleanup ( nodes -- nodes' )
#! We don't recurse into children here, instead the methods
#! do it since the logic is a bit more involved
[ cleanup* ] map flatten ;
[ cleanup* ] map-flat ;
: cleanup-folding? ( #call -- ? )
node-output-infos

View File

@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs fry kernel accessors sequences sequences.deep arrays
stack-checker.inlining namespaces compiler.tree ;
USING: assocs fry kernel accessors sequences compiler.utilities
arrays stack-checker.inlining namespaces compiler.tree
math.order ;
IN: compiler.tree.combinators
: each-node ( nodes quot: ( node -- ) -- )
@ -27,7 +28,7 @@ IN: compiler.tree.combinators
[ _ map-nodes ] change-child
] when
] if
] map flatten ; inline recursive
] map-flat ; inline recursive
: contains-node? ( nodes quot: ( node -- ? ) -- ? )
dup dup '[
@ -48,12 +49,6 @@ IN: compiler.tree.combinators
: sift-children ( seq flags -- seq' )
zip [ nip ] assoc-filter keys ;
: (3each) [ 3array flip ] dip '[ first3 @ ] ; inline
: 3each ( seq1 seq2 seq3 quot -- seq ) (3each) each ; inline
: 3map ( seq1 seq2 seq3 quot -- seq ) (3each) map ; inline
: until-fixed-point ( #recursive quot: ( node -- ) -- )
over label>> t >>fixed-point drop
[ with-scope ] 2keep

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors namespaces assocs deques search-deques
dlists kernel sequences sequences.deep words sets
dlists kernel sequences compiler.utilities words sets
stack-checker.branches compiler.tree compiler.tree.def-use
compiler.tree.combinators ;
IN: compiler.tree.dead-code.liveness
@ -49,4 +49,4 @@ GENERIC: remove-dead-code* ( node -- node' )
M: node remove-dead-code* ;
: (remove-dead-code) ( nodes -- nodes' )
[ remove-dead-code* ] map flatten ;
[ remove-dead-code* ] map-flat ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences sequences.deep kernel
USING: sequences kernel fry vectors
compiler.tree compiler.tree.def-use ;
IN: compiler.tree.def-use.simplified
@ -9,8 +9,6 @@ IN: compiler.tree.def-use.simplified
! A 'real' usage is a usage of a value that is not a #renaming.
TUPLE: real-usage value node ;
GENERIC: actually-used-by* ( value node -- real-usages )
! Def
GENERIC: actually-defined-by* ( value node -- real-usage )
@ -25,16 +23,18 @@ M: #return-recursive actually-defined-by* real-usage boa ;
M: node actually-defined-by* real-usage boa ;
! Use
: (actually-used-by) ( value -- real-usages )
dup used-by [ actually-used-by* ] with map ;
GENERIC# actually-used-by* 1 ( value node accum -- )
: (actually-used-by) ( value accum -- )
[ [ used-by ] keep ] dip '[ _ swap _ actually-used-by* ] each ;
M: #renaming actually-used-by*
inputs/outputs [ indices ] dip nths
[ (actually-used-by) ] map ;
[ inputs/outputs [ indices ] dip nths ] dip
'[ _ (actually-used-by) ] each ;
M: #return-recursive actually-used-by* real-usage boa ;
M: #return-recursive actually-used-by* [ real-usage boa ] dip push ;
M: node actually-used-by* real-usage boa ;
M: node actually-used-by* [ real-usage boa ] dip push ;
: actually-used-by ( value -- real-usages )
(actually-used-by) flatten ;
10 <vector> [ (actually-used-by) ] keep ;

View File

@ -33,4 +33,4 @@ M: #branch escape-analysis*
2bi ;
M: #phi escape-analysis*
[ phi-in-d>> <flipped> ] [ out-d>> ] bi merge-allocations ;
[ phi-in-d>> flip ] [ out-d>> ] bi merge-allocations ;

View File

@ -0,0 +1,23 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: classes classes.tuple math math.private accessors
combinators kernel compiler.tree compiler.tree.combinators
compiler.tree.propagation.info ;
IN: compiler.tree.escape-analysis.check
GENERIC: run-escape-analysis* ( node -- ? )
M: #push run-escape-analysis*
literal>> [ class immutable-tuple-class? ] [ complex? ] bi or ;
M: #call run-escape-analysis*
{
{ [ dup word>> \ <complex> eq? ] [ t ] }
{ [ dup immutable-tuple-boa? ] [ t ] }
[ f ]
} cond nip ;
M: node run-escape-analysis* drop f ;
: run-escape-analysis? ( nodes -- ? )
[ run-escape-analysis* ] contains-node? ;

View File

@ -1,10 +1,11 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry namespaces sequences math accessors kernel arrays
combinators sequences.deep assocs
combinators compiler.utilities assocs
stack-checker.backend
stack-checker.branches
stack-checker.inlining
compiler.utilities
compiler.tree
compiler.tree.combinators
compiler.tree.normalization.introductions
@ -46,7 +47,7 @@ M: #branch normalize*
[
[
[
[ normalize* ] map flatten
[ normalize* ] map-flat
introduction-stack get
2array
] with-scope
@ -70,7 +71,7 @@ M: #phi normalize*
: (normalize) ( nodes introductions -- nodes )
introduction-stack [
[ normalize* ] map flatten
[ normalize* ] map-flat
] with-variable ;
M: #recursive normalize*

View File

@ -6,6 +6,7 @@ compiler.tree.normalization
compiler.tree.propagation
compiler.tree.cleanup
compiler.tree.escape-analysis
compiler.tree.escape-analysis.check
compiler.tree.tuple-unboxing
compiler.tree.identities
compiler.tree.def-use
@ -22,8 +23,10 @@ SYMBOL: check-optimizer?
normalize
propagate
cleanup
escape-analysis
unbox-tuples
dup run-escape-analysis? [
escape-analysis
unbox-tuples
] when
apply-identities
compute-def-use
remove-dead-code

View File

@ -3,6 +3,7 @@
USING: fry kernel sequences assocs accessors namespaces
math.intervals arrays classes.algebra combinators columns
stack-checker.branches
compiler.utilities
compiler.tree
compiler.tree.combinators
compiler.tree.propagation.info
@ -78,7 +79,7 @@ SYMBOL: condition-value
M: #phi propagate-before ( #phi -- )
[ annotate-phi-inputs ]
[ [ phi-info-d>> <flipped> ] [ out-d>> ] bi merge-value-infos ]
[ [ phi-info-d>> flip ] [ out-d>> ] bi merge-value-infos ]
bi ;
: branch-phi-constraints ( output values booleans -- )
@ -137,8 +138,8 @@ M: #phi propagate-before ( #phi -- )
M: #phi propagate-after ( #phi -- )
condition-value get [
[ out-d>> ]
[ phi-in-d>> <flipped> ]
[ phi-info-d>> <flipped> ] tri
[ phi-in-d>> flip ]
[ phi-info-d>> flip ] tri
[
[ possible-boolean-values ] map
branch-phi-constraints

View File

@ -49,7 +49,7 @@ M: #renaming compute-copy-equiv* inputs/outputs are-copies-of ;
] 2each ;
M: #phi compute-copy-equiv*
[ phi-in-d>> <flipped> ] [ out-d>> ] bi compute-phi-equiv ;
[ phi-in-d>> flip ] [ out-d>> ] bi compute-phi-equiv ;
M: node compute-copy-equiv* drop ;

View File

@ -184,7 +184,7 @@ SYMBOL: history
over in-d>> second value-info literal>> dup class?
[ "predicate" word-prop '[ drop @ ] inline-word-def ] [ 3drop f ] if ;
: do-inlining ( #call word -- ? )
: (do-inlining) ( #call word -- ? )
#! If the generic was defined in an outer compilation unit,
#! then it doesn't have a definition yet; the definition
#! is built at the end of the compilation unit. We do not
@ -193,14 +193,19 @@ SYMBOL: history
#! of bounds value. This case comes up if a parsing word
#! calls the compiler at parse time (doing so is
#! discouraged, but it should still work.)
dup custom-inlining? [ 2dup inline-custom ] [ f ] if [ 2drop f ] [
{
{ [ dup deferred? ] [ 2drop f ] }
{ [ dup \ instance? eq? ] [ inline-instance-check ] }
{ [ dup always-inline-word? ] [ inline-word ] }
{ [ dup standard-generic? ] [ inline-standard-method ] }
{ [ dup math-generic? ] [ inline-math-method ] }
{ [ dup method-body? ] [ inline-method-body ] }
[ 2drop f ]
} cond
] if ;
{
{ [ dup deferred? ] [ 2drop f ] }
{ [ dup \ instance? eq? ] [ inline-instance-check ] }
{ [ dup always-inline-word? ] [ inline-word ] }
{ [ dup standard-generic? ] [ inline-standard-method ] }
{ [ dup math-generic? ] [ inline-math-method ] }
{ [ dup method-body? ] [ inline-method-body ] }
[ 2drop f ]
} cond ;
: do-inlining ( #call word -- ? )
#! Note the logic here: if there's a custom inlining hook,
#! it is permitted to return f, which means that we try the
#! normal inlining heuristic.
dup custom-inlining? [ 2dup inline-custom ] [ f ] if
[ 2drop t ] [ (do-inlining) ] if ;

View File

@ -8,7 +8,8 @@ math.functions math.private strings layouts
compiler.tree.propagation.info compiler.tree.def-use
compiler.tree.debugger compiler.tree.checker
slots.private words hashtables classes assocs locals
specialized-arrays.double system sorting math.libm ;
specialized-arrays.double system sorting math.libm
math.intervals ;
IN: compiler.tree.propagation.tests
\ propagate must-infer
@ -599,6 +600,10 @@ MIXIN: empty-mixin
[ V{ t } ] [ [ { fixnum } declare 10 mod >float -20 > ] final-literals ] unit-test
[ T{ interval f { 0 t } { 127 t } } ] [
[ { integer } declare 127 bitand ] final-info first interval>>
] unit-test
! [ V{ string } ] [
! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
! ] unit-test

View File

@ -1,9 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces assocs accessors kernel combinators
classes.algebra sequences sequences.deep slots.private
classes.algebra sequences slots.private fry vectors
classes.tuple.private math math.private arrays
stack-checker.branches
compiler.utilities
compiler.tree
compiler.tree.combinators
compiler.tree.propagation.info
@ -21,7 +22,7 @@ GENERIC: unbox-tuples* ( node -- node/nodes )
: (expand-#push) ( object value -- nodes )
dup unboxed-allocation dup [
[ object-slots ] [ drop ] [ ] tri*
[ (expand-#push) ] 2map
[ (expand-#push) ] 2map-flat
] [
drop #push
] if ;
@ -38,11 +39,16 @@ M: #push unbox-tuples* ( #push -- nodes )
: unbox-<complex> ( #call -- nodes )
dup unbox-output? [ drop { } ] when ;
: (flatten-values) ( values -- values' )
[ dup unboxed-allocation [ (flatten-values) ] [ ] ?if ] map ;
: (flatten-values) ( values accum -- )
dup '[
dup unboxed-allocation
[ _ (flatten-values) ] [ _ push ] ?if
] each ;
: flatten-values ( values -- values' )
dup empty? [ (flatten-values) flatten ] unless ;
dup empty? [
10 <vector> [ (flatten-values) ] keep
] unless ;
: prepare-slot-access ( #call -- tuple-values outputs slot-values )
[ in-d>> flatten-values ]

View File

@ -0,0 +1,31 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences sequences.private arrays vectors fry
math.order ;
IN: compiler.utilities
: flattener ( seq quot -- seq vector quot' )
over length <vector> [
dup
'[
@ [
dup array?
[ _ push-all ] [ _ push ] if
] when*
]
] keep ; inline
: flattening ( seq quot combinator -- seq' )
[ flattener ] dip dip { } like ; inline
: map-flat ( seq quot -- seq' ) [ each ] flattening ; inline
: 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline
: (3each) ( seq1 seq2 seq3 quot -- n quot' )
[ [ [ length ] tri@ min min ] 3keep ] dip
'[ [ _ nth-unsafe ] [ _ nth-unsafe ] [ _ nth-unsafe ] tri @ ] ; inline
: 3each ( seq1 seq2 seq3 quot -- seq ) (3each) each ; inline
: 3map ( seq1 seq2 seq3 quot -- seq ) (3each) map ; inline

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel kernel.private math math.private words
sequences parser namespaces make assocs quotations arrays locals
sequences parser namespaces make assocs quotations arrays
generic generic.math hashtables effects compiler.units
classes.algebra fry combinators ;
IN: math.partial-dispatch
@ -45,29 +45,29 @@ M: word integer-op-input-classes
{ bitnot fixnum-bitnot }
} at swap or ;
:: integer-fixnum-op-quot ( fix-word big-word -- quot )
: integer-fixnum-op-quot ( fix-word big-word -- quot )
[
[ over fixnum? ] %
fix-word '[ _ execute ] ,
big-word '[ fixnum>bignum _ execute ] ,
[ '[ _ execute ] , ]
[ '[ fixnum>bignum _ execute ] , ] bi*
\ if ,
] [ ] make ;
:: fixnum-integer-op-quot ( fix-word big-word -- quot )
: fixnum-integer-op-quot ( fix-word big-word -- quot )
[
[ dup fixnum? ] %
fix-word '[ _ execute ] ,
big-word '[ [ fixnum>bignum ] dip _ execute ] ,
[ '[ _ execute ] , ]
[ '[ [ fixnum>bignum ] dip _ execute ] , ] bi*
\ if ,
] [ ] make ;
:: integer-integer-op-quot ( fix-word big-word -- quot )
: integer-integer-op-quot ( fix-word big-word -- quot )
[
[ dup fixnum? ] %
fix-word big-word integer-fixnum-op-quot ,
2dup integer-fixnum-op-quot ,
[
[ over fixnum? [ [ fixnum>bignum ] dip ] when ] %
big-word ,
nip ,
] [ ] make ,
\ if ,
] [ ] make ;

View File

@ -835,12 +835,35 @@ PRIVATE>
: supremum ( seq -- n ) dup first [ max ] reduce ;
: flip ( matrix -- newmatrix )
dup empty? [
dup [ length ] map infimum
swap [ [ nth-unsafe ] with { } map-as ] curry { } map-as
] unless ;
: sigma ( seq quot -- n ) [ + ] compose 0 swap reduce ; inline
: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline
! We hand-optimize flip to such a degree because type hints
! cannot express that an array is an array of arrays yet, and
! this word happens to be performance-critical since the compiler
! itself uses it. Optimizing it like this reduced compile time.
<PRIVATE
: generic-flip ( matrix -- newmatrix )
[ dup first length [ length min ] reduce ] keep
[ [ nth-unsafe ] with { } map-as ] curry { } map-as ; inline
USE: arrays
: array-length ( array -- len )
{ array } declare length>> ;
: array-flip ( matrix -- newmatrix )
[ dup first array-length [ array-length min ] reduce ] keep
[ [ array-nth ] with { } map-as ] curry { } map-as ;
PRIVATE>
: flip ( matrix -- newmatrix )
dup empty? [
dup array? [
dup [ array? ] all?
[ array-flip ] [ generic-flip ] if
] [ generic-flip ] if
] unless ;