basis/optimizer/control/control-tests.factor

   1 IN: optimizer.control.tests
   2 USING: tools.test optimizer.control combinators kernel
   3 sequences inference.dataflow math inference classes strings
   4 optimizer ;
   5
   6 : label-is-loop? ( node word -- ? )
   7     [
   8         {
   9             { [ over #label? not ] [ 2drop f ] }
  10             { [ over #label-word over eq? not ] [ 2drop f ] }
  11             { [ over #label-loop? not ] [ 2drop f ] }
  12             [ 2drop t ]
  13         } cond
  14     ] curry node-exists? ;
  15
  16 : label-is-not-loop? ( node word -- ? )
  17     [
  18         {
  19             { [ over #label? not ] [ f ] }
  20             { [ over #label-word over eq? not ] [ f ] }
  21             { [ over #label-loop? ] [ f ] }
  22             [ t ]
  23         } cond 2nip
  24     ] curry node-exists? ;
  25
  26 : loop-test-1 ( a -- )
  27     dup [ 1+ loop-test-1 ] [ drop ] if ; inline
  28
  29 [ t ] [
  30     [ loop-test-1 ] dataflow detect-loops
  31     \ loop-test-1 label-is-loop?
  32 ] unit-test
  33
  34 [ t ] [
  35     [ loop-test-1 1 2 3 ] dataflow detect-loops
  36     \ loop-test-1 label-is-loop?
  37 ] unit-test
  38
  39 [ t ] [
  40     [ [ loop-test-1 ] each ] dataflow detect-loops
  41     \ loop-test-1 label-is-loop?
  42 ] unit-test
  43
  44 [ t ] [
  45     [ [ loop-test-1 ] each ] dataflow detect-loops
  46     \ (each-integer) label-is-loop?
  47 ] unit-test
  48
  49 : loop-test-2 ( a -- )
  50     dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline
  51
  52 [ t ] [
  53     [ loop-test-2 ] dataflow detect-loops
  54     \ loop-test-2 label-is-not-loop?
  55 ] unit-test
  56
  57 : loop-test-3 ( a -- )
  58     dup [ [ loop-test-3 ] each ] [ drop ] if ; inline
  59
  60 [ t ] [
  61     [ loop-test-3 ] dataflow detect-loops
  62     \ loop-test-3 label-is-not-loop?
  63 ] unit-test
  64
  65 : loop-test-4 ( a -- )
  66     dup [
  67         loop-test-4
  68     ] [
  69         drop
  70     ] if ; inline
  71
  72 : find-label ( node -- label )
  73     dup #label? [ node-successor find-label ] unless ;
  74
  75 : test-loop-exits
  76     dataflow detect-loops find-label
  77     dup node-param swap
  78     [ node-child find-tail find-loop-exits [ class ] map ] keep
  79     #label-loop? ;
  80
  81 [ { #values } t ] [
  82     [ loop-test-4 ] test-loop-exits
  83 ] unit-test
  84
  85 : loop-test-5 ( a -- )
  86     dup [
  87         dup string? [
  88             loop-test-5
  89         ] [
  90             drop
  91         ] if
  92     ] [
  93         drop
  94     ] if ; inline
  95
  96 [ { #values #values } t ] [
  97     [ loop-test-5 ] test-loop-exits
  98 ] unit-test
  99
 100 : loop-test-6 ( a -- )
 101     dup [
 102         dup string? [
 103             loop-test-6
 104         ] [
 105             3 throw
 106         ] if
 107     ] [
 108         drop
 109     ] if ; inline
 110
 111 [ { #values } t ] [
 112     [ loop-test-6 ] test-loop-exits
 113 ] unit-test
 114
 115 [ f ] [
 116     [ [ [ ] map ] map ] dataflow detect-loops
 117     [ dup #label? swap #loop? not and ] node-exists?
 118 ] unit-test
 119
 120 : blah f ;
 121
 122 DEFER: a
 123
 124 : b ( -- )
 125     blah [ b ] [ a ] if ; inline
 126
 127 : a ( -- )
 128     blah [ b ] [ a ] if ; inline
 129
 130 [ t ] [
 131     [ a ] dataflow detect-loops
 132     \ a label-is-loop?
 133 ] unit-test
 134
 135 [ t ] [
 136     [ a ] dataflow detect-loops
 137     \ b label-is-loop?
 138 ] unit-test
 139
 140 [ t ] [
 141     [ b ] dataflow detect-loops
 142     \ a label-is-loop?
 143 ] unit-test
 144
 145 [ t ] [
 146     [ a ] dataflow detect-loops
 147     \ b label-is-loop?
 148 ] unit-test
 149
 150 DEFER: a'
 151
 152 : b' ( -- )
 153     blah [ b' b' ] [ a' ] if ; inline
 154
 155 : a' ( -- )
 156     blah [ b' ] [ a' ] if ; inline
 157
 158 [ f ] [
 159     [ a' ] dataflow detect-loops
 160     \ a' label-is-loop?
 161 ] unit-test
 162
 163 [ f ] [
 164     [ b' ] dataflow detect-loops
 165     \ b' label-is-loop?
 166 ] unit-test
 167
 168 ! I used to think this should be f, but doing this on pen and
 169 ! paper almost convinced me that a loop conversion here is
 170 ! sound. The loop analysis algorithm looks pretty solid -- its
 171 ! a standard iterative dataflow problem after all -- so I'm
 172 ! tempted to believe the computer here
 173 [ t ] [
 174     [ b' ] dataflow detect-loops
 175     \ a' label-is-loop?
 176 ] unit-test
 177
 178 [ f ] [
 179     [ a' ] dataflow detect-loops
 180     \ b' label-is-loop?
 181 ] unit-test