]> gitweb.factorcode.org Git - factor.git/commitdiff
compiler.tree.modular-arithmetic: convert >integer >fixnum into >fixnum
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 7 May 2009 17:54:23 +0000 (12:54 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 7 May 2009 17:54:23 +0000 (12:54 -0500)
basis/compiler/tests/optimizer.factor
basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor

index f19a950711e1993f6b42d3f8e9d6e0df34fdf38a..fa1248435bf1806a9aa48f450ccb7d8fdb8af44f 100644 (file)
@@ -389,4 +389,10 @@ DEFER: loop-bbb
 
 [ f ] [ \ broken-declaration optimized? ] unit-test
 
-[ ] [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test
\ No newline at end of file
+[ ] [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test
+
+! Modular arithmetic bug
+: modular-arithmetic-bug ( a -- b ) >integer 256 mod ;
+
+[ 1 ] [ 257 modular-arithmetic-bug ] unit-test
+[ -10 ] [ -10 modular-arithmetic-bug ] unit-test
\ No newline at end of file
index 5d6a9cdea1661206c285515a78ef8602fd0d9c0a..6e1c32d89d632b96520bd08a607e183d79123cf5 100644 (file)
@@ -98,13 +98,18 @@ TUPLE: declared-fixnum { x fixnum } ;
     ] { mod fixnum-mod } inlined?
 ] unit-test
 
-
 [ f ] [
     [
         256 mod
     ] { mod fixnum-mod } inlined?
 ] unit-test
 
+[ f ] [
+    [
+        >fixnum 256 mod
+    ] { mod fixnum-mod } inlined?
+] unit-test
+
 [ f ] [
     [
         dup 0 >= [ 256 mod ] when
@@ -128,3 +133,6 @@ TUPLE: declared-fixnum { x fixnum } ;
         { integer } declare [ 256 rem ] map
     ] { mod fixnum-mod rem } inlined?
 ] unit-test
+
+[ [ >fixnum 255 fixnum-bitand ] ]
+[ [ >integer 256 rem ] test-modular-arithmetic ] unit-test
\ No newline at end of file
index de2600f69145d094915f6d3f561dfad5cdc16dd2..31939a0d229e605435a05e84edfde81365fc7d4d 100644 (file)
@@ -2,6 +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
 compiler.tree
 compiler.tree.combinators
 compiler.tree.def-use
@@ -69,6 +70,12 @@ GENERIC: optimize-modular-arithmetic* ( node -- nodes )
 : optimize->fixnum ( #call -- nodes )
     dup redundant->fixnum? [ drop f ] when ;
 
+: optimize->integer ( #call -- nodes )
+    dup out-d>> first actually-used-by dup length 1 = [
+        first node>> { [ #call? ] [ word>> \ >fixnum eq? ] } 1&&
+        [ drop { } ] when
+    ] [ drop ] if ;
+
 MEMO: fixnum-coercion ( flags -- nodes )
     [ [ ] [ >fixnum ] ? ] map '[ _ spread ] splice-quot ;
 
@@ -87,6 +94,7 @@ MEMO: fixnum-coercion ( flags -- nodes )
 M: #call optimize-modular-arithmetic*
     dup word>> {
         { [ dup \ >fixnum eq? ] [ drop optimize->fixnum ] }
+        { [ dup \ >integer eq? ] [ drop optimize->integer ] }
         { [ dup "modular-arithmetic" word-prop ] [ drop optimize-modular-op ] }
         [ drop ]
     } cond ;