65 lines
		
	
	
		
			1.8 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			65 lines
		
	
	
		
			1.8 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
 | |
| stack-checker.branches 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 ;
 | |
| 
 | |
| SYMBOL: if-node
 | |
| 
 | |
| M: #branch remove-dead-code*
 | |
|     [ [ [ (remove-dead-code) ] map ] change-children ]
 | |
|     [ if-node set ]
 | |
|     bi ;
 | |
| 
 | |
| : remove-phi-inputs ( #phi -- )
 | |
|     if-node get children>>
 | |
|     [ dup ends-with-terminate? [ drop f ] [ peek out-d>> ] if ] map
 | |
|     pad-with-bottom >>phi-in-d drop ;
 | |
| 
 | |
| : live-value-indices ( values -- indices )
 | |
|     [ length ] keep live-values get
 | |
|     '[ _ nth _ key? ] filter ; inline
 | |
| 
 | |
| : drop-indexed-values ( values indices -- node )
 | |
|     [ drop filter-live ] [ swap nths ] 2bi
 | |
|     [ make-values ] keep
 | |
|     [ drop ] [ zip ] 2bi
 | |
|     #data-shuffle ;
 | |
| 
 | |
| : insert-drops ( nodes values indices -- nodes' )
 | |
|     '[
 | |
|         over ends-with-terminate?
 | |
|         [ drop ] [ _ drop-indexed-values suffix ] if
 | |
|     ] 2map ;
 | |
| 
 | |
| : hoist-drops ( #phi -- )
 | |
|     if-node get swap
 | |
|     [ phi-in-d>> ] [ out-d>> live-value-indices ] bi
 | |
|     '[ _ _ insert-drops ] change-children drop ;
 | |
| 
 | |
| : remove-phi-outputs ( #phi -- )
 | |
|     [ filter-live ] change-out-d drop ;
 | |
| 
 | |
| M: #phi remove-dead-code*
 | |
|     {
 | |
|         [ hoist-drops ]
 | |
|         [ remove-phi-inputs ]
 | |
|         [ remove-phi-outputs ]
 | |
|         [ ]
 | |
|     } cleave ;
 |