compiler.tree.propagation.*: new and fixed tests for the new propagation

behaviour for mod

diff --git a/basis/compiler/tree/propagation/inlining/inlining-tests.factor b/basis/compiler/tree/propagation/inlining/inlining-tests.factor
new file mode 100644 (file)
index 0000000..16dd94d
--- /dev/null
+++ b/basis/compiler/tree/propagation/inlining/inlining-tests.factor
@@ -0,0 +1,8 @@
+USING: accessors compiler.tree.builder compiler.tree.propagation
+compiler.tree.propagation.inlining kernel math sequences tools.test ;
+IN: compiler.tree.propagation.inlining.tests
+
+{ t } [
+    [ >bignum 10 mod ] build-tree propagate
+    fourth dup word>> do-inlining
+] unit-test

diff --git a/basis/compiler/tree/propagation/known-words/known-words-tests.factor b/basis/compiler/tree/propagation/known-words/known-words-tests.factor
new file mode 100644 (file)
index 0000000..dd8974d
--- /dev/null
+++ b/basis/compiler/tree/propagation/known-words/known-words-tests.factor
@@ -0,0 +1,21 @@
+USING: compiler.tree.propagation.known-words kernel math math.intervals
+tools.test ;
+IN: compiler.tree.propagation.known-words.tests
+
+{
+    fixnum
+    T{ interval { from { -19 t } } { to { 19 t } } }
+} [
+    integer
+    T{ interval { from { -19 t } } { to { 19 t } } }
+    maybe>fixnum
+] unit-test
+
+{
+    object
+    T{ interval { from { -19 t } } { to { 19 t } } }
+} [
+    object
+    T{ interval { from { -19 t } } { to { 19 t } } }
+    maybe>fixnum
+] unit-test

diff --git a/basis/compiler/tree/propagation/simple/simple-tests.factor b/basis/compiler/tree/propagation/simple/simple-tests.factor
index c8b40550f4c25d549cdfbda90ff196a7c74dafec..13ab4a51c89569fa9c734d70c957c5cbe6310352 100644 (file)
--- a/basis/compiler/tree/propagation/simple/simple-tests.factor
+++ b/basis/compiler/tree/propagation/simple/simple-tests.factor
@@ -1,72 +1,39 @@
 USING: accessors arrays assocs compiler.tree
 compiler.tree.propagation.constraints compiler.tree.propagation.copy
-compiler.tree.propagation.info compiler.tree.propagation.simple kernel math
-math.intervals math.private namespaces sequences system tools.test words ;
+compiler.tree.propagation.info compiler.tree.propagation.simple hashtables
+kernel math math.intervals math.private namespaces sequences system tools.test
+words ;
 IN: compiler.tree.propagation.simple.tests
 
+: make-value-infos ( classes intervals -- seq )
+    [ <class/interval-info>  ] 2map ;
+
 : fixnum-value-infos ( -- infos )
-    {
-        H{
-            {
-                1
-                T{ value-info-state
-                   { class fixnum }
-                   { interval
-                     T{ interval
-                        { from { 56977 t } }
-                        { to { 56977 t } }
-                     }
-                   }
-                   { literal 56977 }
-                   { literal? t }
-                }
-            }
-            {
-                2
-                T{ value-info-state
-                   { class fixnum }
-                   { interval
-                     T{ interval
-                        { from { 8098 t } }
-                        { to { 8098 t } }
-                     }
-                   }
-                   { literal 8098 }
-                   { literal? t }
-                }
-            }
-        }
-    } ;
+    { fixnum fixnum } 56977 [a,a] 8098 [a,a] 2array make-value-infos ;
 
 : object-value-infos ( -- infos )
-    {
-        H{
-            {
-                1
-                T{ value-info-state
-                   { class object }
-                   { interval full-interval }
-                }
-            }
-            {
-                2
-                T{ value-info-state
-                   { class object }
-                   { interval full-interval }
-                }
-            }
-        }
-    } ;
+    { object object } { full-interval full-interval } make-value-infos ;
+
+: bignum-value-infos ( -- infos )
+    { bignum bignum } full-interval 20 [a,a] 2array
+    make-value-infos ;
+
+: full-interval-and-bignum-literal ( -- infos )
+    { object bignum } full-interval 20 [a,a] 2array
+    make-value-infos ;
+
+: indexize ( seq -- assoc )
+    [ swap 2array ] map-index ;
 
 : setup-value-infos ( value-infos -- )
-    value-infos set
-    H{ { 1 1 } { 2 2 } { 3 3 } } copies set ;
+    indexize >hashtable 1array value-infos set
+    H{ { 0 0 } { 1 1 } { 2 2 } } copies set ;
 
 : #call-fixnum* ( -- node )
-    T{ #call { word fixnum* } { in-d V{ 1 2 } } { out-d { 3 } } } ;
+    T{ #call { word fixnum* } { in-d V{ 0 1 } } { out-d { 3 } } } ;
 
-: #call-fixnum/mod ( -- node )
-    T{ #call { word fixnum/mod } { in-d V{ 1 2 } } { out-d { 4 5 } } } ;
+: call-outputs-quot-of-word ( inputs outputs word -- value-infos )
+    <#call> dup word>> call-outputs-quot ;
 
 { } [
     fixnum-value-infos setup-value-infos
@@ -74,10 +41,6 @@ IN: compiler.tree.propagation.simple.tests
     propagate-input-classes
 ] unit-test
 
-{ t } [
-    fixnum-value-infos setup-value-infos 1 value-info literal?>>
-] unit-test
-
 {
     {
         T{ value-info-state
@@ -97,7 +60,7 @@ IN: compiler.tree.propagation.simple.tests
     }
 } [
     fixnum-value-infos setup-value-infos
-    #call-fixnum/mod dup word>> call-outputs-quot
+    V{ 0 1 } V{ 2 3 } \ fixnum/mod call-outputs-quot-of-word
 ] unit-test
 
 ! The result of fixnum-mod should always be a fixnum.
@@ -116,7 +79,36 @@ cpu x86.64? [
         }
     } [
         object-value-infos setup-value-infos
-        T{ #call { word fixnum-mod } { in-d V{ 1 2 } } { out-d { 4 } } }
-        dup word>> call-outputs-quot
+        V{ 0 1 } V{ 2 } \ fixnum-mod call-outputs-quot-of-word
     ] unit-test
 ] when
+
+! Downgrading should do its thing here.
+{
+    {
+        T{ value-info-state
+           { class fixnum }
+           { interval
+             T{ interval { from { -19 t } } { to { 19 t } } }
+           }
+        }
+    }
+} [
+    bignum-value-infos setup-value-infos
+    V{ 0 1 } V{ 2 } \ mod call-outputs-quot-of-word
+] unit-test
+
+! But not here because the argument to mod might be a real.
+{
+    {
+        T{ value-info-state
+           { class real }
+           { interval
+             T{ interval { from { -20 f } } { to { 20 f } } }
+           }
+        }
+    }
+} [
+    full-interval-and-bignum-literal setup-value-infos
+    V{ 0 1 } V{ 2 } \ mod call-outputs-quot-of-word
+] unit-test