factor/basis/compiler/tree/dead-code/branches/branches.factor

65 lines
1.8 KiB
Factor
Raw Normal View History

2008-08-13 19:56:50 -04:00
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences namespaces kernel accessors assocs sets fry
2008-08-18 22:30:10 -04:00
arrays combinators columns stack-checker.backend
stack-checker.branches compiler.tree compiler.tree.combinators
compiler.tree.dead-code.liveness compiler.tree.dead-code.simple
;
2008-08-13 19:56:50 -04:00
IN: compiler.tree.dead-code.branches
M: #if mark-live-values* look-at-inputs ;
M: #dispatch mark-live-values* look-at-inputs ;
2008-08-14 00:52:49 -04:00
: look-at-phi ( value outputs inputs -- )
[ index ] dip swap dup [ <column> look-at-values ] [ 2drop ] if ;
2008-08-13 19:56:50 -04:00
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 ;
2008-08-13 19:56:50 -04:00
2008-08-18 16:47:49 -04:00
SYMBOL: if-node
2008-08-15 00:35:19 -04:00
M: #branch remove-dead-code*
2008-08-18 16:47:49 -04:00
[ [ [ (remove-dead-code) ] map ] change-children ]
[ if-node set ]
bi ;
2008-08-13 19:56:50 -04:00
2008-08-14 00:52:49 -04:00
: remove-phi-inputs ( #phi -- )
2008-08-18 22:30:10 -04:00
if-node get children>>
[ dup ends-with-terminate? [ drop f ] [ peek out-d>> ] if ] map
pad-with-bottom >>phi-in-d drop ;
2008-08-14 00:52:49 -04:00
2008-08-18 16:47:49 -04:00
: live-value-indices ( values -- indices )
[ length ] keep live-values get
2008-09-10 23:11:40 -04:00
'[ _ nth _ key? ] filter ; inline
2008-08-18 16:47:49 -04:00
2008-08-22 19:09:48 -04:00
: drop-indexed-values ( values indices -- node )
2008-08-18 16:47:49 -04:00
[ drop filter-live ] [ nths ] 2bi
[ make-values ] keep
[ drop ] [ zip ] 2bi
#shuffle ;
: insert-drops ( nodes values indices -- nodes' )
2008-08-18 22:30:10 -04:00
'[
over ends-with-terminate?
2008-09-10 23:11:40 -04:00
[ drop ] [ _ drop-indexed-values suffix ] if
2008-08-18 22:30:10 -04:00
] 2map ;
2008-08-18 16:47:49 -04:00
: hoist-drops ( #phi -- )
if-node get swap
[ phi-in-d>> ] [ out-d>> live-value-indices ] bi
2008-09-10 23:11:40 -04:00
'[ _ _ insert-drops ] change-children drop ;
2008-08-13 19:56:50 -04:00
: remove-phi-outputs ( #phi -- )
2008-08-18 22:30:10 -04:00
[ filter-live ] change-out-d drop ;
2008-08-13 19:56:50 -04:00
M: #phi remove-dead-code*
2008-08-14 00:52:49 -04:00
{
2008-08-18 16:47:49 -04:00
[ hoist-drops ]
2008-08-14 00:52:49 -04:00
[ remove-phi-inputs ]
[ remove-phi-outputs ]
[ ]
} cleave ;