USING: accessors arrays assocs compiler.tree
compiler.tree.propagation.constraints compiler.tree.propagation.copy
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 )
    { fixnum fixnum } 56977 [a,a] 8098 [a,a] 2array make-value-infos ;

: object-value-infos ( -- infos )
    { 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 -- )
    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{ 0 1 } } { out-d { 3 } } } ;

: call-outputs-quot-of-word ( inputs outputs word -- value-infos )
    <#call> dup word>> call-outputs-quot ;

{ } [
    fixnum-value-infos setup-value-infos
    #call-fixnum* dup word>> "input-classes" word-prop
    propagate-input-classes
] unit-test

{
    {
        T{ value-info-state
           { class fixnum }
           { interval
             T{ interval { from { 7 t } } { to { 7 t } } }
           }
           { literal 7 }
           { literal? t }
        }
        T{ value-info-state
           { class fixnum }
           { interval
             T{ interval { from { 0 t } } { to { 8097 t } } }
           }
        }
    }
} [
    fixnum-value-infos setup-value-infos
    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.
cpu x86.64? [
    {
        {
            T{ value-info-state
               { class fixnum }
               { interval
                 T{ interval
                    { from { -576460752303423488 t } }
                    { to { 576460752303423487 t } }
                 }
               }
            }
        }
    } [
        object-value-infos setup-value-infos
        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