compiler.tree.modular-arithmetic: >fixnum elimination and value info annotations...

diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
index 9c3f98d412613627d323f9f46240c6b1e83f07d9..7b972c516076680f44e7e5e1f4e398f751bfdf8f 100644 (file)
--- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
+++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
@@ -249,3 +249,12 @@ cell {
     { fixnum+ >fixnum } inlined?
 ] unit-test
 
+[ f ] [
+    [ f >fixnum ]
+    { >fixnum } inlined?
+] unit-test
+
+[ f ] [
+    [ [ >fixnum ] 2dip set-alien-unsigned-1 ]
+    { >fixnum } inlined?
+] unit-test
\ No newline at end of file

diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
index 84f11aeb47268285e9a7a373a1285c0e9db47a5f..d97295d0f17daca03522b7b419e8ef3540cefa21 100644 (file)
--- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
+++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
@@ -124,23 +124,13 @@ SYMBOL: changed?
 GENERIC: optimize-modular-arithmetic* ( node -- nodes )
 
 M: #push optimize-modular-arithmetic*
-    dup out-d>> first modular-value? [
-        [ >fixnum ] change-literal
-    ] when ;
+    dup [ out-d>> first modular-value? ] [ literal>> real? ] bi and
+    [ [ >fixnum ] change-literal ] when ;
 
-: input-will-be-fixnum? ( #call -- ? )
+: redundant->fixnum? ( #call -- ? )
     in-d>> first actually-defined-by
     [ value>> { [ modular-value? ] [ fixnum-value? ] } 1&& ] all? ;
 
-: output-will-be-coerced? ( #call -- ? )
-    out-d>> first modular-value? ;
-
-: redundant->fixnum? ( #call -- ? )
-    {
-        [ input-will-be-fixnum? ]
-        [ output-will-be-coerced? ]
-    } 1|| ;
-
 : optimize->fixnum ( #call -- nodes )
     dup redundant->fixnum? [ drop f ] when ;
 
@@ -172,7 +162,7 @@ MEMO: fixnum-coercion ( flags -- nodes )
     ] when ;
 
 : optimize-low-order-op ( #call -- nodes )
-    dup in-d>> first modular-value? [
+    dup in-d>> first fixnum-value? [
         [ ] [ in-d>> first ] [ info>> ] tri
         [ drop fixnum <class-info> ] change-at
     ] when ;

diff --git a/core/byte-arrays/byte-arrays-tests.factor b/core/byte-arrays/byte-arrays-tests.factor
index a23e4ecd745fc3222fb8f9e82258b34e8c10ba44..e28083b2dbf5a21a39f089224e261994479bcd13 100644 (file)
--- a/core/byte-arrays/byte-arrays-tests.factor
+++ b/core/byte-arrays/byte-arrays-tests.factor
@@ -1,4 +1,4 @@
-USING: tools.test byte-arrays sequences kernel ;\r
+USING: tools.test byte-arrays sequences kernel math ;\r
 IN: byte-arrays.tests\r
 \r
 [ 6 B{ 1 2 3 } ] [\r
@@ -11,3 +11,7 @@ IN: byte-arrays.tests
 [ -10 B{ } resize-byte-array ] must-fail\r
 \r
 [ B{ 123 } ] [ 123 1byte-array ] unit-test\r
+\r
+[ B{ 123 } ] [ 123 0 B{ 0 } [ set-nth ] keep ] unit-test\r
+\r
+[ B{ 123 } ] [ 123 >bignum 0 B{ 0 } [ set-nth ] keep ] unit-test
\ No newline at end of file

diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor
index 43a8373232d9c9c397d32db00a0e3f466c8ff220..3a08dd10d97907caa3365e628ccc18b5efcd508e 100644 (file)
--- a/core/io/streams/byte-array/byte-array-tests.factor
+++ b/core/io/streams/byte-array/byte-array-tests.factor
@@ -1,5 +1,5 @@
 USING: tools.test io.streams.byte-array io.encodings.binary
-io.encodings.utf8 io kernel arrays strings namespaces ;
+io.encodings.utf8 io kernel arrays strings namespaces math ;
 
 [ B{ } ] [ B{ } binary [ contents ] with-byte-reader ] unit-test
 [ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test
@@ -28,3 +28,8 @@ io.encodings.utf8 io kernel arrays strings namespaces ;
         read1
     ] with-byte-reader
 ] unit-test
+
+! Overly aggressive compiler optimizations
+[ B{ 123 } ] [
+    binary [ 123 >bignum write1 ] with-byte-writer
+] unit-test
\ No newline at end of file