From 9048233d276ecae8acf739a313fbf2d4156d7856 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 6 Nov 2011 19:20:33 -0800
Subject: [PATCH] compiler.tree.dead-code: Rewrite /mod to /i or mod in the
dead-code pass in the high level optimizer. Fixes #279.
---
.../tree/dead-code/dead-code-tests.factor | 15 ++++++-
.../tree/dead-code/simple/simple.factor | 40 +++++++++++++++++--
2 files changed, 51 insertions(+), 4 deletions(-)
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