78 lines
2.1 KiB
Factor
78 lines
2.1 KiB
Factor
! Copyright (C) 2008 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: sequences namespaces kernel accessors assocs sets fry
|
|
arrays combinators columns 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 outputs inputs -- )
|
|
[ index ] dip swap dup [ <column> 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 ;
|
|
|
|
: remove-phi-inputs ( #phi -- )
|
|
dup [ out-d>> ] [ phi-in-d>> ] bi filter-corresponding >>phi-in-d
|
|
dup [ out-r>> ] [ phi-in-r>> ] bi filter-corresponding >>phi-in-r
|
|
drop ;
|
|
|
|
: dead-value-indices ( values -- indices )
|
|
[ length ] keep live-values get
|
|
'[ , nth , key? not ] filter ; inline
|
|
|
|
: drop-d-values ( values indices -- node )
|
|
[ drop filter-live ] [ nths filter-live ] 2bi
|
|
[ make-values ] keep
|
|
[ drop ] [ 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' )
|
|
'[
|
|
[ , drop-d-values 1array ]
|
|
[ , drop-r-values ]
|
|
bi* 3append
|
|
] 3map ;
|
|
|
|
: hoist-drops ( #phi -- )
|
|
if-node get swap
|
|
{
|
|
[ phi-in-d>> ]
|
|
[ phi-in-r>> ]
|
|
[ out-d>> dead-value-indices ]
|
|
[ out-r>> dead-value-indices ]
|
|
} 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*
|
|
{
|
|
[ hoist-drops ]
|
|
[ remove-phi-inputs ]
|
|
[ remove-phi-outputs ]
|
|
[ ]
|
|
} cleave ;
|