compiler.tree.dead-code: Rewrite /mod to /i or mod in the dead-code pass in the high level optimizer. Fixes #279.
							parent
							
								
									4c197ec6e6
								
							
						
					
					
						commit
						9048233d27
					
				| 
						 | 
				
			
			@ -6,7 +6,8 @@ compiler.tree.tuple-unboxing compiler.tree.debugger
 | 
			
		|||
compiler.tree.recursive compiler.tree.normalization
 | 
			
		||||
compiler.tree.checker tools.test kernel math stack-checker.state
 | 
			
		||||
accessors combinators io prettyprint words sequences.deep
 | 
			
		||||
sequences.private arrays classes kernel.private shuffle ;
 | 
			
		||||
sequences.private arrays classes kernel.private shuffle
 | 
			
		||||
math.private ;
 | 
			
		||||
IN: compiler.tree.dead-code.tests
 | 
			
		||||
 | 
			
		||||
: count-live-values ( quot -- n )
 | 
			
		||||
| 
						 | 
				
			
			@ -187,3 +188,15 @@ IN: compiler.tree.dead-code.tests
 | 
			
		|||
    dup 5 = [ t ] [ dup [ call-recursive-dce-7 ] [ drop f f ] if ] if ; inline recursive
 | 
			
		||||
 | 
			
		||||
[ ] [ [ call-recursive-dce-7 ] optimize-quot drop ] unit-test
 | 
			
		||||
 | 
			
		||||
[ [ /i ] ] [ [ /mod drop ] optimize-quot ] unit-test
 | 
			
		||||
 | 
			
		||||
[ [ mod ] ] [ [ /mod nip ] optimize-quot ] unit-test
 | 
			
		||||
 | 
			
		||||
[ [ fixnum/i ] ] [ [ { fixnum fixnum } declare /mod drop ] optimize-quot ] unit-test
 | 
			
		||||
 | 
			
		||||
[ [ fixnum-mod ] ] [ [ { fixnum fixnum } declare /mod nip ] optimize-quot ] unit-test
 | 
			
		||||
 | 
			
		||||
[ [ bignum/i ] ] [ [ { bignum bignum } declare /mod drop ] optimize-quot ] unit-test
 | 
			
		||||
 | 
			
		||||
[ [ bignum-mod ] ] [ [ { bignum bignum } declare /mod nip ] optimize-quot ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,8 @@
 | 
			
		|||
! Copyright (C) 2008, 2010 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: kernel accessors words assocs sequences arrays namespaces
 | 
			
		||||
fry locals definitions classes classes.algebra generic
 | 
			
		||||
fry locals definitions classes classes.algebra generic math
 | 
			
		||||
combinators math.private
 | 
			
		||||
stack-checker.dependencies
 | 
			
		||||
stack-checker.backend
 | 
			
		||||
compiler.tree
 | 
			
		||||
| 
						 | 
				
			
			@ -94,9 +95,42 @@ M: #push remove-dead-code*
 | 
			
		|||
    [ in-d>> #drop remove-dead-code* ]
 | 
			
		||||
    bi ;
 | 
			
		||||
 | 
			
		||||
: define-simplifications ( word seq -- )
 | 
			
		||||
    "simplifications" set-word-prop ;
 | 
			
		||||
 | 
			
		||||
\ /mod {
 | 
			
		||||
    { { f t } /i }
 | 
			
		||||
    { { t f } mod }
 | 
			
		||||
} define-simplifications
 | 
			
		||||
 | 
			
		||||
\ fixnum/mod {
 | 
			
		||||
    { { f t } fixnum/i }
 | 
			
		||||
    { { t f } fixnum-mod }
 | 
			
		||||
} define-simplifications
 | 
			
		||||
 | 
			
		||||
\ bignum/mod {
 | 
			
		||||
    { { f t } bignum/i }
 | 
			
		||||
    { { t f } bignum-mod }
 | 
			
		||||
} define-simplifications
 | 
			
		||||
 | 
			
		||||
: out-d-matches? ( out-d seq -- ? )
 | 
			
		||||
    [ [ live-value? ] [ drop t ] if ] 2all? not ;
 | 
			
		||||
 | 
			
		||||
: (simplify-call) ( #call -- new-word/f )
 | 
			
		||||
    [ out-d>> ] [ word>> "simplifications" word-prop ] bi
 | 
			
		||||
    [ first out-d-matches? ] with find nip dup [ second ] when ;
 | 
			
		||||
 | 
			
		||||
: simplify-call ( #call -- nodes )
 | 
			
		||||
    dup (simplify-call) [
 | 
			
		||||
        >>word [ filter-live ] change-out-d
 | 
			
		||||
    ] when* ;
 | 
			
		||||
 | 
			
		||||
M: #call remove-dead-code*
 | 
			
		||||
    dup dead-flushable-call?
 | 
			
		||||
    [ remove-flushable-call ] [ maybe-drop-dead-outputs ] if ;
 | 
			
		||||
    {
 | 
			
		||||
        { [ dup dead-flushable-call? ] [ remove-flushable-call ] }
 | 
			
		||||
        { [ dup word>> "simplifications" word-prop ] [ simplify-call ] }
 | 
			
		||||
        [ maybe-drop-dead-outputs ]
 | 
			
		||||
    } cond ;
 | 
			
		||||
 | 
			
		||||
M: #shuffle remove-dead-code*
 | 
			
		||||
    [ filter-live ] change-in-d
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue