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

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