More DCE work
Slava Pestov
parent
3735f135c0
commit
a982e564bf
|
|
@ -0,0 +1,68 @@
|
||||||
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: sequences namespaces kernel accessors assocs sets fry
|
||||||
|
arrays combinators stack-checker.backend compiler.tree
|
||||||
|
compiler.tree.combinators compiler.tree.dead-code.liveness
|
||||||
|
compiler.tree.dead-code.simple ;
|
||||||
|
IN: compiler.tree.dead-code.branches
|
||||||
|
|
||||||
|
M: #if mark-live-values* look-at-inputs ;
|
||||||
|
|
||||||
|
M: #dispatch mark-live-values* look-at-inputs ;
|
||||||
|
|
||||||
|
: look-at-phi ( value inputs outputs -- )
|
||||||
|
[ index ] dip over [ nth look-at-values ] [ 2drop ] if ;
|
||||||
|
|
||||||
|
M: #phi compute-live-values*
|
||||||
|
#! If any of the outputs of a #phi are live, then the
|
||||||
|
#! corresponding inputs are live too.
|
||||||
|
[ [ out-d>> ] [ phi-in-d>> ] bi look-at-phi ]
|
||||||
|
[ [ out-r>> ] [ phi-in-r>> ] bi look-at-phi ]
|
||||||
|
2bi ;
|
||||||
|
|
||||||
|
SYMBOL: if-node
|
||||||
|
|
||||||
|
M: #if remove-dead-code*
|
||||||
|
[ [ (remove-dead-code) ] map ] change-children
|
||||||
|
dup if-node set ;
|
||||||
|
|
||||||
|
: dead-value-indices ( values -- indices )
|
||||||
|
[ length ] keep live-values get
|
||||||
|
'[ , nth , key? not ] filter ; inline
|
||||||
|
|
||||||
|
: drop-d-values ( values indices -- node )
|
||||||
|
[ drop ] [ nths ] 2bi
|
||||||
|
dup make-values
|
||||||
|
[ nip ] [ zip ] 2bi
|
||||||
|
#shuffle ;
|
||||||
|
|
||||||
|
: drop-r-values ( values indices -- nodes )
|
||||||
|
[ dup make-values [ #r> ] keep ] dip
|
||||||
|
drop-d-values dup out-d>> dup make-values #>r
|
||||||
|
3array ;
|
||||||
|
|
||||||
|
: insert-drops ( nodes d-values r-values d-indices r-indices -- nodes' )
|
||||||
|
[ [ flip ] bi@ ] 2dip
|
||||||
|
'[
|
||||||
|
[ , drop-d-values 1array ]
|
||||||
|
[ , drop-r-values ]
|
||||||
|
bi* 3append
|
||||||
|
] 3map ;
|
||||||
|
|
||||||
|
: remove-phi-inputs ( #phi -- )
|
||||||
|
if-node get swap
|
||||||
|
{
|
||||||
|
[ phi-in-d>> ]
|
||||||
|
[ [ phi-in-d>> ] [ out-d>> ] bi dead-value-indices nths ]
|
||||||
|
[ phi-in-r>> ]
|
||||||
|
[ [ phi-in-r>> ] [ out-r>> ] bi dead-value-indices nths ]
|
||||||
|
} cleave
|
||||||
|
'[ , , , , insert-drops ] change-children drop ;
|
||||||
|
|
||||||
|
: remove-phi-outputs ( #phi -- )
|
||||||
|
[ filter-live ] change-out-d
|
||||||
|
[ filter-live ] change-out-r
|
||||||
|
drop ;
|
||||||
|
|
||||||
|
M: #phi remove-dead-code*
|
||||||
|
[ remove-phi-inputs ] [ remove-phi-outputs ] [ ] tri ;
|
||||||
|
|
@ -1,132 +1,14 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: fry accessors namespaces assocs dequeues search-dequeues
|
USING: compiler.tree.dead-code.branches
|
||||||
kernel sequences words sets arrays
|
compiler.tree.dead-code.liveness
|
||||||
stack-checker.state stack-checker.inlining
|
compiler.tree.dead-code.recursive
|
||||||
compiler.tree
|
compiler.tree.dead-code.simple ;
|
||||||
compiler.tree.combinators
|
|
||||||
compiler.tree.dataflow-analysis
|
|
||||||
compiler.tree.dataflow-analysis.backward ;
|
|
||||||
IN: compiler.tree.dead-code
|
IN: compiler.tree.dead-code
|
||||||
|
|
||||||
! Dead code elimination: remove #push and flushable #call whose
|
: remove-dead-code ( nodes -- nodes )
|
||||||
! outputs are unused using backward DFA.
|
init-dead-code
|
||||||
GENERIC: mark-live-values ( node -- )
|
mark-live-values
|
||||||
|
compute-live-values
|
||||||
|
(remove-dead-code) ;
|
||||||
|
|
||||||
M: #if mark-live-values look-at-inputs ;
|
|
||||||
|
|
||||||
M: #dispatch mark-live-values look-at-inputs ;
|
|
||||||
|
|
||||||
M: #call mark-live-values
|
|
||||||
dup word>> "flushable" word-prop
|
|
||||||
[ drop ] [ look-at-inputs ] if ;
|
|
||||||
|
|
||||||
M: #alien-invoke mark-live-values look-at-inputs ;
|
|
||||||
|
|
||||||
M: #alien-indirect mark-live-values look-at-inputs ;
|
|
||||||
|
|
||||||
M: #return mark-live-values look-at-inputs ;
|
|
||||||
|
|
||||||
M: node mark-live-values drop ;
|
|
||||||
|
|
||||||
SYMBOL: live-values
|
|
||||||
|
|
||||||
: live-value? ( value -- ? ) live-values get at ;
|
|
||||||
|
|
||||||
GENERIC: remove-dead-code* ( node -- node' )
|
|
||||||
|
|
||||||
M: #introduce remove-dead-code*
|
|
||||||
dup value>> live-value? [
|
|
||||||
dup value>> 1array #drop 2array
|
|
||||||
] unless ;
|
|
||||||
|
|
||||||
: filter-live ( values -- values' )
|
|
||||||
[ live-value? ] filter ;
|
|
||||||
|
|
||||||
M: #>r remove-dead-code*
|
|
||||||
[ filter-live ] change-out-r
|
|
||||||
[ filter-live ] change-in-d
|
|
||||||
dup in-d>> empty? [ drop f ] when ;
|
|
||||||
|
|
||||||
M: #r> remove-dead-code*
|
|
||||||
[ filter-live ] change-out-d
|
|
||||||
[ filter-live ] change-in-r
|
|
||||||
dup in-r>> empty? [ drop f ] when ;
|
|
||||||
|
|
||||||
M: #push remove-dead-code*
|
|
||||||
dup out-d>> first live-value? [ drop f ] unless ;
|
|
||||||
|
|
||||||
: dead-flushable-call? ( #call -- ? )
|
|
||||||
[ word>> "flushable" word-prop ]
|
|
||||||
[ out-d>> [ live-value? not ] all? ] bi and ;
|
|
||||||
|
|
||||||
: remove-flushable-call ( #call -- node )
|
|
||||||
in-d>> #drop remove-dead-code* ;
|
|
||||||
|
|
||||||
: some-outputs-dead? ( #call -- ? )
|
|
||||||
out-d>> [ live-value? not ] contains? ;
|
|
||||||
|
|
||||||
: remove-dead-outputs ( #call -- nodes )
|
|
||||||
[ out-d>> ] [ [ [ <value> ] replicate ] change-out-d ] bi
|
|
||||||
[ nip ] [ out-d>> swap #copy remove-dead-code* ] 2bi
|
|
||||||
2array ;
|
|
||||||
|
|
||||||
M: #call remove-dead-code*
|
|
||||||
dup dead-flushable-call? [
|
|
||||||
remove-flushable-call
|
|
||||||
] [
|
|
||||||
dup some-outputs-dead? [
|
|
||||||
remove-dead-outputs
|
|
||||||
] when
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
M: #recursive remove-dead-code*
|
|
||||||
[ filter-live ] change-in-d ;
|
|
||||||
|
|
||||||
M: #call-recursive remove-dead-code*
|
|
||||||
[ filter-live ] change-in-d
|
|
||||||
[ filter-live ] change-out-d ;
|
|
||||||
|
|
||||||
M: #enter-recursive remove-dead-code*
|
|
||||||
[ filter-live ] change-in-d
|
|
||||||
[ filter-live ] change-out-d ;
|
|
||||||
|
|
||||||
M: #return-recursive remove-dead-code*
|
|
||||||
[ filter-live ] change-in-d
|
|
||||||
[ filter-live ] change-out-d ;
|
|
||||||
|
|
||||||
M: #shuffle remove-dead-code*
|
|
||||||
[ filter-live ] change-in-d
|
|
||||||
[ filter-live ] change-out-d
|
|
||||||
dup in-d>> empty? [ drop f ] when ;
|
|
||||||
|
|
||||||
M: #copy remove-dead-code*
|
|
||||||
[ in-d>> ] [ out-d>> ] bi
|
|
||||||
2dup swap zip #shuffle
|
|
||||||
remove-dead-code* ;
|
|
||||||
|
|
||||||
: filter-corresponding-values ( in out -- in' out' )
|
|
||||||
zip live-values get '[ drop _ , key? ] assoc-filter unzip ;
|
|
||||||
|
|
||||||
: remove-dead-phi-d ( #phi -- #phi )
|
|
||||||
dup
|
|
||||||
[ phi-in-d>> ] [ out-d>> ] bi
|
|
||||||
filter-corresponding-values
|
|
||||||
[ >>phi-in-d ] [ >>out-d ] bi* ;
|
|
||||||
|
|
||||||
: remove-dead-phi-r ( #phi -- #phi )
|
|
||||||
dup
|
|
||||||
[ phi-in-r>> ] [ out-r>> ] bi
|
|
||||||
filter-corresponding-values
|
|
||||||
[ >>phi-in-r ] [ >>out-r ] bi* ;
|
|
||||||
|
|
||||||
M: #phi remove-dead-code*
|
|
||||||
remove-dead-phi-d
|
|
||||||
remove-dead-phi-r ;
|
|
||||||
|
|
||||||
M: node remove-dead-code* ;
|
|
||||||
|
|
||||||
: remove-dead-code ( node -- newnode )
|
|
||||||
[ [ mark-live-values ] backward-dfa live-values set ]
|
|
||||||
[ [ remove-dead-code* ] map-nodes ]
|
|
||||||
bi ;
|
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,51 @@
|
||||||
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: fry accessors namespaces assocs dequeues search-dequeues
|
||||||
|
kernel sequences sequences.deep words sets stack-checker.branches
|
||||||
|
compiler.tree compiler.tree.def-use compiler.tree.combinators ;
|
||||||
|
IN: compiler.tree.dead-code.liveness
|
||||||
|
|
||||||
|
SYMBOL: work-list
|
||||||
|
|
||||||
|
SYMBOL: live-values
|
||||||
|
|
||||||
|
: live-value? ( value -- ? ) live-values get at ;
|
||||||
|
|
||||||
|
: look-at-value ( values -- ) work-list get push-front ;
|
||||||
|
|
||||||
|
: look-at-values ( values -- ) work-list get push-all-front ;
|
||||||
|
|
||||||
|
: look-at-inputs ( node -- ) in-d>> look-at-values ;
|
||||||
|
|
||||||
|
: init-dead-code ( -- )
|
||||||
|
<hashed-dlist> work-list set
|
||||||
|
H{ { +bottom+ f } } clone live-values set ;
|
||||||
|
|
||||||
|
GENERIC: mark-live-values* ( node -- )
|
||||||
|
|
||||||
|
: mark-live-values ( nodes -- nodes )
|
||||||
|
dup [ mark-live-values* ] each-node ; inline
|
||||||
|
|
||||||
|
M: node mark-live-values* drop ;
|
||||||
|
|
||||||
|
GENERIC: compute-live-values* ( value node -- )
|
||||||
|
|
||||||
|
M: node compute-live-values* 2drop ;
|
||||||
|
|
||||||
|
: iterate-live-values ( value -- )
|
||||||
|
dup live-values get key? [
|
||||||
|
drop
|
||||||
|
] [
|
||||||
|
dup live-values get conjoin
|
||||||
|
dup defined-by compute-live-values*
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: compute-live-values ( -- )
|
||||||
|
work-list get [ iterate-live-values ] slurp-dequeue ;
|
||||||
|
|
||||||
|
GENERIC: remove-dead-code* ( node -- node' )
|
||||||
|
|
||||||
|
M: node remove-dead-code* ;
|
||||||
|
|
||||||
|
: (remove-dead-code) ( nodes -- nodes' )
|
||||||
|
[ remove-dead-code* ] map flatten ;
|
||||||
|
|
@ -0,0 +1,31 @@
|
||||||
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors sequences kernel
|
||||||
|
compiler.tree compiler.tree.dead-code.branches
|
||||||
|
compiler.tree.dead-code.liveness
|
||||||
|
compiler.tree.dead-code.simple ;
|
||||||
|
IN: compiler.tree.dead-code.recursive
|
||||||
|
|
||||||
|
M: #enter-recursive compute-live-values*
|
||||||
|
[ out-d>> ] [ recursive-phi-in flip ] bi look-at-phi ;
|
||||||
|
|
||||||
|
: return-recursive-phi-in ( #return-recursive -- phi-in )
|
||||||
|
[ label>> calls>> [ in-d>> ] map ] [ in-d>> ] bi suffix ;
|
||||||
|
|
||||||
|
M: #return-recursive compute-live-values*
|
||||||
|
[ out-d>> ] [ return-recursive-phi-in flip ] bi look-at-phi ;
|
||||||
|
|
||||||
|
M: #recursive remove-dead-code*
|
||||||
|
[ filter-live ] change-in-d ;
|
||||||
|
|
||||||
|
M: #call-recursive remove-dead-code*
|
||||||
|
[ filter-live ] change-in-d
|
||||||
|
[ filter-live ] change-out-d ;
|
||||||
|
|
||||||
|
M: #enter-recursive remove-dead-code*
|
||||||
|
[ filter-live ] change-in-d
|
||||||
|
[ filter-live ] change-out-d ;
|
||||||
|
|
||||||
|
M: #return-recursive remove-dead-code*
|
||||||
|
[ filter-live ] change-in-d
|
||||||
|
[ filter-live ] change-out-d ;
|
||||||
|
|
@ -0,0 +1,99 @@
|
||||||
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: kernel accessors words assocs sequences arrays
|
||||||
|
compiler.tree stack-checker.backend
|
||||||
|
compiler.tree.dead-code.liveness ;
|
||||||
|
IN: compiler.tree.dead-code.simple
|
||||||
|
|
||||||
|
M: #call mark-live-values*
|
||||||
|
dup word>> "flushable" word-prop
|
||||||
|
[ drop ] [ look-at-inputs ] if ;
|
||||||
|
|
||||||
|
M: #alien-invoke mark-live-values* look-at-inputs ;
|
||||||
|
|
||||||
|
M: #alien-indirect mark-live-values* look-at-inputs ;
|
||||||
|
|
||||||
|
M: #return mark-live-values* look-at-inputs ;
|
||||||
|
|
||||||
|
: look-at-mapping ( value inputs outputs -- )
|
||||||
|
[ index ] dip over [ nth look-at-value ] [ 2drop ] if ;
|
||||||
|
|
||||||
|
M: #copy compute-live-values*
|
||||||
|
#! If the output of a copy is live, then the corresponding
|
||||||
|
#! input is live also.
|
||||||
|
[ out-d>> ] [ in-d>> ] bi look-at-mapping ;
|
||||||
|
|
||||||
|
M: #call compute-live-values* nip look-at-inputs ;
|
||||||
|
|
||||||
|
M: #call-recursive compute-live-values*
|
||||||
|
#! If the output of a copy is live, then the corresponding
|
||||||
|
#! inputs to #return nodes are live also.
|
||||||
|
[ out-d>> ] [ label>> return>> ] bi look-at-mapping ;
|
||||||
|
|
||||||
|
M: #>r compute-live-values*
|
||||||
|
[ out-r>> ] [ in-d>> ] bi look-at-mapping ;
|
||||||
|
|
||||||
|
M: #r> compute-live-values*
|
||||||
|
[ out-d>> ] [ in-r>> ] bi look-at-mapping ;
|
||||||
|
|
||||||
|
M: #shuffle compute-live-values*
|
||||||
|
mapping>> at look-at-value ;
|
||||||
|
|
||||||
|
M: #alien-invoke compute-live-values* nip look-at-inputs ;
|
||||||
|
|
||||||
|
M: #alien-indirect compute-live-values* nip look-at-inputs ;
|
||||||
|
|
||||||
|
M: #introduce remove-dead-code*
|
||||||
|
dup value>> live-value? [
|
||||||
|
dup value>> 1array #drop 2array
|
||||||
|
] unless ;
|
||||||
|
|
||||||
|
: filter-live ( values -- values' )
|
||||||
|
[ live-value? ] filter ;
|
||||||
|
|
||||||
|
M: #>r remove-dead-code*
|
||||||
|
[ filter-live ] change-out-r
|
||||||
|
[ filter-live ] change-in-d
|
||||||
|
dup in-d>> empty? [ drop f ] when ;
|
||||||
|
|
||||||
|
M: #r> remove-dead-code*
|
||||||
|
[ filter-live ] change-out-d
|
||||||
|
[ filter-live ] change-in-r
|
||||||
|
dup in-r>> empty? [ drop f ] when ;
|
||||||
|
|
||||||
|
M: #push remove-dead-code*
|
||||||
|
dup out-d>> first live-value? [ drop f ] unless ;
|
||||||
|
|
||||||
|
: dead-flushable-call? ( #call -- ? )
|
||||||
|
[ word>> "flushable" word-prop ]
|
||||||
|
[ out-d>> [ live-value? not ] all? ] bi and ;
|
||||||
|
|
||||||
|
: remove-flushable-call ( #call -- node )
|
||||||
|
in-d>> #drop remove-dead-code* ;
|
||||||
|
|
||||||
|
: some-outputs-dead? ( #call -- ? )
|
||||||
|
out-d>> [ live-value? not ] contains? ;
|
||||||
|
|
||||||
|
: drop-dead-outputs ( #call -- nodes )
|
||||||
|
[ out-d>> ] [ [ make-values ] change-out-d ] bi
|
||||||
|
[ nip ] [ out-d>> swap #copy remove-dead-code* ] 2bi
|
||||||
|
2array ;
|
||||||
|
|
||||||
|
M: #call remove-dead-code*
|
||||||
|
dup dead-flushable-call? [
|
||||||
|
remove-flushable-call
|
||||||
|
] [
|
||||||
|
dup some-outputs-dead? [
|
||||||
|
drop-dead-outputs
|
||||||
|
] when
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
M: #shuffle remove-dead-code*
|
||||||
|
[ filter-live ] change-in-d
|
||||||
|
[ filter-live ] change-out-d
|
||||||
|
dup in-d>> empty? [ drop f ] when ;
|
||||||
|
|
||||||
|
M: #copy remove-dead-code*
|
||||||
|
[ in-d>> ] [ out-d>> ] bi
|
||||||
|
2dup swap zip #shuffle
|
||||||
|
remove-dead-code* ;
|
||||||
|
|
@ -7,8 +7,7 @@ combinators io sorting
|
||||||
compiler.tree
|
compiler.tree
|
||||||
compiler.tree.builder
|
compiler.tree.builder
|
||||||
compiler.tree.optimizer
|
compiler.tree.optimizer
|
||||||
compiler.tree.combinators
|
compiler.tree.combinators ;
|
||||||
compiler.tree.propagation.info ;
|
|
||||||
IN: compiler.tree.debugger
|
IN: compiler.tree.debugger
|
||||||
|
|
||||||
! A simple tool for turning tree IR into quotations and
|
! A simple tool for turning tree IR into quotations and
|
||||||
|
|
@ -54,10 +53,7 @@ M: #shuffle node>quot
|
||||||
shuffle-effect dup pretty-shuffle
|
shuffle-effect dup pretty-shuffle
|
||||||
[ % ] [ shuffle-node boa , ] ?if ;
|
[ % ] [ shuffle-node boa , ] ?if ;
|
||||||
|
|
||||||
: pushed-literals ( node -- seq )
|
M: #push node>quot literal>> , ;
|
||||||
dup out-d>> [ node-value-info literal>> literalize ] with map ;
|
|
||||||
|
|
||||||
M: #push node>quot pushed-literals % ;
|
|
||||||
|
|
||||||
M: #call node>quot word>> , ;
|
M: #call node>quot word>> , ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -35,7 +35,7 @@ SYMBOL: visited
|
||||||
] tri
|
] tri
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
! M: word redefined H{ } clone visited [ (redefined) ] with-variable ;
|
M: word redefined H{ } clone visited [ (redefined) ] with-variable ;
|
||||||
|
|
||||||
: push-d ( obj -- ) meta-d get push ;
|
: push-d ( obj -- ) meta-d get push ;
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue