factor/basis/optimizer/def-use/def-use-tests.factor

USING: accessors inference inference.dataflow optimizer
optimizer.def-use namespaces assocs kernel sequences math
tools.test words sets ;
IN: optimizer.def-use.tests

[ 3 { 1 1 1 } ] [
    [ 1 2 3 ] dataflow compute-def-use drop
    def-use get values dup length swap [ length ] map
] unit-test

: kill-set ( quot -- seq )
    dataflow compute-def-use drop compute-dead-literals keys
    [ value-literal ] map ;

[ { [ + ] } ] [
    [ [ 1 2 3 ] [ + ] over drop drop ] kill-set
] unit-test

[ { [ + ] } ] [
    [ [ + ] [ 1 2 3 ] over drop nip ] kill-set
] unit-test

[ { [ + ] } ] [
    [ [ + ] dup over 3drop ] kill-set
] unit-test

[ t ] [
    { [ + ] [ - ] }
    [ [ + ] [ - ] [ 1 2 3 ] pick pick 2drop >r 2drop r> ]
    kill-set set=
] unit-test

[ t ] [
    { [ + ] }
    [ [ 1 2 3 ] [ 4 5 6 ] [ + ] pick >r drop r> ]
    kill-set set=
] unit-test

[ t ] [
    [ [ 1 ] [ 2 ] ] [ [ 1 ] [ 2 ] if ] kill-set set=
] unit-test

[ t ] [
    { [ 5 ] [ dup ] }
    [ [ 5 ] [ dup ] if ] kill-set set=
] unit-test

[ t ] [
    [ [ dup ] [ dup ] ]
    [ 5 swap [ dup ] [ dup ] if ]
    kill-set set=
] unit-test

[ t ] [
    [ 5 [ dup ] [ dup ] ]
    [ 5 swap [ dup ] [ dup ] if 2drop ]
    kill-set set=
] unit-test

: literal-kill-test ( a b -- )
    dup [ >r dup slip r> literal-kill-test ] [ 2drop ] if ; inline

[ t ] [
    { [ ] [ >r dup slip r> literal-kill-test ] [ 2drop ] }
    [ [ ] swap literal-kill-test ] kill-set set=
] unit-test

: p1 drop 4 ;
: p2 3drop 1 2 ;
: p3 drop 3 ;

: regression-0
    [ 2drop ] with assoc-find ;

[ t ] [
    [ [ 2drop ] with assoc-find ] kill-set
    [ 2drop ] swap member?
] unit-test

[ t ] [
    [ [ "x" 2drop ] assoc-find ] kill-set
    [ "x" 2drop ] swap member?
] unit-test

: 2swap ( x y z t -- z t x y )
    rot >r rot r> ; inline

: regression-1
    [ 2swap [ swapd * -rot p2 +@ ] 2keep ] assoc-each ;

[ { t t } ] [
    {
        [ swapd * -rot p2 +@ ]
        [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
    } \ regression-1 def>> kill-set [ member? ] curry map
] unit-test

: regression-2 ( x y -- x.y )
    [ p1 ] bi@ [
        [
            rot
            [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
            assoc-each 2drop
        ] with assoc-each
    ] H{ } make-assoc p3 ;

[ { t t t t t } ] [
    {
        [ p1 ]
        [ swapd * -rot p2 +@ ]
        [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
        [
            rot
            [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
            assoc-each 2drop
        ]
        [
            [
                rot
                [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
                assoc-each 2drop
            ] with assoc-each
        ]
    }
    \ regression-2 def>> kill-set
    [ member? ] curry map
] unit-test