diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor index e3ed18b19e..27840ea758 100644 --- a/basis/compiler/tree/dead-code/dead-code-tests.factor +++ b/basis/compiler/tree/dead-code/dead-code-tests.factor @@ -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 diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor index 46da6232df..38942d2f0f 100644 --- a/basis/compiler/tree/dead-code/simple/simple.factor +++ b/basis/compiler/tree/dead-code/simple/simple.factor @@ -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