Improving modular arithmetic optimization to be aware of words like set-alien-unsigned-2

diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
index 6e1c32d89d632b96520bd08a607e183d79123cf5..55a8cb9ea29853f77eb60a3f7c75c2ce1eff8f72 100644 (file)
--- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
+++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
@@ -3,7 +3,8 @@ USING: kernel kernel.private tools.test math math.partial-dispatch
 math.private accessors slots.private sequences strings sbufs
 compiler.tree.builder
 compiler.tree.optimizer
-compiler.tree.debugger ;
+compiler.tree.debugger
+alien.accessors layouts combinators byte-arrays ;
 
 : test-modular-arithmetic ( quot -- quot' )
     build-tree optimize-tree nodes>quot ;
@@ -135,4 +136,36 @@ TUPLE: declared-fixnum { x fixnum } ;
 ] unit-test
 
 [ [ >fixnum 255 fixnum-bitand ] ]
-[ [ >integer 256 rem ] test-modular-arithmetic ] unit-test
\ No newline at end of file
+[ [ >integer 256 rem ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-1 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-1 ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-2 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-2 ] test-modular-arithmetic ] unit-test
+
+cell {
+    { 4 [ [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-4 ] ] ] }
+    { 8 [ [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-4 ] ] ] }
+} case
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-4 ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-8 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-8 ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-1 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-1 ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-2 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-2 ] test-modular-arithmetic ] unit-test
+
+cell {
+    { 4 [ [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-4 ] ] ] }
+    { 8 [ [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-4 ] ] ] }
+} case
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-4 ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-8 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-8 ] test-modular-arithmetic ] unit-test
+
+[ t ] [ [ { fixnum byte-array } declare [ + ] with map ] { + fixnum+ >fixnum } inlined? ] unit-test

diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
index 31939a0d229e605435a05e84edfde81365fc7d4d..6ddefa93073416d21c27e24fd72effddd079f3cc 100644 (file)
--- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
+++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math math.partial-dispatch namespaces sequences sets
 accessors assocs words kernel memoize fry combinators
-combinators.short-circuit
+combinators.short-circuit layouts alien.accessors
 compiler.tree
 compiler.tree.combinators
 compiler.tree.def-use
@@ -28,6 +28,16 @@ IN: compiler.tree.modular-arithmetic
 { bitand bitor bitxor bitnot }
 [ t "modular-arithmetic" set-word-prop ] each
 
+{
+    >fixnum
+    set-alien-unsigned-1 set-alien-signed-1
+    set-alien-unsigned-2 set-alien-signed-2
+}
+cell 8 = [
+    { set-alien-unsigned-4 set-alien-signed-4 } append
+] when
+[ t "low-order" set-word-prop ] each
+
 SYMBOL: modularize-values
 
 : modular-value? ( value -- ? )
@@ -54,7 +64,7 @@ M: node maybe-modularize* 2drop ;
 GENERIC: compute-modularized-values* ( node -- )
 
 M: #call compute-modularized-values*
-    dup word>> \ >fixnum eq?
+    dup word>> "low-order" word-prop
     [ in-d>> first maybe-modularize ] [ drop ] if ;
 
 M: node compute-modularized-values* drop ;