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

   1 IN: optimizer.def-use.tests
   2 USING: inference inference.dataflow optimizer optimizer.def-use
   3 namespaces assocs kernel sequences math tools.test words sets ;
   4
   5 [ 3 { 1 1 1 } ] [
   6     [ 1 2 3 ] dataflow compute-def-use drop
   7     def-use get values dup length swap [ length ] map
   8 ] unit-test
   9
  10 : kill-set ( quot -- seq )
  11     dataflow compute-def-use drop compute-dead-literals keys
  12     [ value-literal ] map ;
  13
  14 [ { [ + ] } ] [
  15     [ [ 1 2 3 ] [ + ] over drop drop ] kill-set
  16 ] unit-test
  17
  18 [ { [ + ] } ] [
  19     [ [ + ] [ 1 2 3 ] over drop nip ] kill-set
  20 ] unit-test
  21
  22 [ { [ + ] } ] [
  23     [ [ + ] dup over 3drop ] kill-set
  24 ] unit-test
  25
  26 [ t ] [
  27     { [ + ] [ - ] }
  28     [ [ + ] [ - ] [ 1 2 3 ] pick pick 2drop >r 2drop r> ]
  29     kill-set set=
  30 ] unit-test
  31
  32 [ t ] [
  33     { [ + ] }
  34     [ [ 1 2 3 ] [ 4 5 6 ] [ + ] pick >r drop r> ]
  35     kill-set set=
  36 ] unit-test
  37
  38 [ t ] [
  39     [ [ 1 ] [ 2 ] ] [ [ 1 ] [ 2 ] if ] kill-set set=
  40 ] unit-test
  41
  42 [ t ] [
  43     { [ 5 ] [ dup ] }
  44     [ [ 5 ] [ dup ] if ] kill-set set=
  45 ] unit-test
  46
  47 [ t ] [
  48     [ [ dup ] [ dup ] ]
  49     [ 5 swap [ dup ] [ dup ] if ]
  50     kill-set set=
  51 ] unit-test
  52
  53 [ t ] [
  54     [ 5 [ dup ] [ dup ] ]
  55     [ 5 swap [ dup ] [ dup ] if 2drop ]
  56     kill-set set=
  57 ] unit-test
  58
  59 : literal-kill-test ( a b -- )
  60     dup [ >r dup slip r> literal-kill-test ] [ 2drop ] if ; inline
  61
  62 [ t ] [
  63     { [ ] [ >r dup slip r> literal-kill-test ] [ 2drop ] }
  64     [ [ ] swap literal-kill-test ] kill-set set=
  65 ] unit-test
  66
  67 : p1 drop 4 ;
  68 : p2 3drop 1 2 ;
  69 : p3 drop 3 ;
  70
  71 : regression-0
  72     [ 2drop ] with assoc-find ;
  73
  74 [ t ] [
  75     [ [ 2drop ] with assoc-find ] kill-set
  76     [ 2drop ] swap member?
  77 ] unit-test
  78
  79 [ t ] [
  80     [ [ "x" 2drop ] assoc-find ] kill-set
  81     [ "x" 2drop ] swap member?
  82 ] unit-test
  83
  84 : 2swap ( x y z t -- z t x y )
  85     rot >r rot r> ; inline
  86
  87 : regression-1
  88     [ 2swap [ swapd * -rot p2 +@ ] 2keep ] assoc-each ;
  89
  90 [ { t t } ] [
  91     {
  92         [ swapd * -rot p2 +@ ]
  93         [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
  94     } \ regression-1 def>> kill-set [ member? ] curry map
  95 ] unit-test
  96
  97 : regression-2 ( x y -- x.y )
  98     [ p1 ] bi@ [
  99         [
 100             rot
 101             [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
 102             assoc-each 2drop
 103         ] with assoc-each
 104     ] H{ } make-assoc p3 ;
 105
 106 [ { t t t t t } ] [
 107     {
 108         [ p1 ]
 109         [ swapd * -rot p2 +@ ]
 110         [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
 111         [
 112             rot
 113             [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
 114             assoc-each 2drop
 115         ]
 116         [
 117             [
 118                 rot
 119                 [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
 120                 assoc-each 2drop
 121             ] with assoc-each
 122         ]
 123     }
 124     \ regression-2 def>> kill-set
 125     [ member? ] curry map
 126 ] unit-test