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.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: fry accessors namespaces assocs dequeues search-dequeues
|
||||
kernel sequences words sets arrays
|
||||
stack-checker.state stack-checker.inlining
|
||||
compiler.tree
|
||||
compiler.tree.combinators
|
||||
compiler.tree.dataflow-analysis
|
||||
compiler.tree.dataflow-analysis.backward ;
|
||||
USING: compiler.tree.dead-code.branches
|
||||
compiler.tree.dead-code.liveness
|
||||
compiler.tree.dead-code.recursive
|
||||
compiler.tree.dead-code.simple ;
|
||||
IN: compiler.tree.dead-code
|
||||
|
||||
! Dead code elimination: remove #push and flushable #call whose
|
||||
! outputs are unused using backward DFA.
|
||||
GENERIC: mark-live-values ( node -- )
|
||||
: remove-dead-code ( nodes -- nodes )
|
||||
init-dead-code
|
||||
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.builder
|
||||
compiler.tree.optimizer
|
||||
compiler.tree.combinators
|
||||
compiler.tree.propagation.info ;
|
||||
compiler.tree.combinators ;
|
||||
IN: compiler.tree.debugger
|
||||
|
||||
! A simple tool for turning tree IR into quotations and
|
||||
|
|
@ -54,10 +53,7 @@ M: #shuffle node>quot
|
|||
shuffle-effect dup pretty-shuffle
|
||||
[ % ] [ shuffle-node boa , ] ?if ;
|
||||
|
||||
: pushed-literals ( node -- seq )
|
||||
dup out-d>> [ node-value-info literal>> literalize ] with map ;
|
||||
|
||||
M: #push node>quot pushed-literals % ;
|
||||
M: #push node>quot literal>> , ;
|
||||
|
||||
M: #call node>quot word>> , ;
|
||||
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ SYMBOL: visited
|
|||
] tri
|
||||
] 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 ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue