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 IRdb4
parent
a56d480aa6
commit
145b635eb6
|
@ -60,7 +60,7 @@ nl
|
|||
"." write flush
|
||||
|
||||
{
|
||||
new-sequence nth push pop peek
|
||||
new-sequence nth push pop peek flip
|
||||
} compile-uncompiled
|
||||
|
||||
"." write flush
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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? ;
|
|
@ -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*
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ]
|
||||
|
|
|
@ -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
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue