compiler.tree.dead-code: Rewrite /mod to /i or mod in the dead-code pass in the high...

diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor
index e3ed18b19e671451339694c937bf98403b90cd7c..27840ea758ca4efb4b83f26448fd9a4f6da1f000 100644 (file)
--- 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 46da6232dfb40efa8154ef9f4f018f8e23b5dbbb..38942d2f0f3d55d96c06def034e610e4dbdea013 100644 (file)
--- 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