basis/compiler/tree/recursive/recursive-tests.factor

   1 USING: tools.test kernel combinators.short-circuit math sequences accessors make
   2 compiler.tree
   3 compiler.tree.builder
   4 compiler.tree.combinators
   5 compiler.tree.recursive
   6 compiler.tree.recursive.private ;
   7 IN: compiler.tree.recursive.tests
   8
   9 { { f f f f } } [ f { f t f f } (tail-calls) ] unit-test
  10 { { f f f t } } [ t { f t f f } (tail-calls) ] unit-test
  11 { { f t t t } } [ t { f f t t } (tail-calls) ] unit-test
  12 { { f f f t } } [ t { f f t f } (tail-calls) ] unit-test
  13
  14 : label-is-loop? ( nodes word -- ? )
  15     swap [
  16         [
  17             dup {
  18                 [ #recursive? ]
  19                 [ label>> loop?>> ]
  20             } 1&& [ label>> word>> , ] [ drop ] if
  21         ] each-node
  22     ] V{ } make member? ;
  23
  24 : label-is-not-loop? ( nodes word -- ? )
  25     swap [
  26         [
  27             dup {
  28                 [ #recursive? ]
  29                 [ label>> loop?>> not ]
  30             } 1&& [ label>> word>> , ] [ drop ] if
  31         ] each-node
  32     ] V{ } make member? ;
  33
  34 : loop-test-1 ( a -- )
  35     dup [ 1 + loop-test-1 ] [ drop ] if ; inline recursive
  36
  37 { t } [
  38     [ loop-test-1 ] build-tree analyze-recursive
  39     \ loop-test-1 label-is-loop?
  40 ] unit-test
  41
  42 { t } [
  43     [ loop-test-1 1 2 3 ] build-tree analyze-recursive
  44     \ loop-test-1 label-is-loop?
  45 ] unit-test
  46
  47 { t } [
  48     [ [ loop-test-1 ] each ] build-tree analyze-recursive
  49     \ loop-test-1 label-is-loop?
  50 ] unit-test
  51
  52 { t } [
  53     [ [ loop-test-1 ] each ] build-tree analyze-recursive
  54     \ (each-integer) label-is-loop?
  55 ] unit-test
  56
  57 : loop-test-2 ( a b -- a' )
  58     dup [ 1 + loop-test-2 1 - ] [ drop ] if ; inline recursive
  59
  60 { t } [
  61     [ loop-test-2 ] build-tree analyze-recursive
  62     \ loop-test-2 label-is-not-loop?
  63 ] unit-test
  64
  65 : loop-test-3 ( a -- )
  66     dup [ [ loop-test-3 ] each ] [ drop ] if ; inline recursive
  67
  68 { t } [
  69     [ loop-test-3 ] build-tree analyze-recursive
  70     \ loop-test-3 label-is-not-loop?
  71 ] unit-test
  72
  73 { f } [
  74     [ [ [ ] map ] map ] build-tree analyze-recursive
  75     [
  76         dup #recursive? [ label>> loop?>> not ] [ drop f ] if
  77     ] contains-node?
  78 ] unit-test
  79
  80 : blah ( -- value ) f ;
  81
  82 DEFER: a
  83
  84 : b ( -- )
  85     blah [ b ] [ a ] if ; inline recursive
  86
  87 : a ( -- )
  88     blah [ b ] [ a ] if ; inline recursive
  89
  90 { t } [
  91     [ a ] build-tree analyze-recursive
  92     \ a label-is-loop?
  93 ] unit-test
  94
  95 { t } [
  96     [ a ] build-tree analyze-recursive
  97     \ b label-is-loop?
  98 ] unit-test
  99
 100 { t } [
 101     [ b ] build-tree analyze-recursive
 102     \ a label-is-loop?
 103 ] unit-test
 104
 105 { t } [
 106     [ a ] build-tree analyze-recursive
 107     \ b label-is-loop?
 108 ] unit-test
 109
 110 DEFER: a'
 111
 112 : b' ( -- )
 113     blah [ b' b' ] [ a' ] if ; inline recursive
 114
 115 : a' ( -- )
 116     blah [ b' ] [ a' ] if ; inline recursive
 117
 118 { f } [
 119     [ a' ] build-tree analyze-recursive
 120     \ a' label-is-loop?
 121 ] unit-test
 122
 123 { f } [
 124     [ b' ] build-tree analyze-recursive
 125     \ b' label-is-loop?
 126 ] unit-test
 127
 128 ! I used to think this should be f, but doing this on pen and
 129 ! paper almost convinced me that a loop conversion here is
 130 ! sound.
 131
 132 { t } [
 133     [ b' ] build-tree analyze-recursive
 134     \ a' label-is-loop?
 135 ] unit-test
 136
 137 { f } [
 138     [ a' ] build-tree analyze-recursive
 139     \ b' label-is-loop?
 140 ] unit-test
 141
 142 DEFER: a''
 143
 144 : b'' ( a -- b )
 145     a'' ; inline recursive
 146
 147 : a'' ( a -- b )
 148     dup [ b'' a'' ] when ; inline recursive
 149
 150 { t } [
 151     [ a'' ] build-tree analyze-recursive
 152     \ a'' label-is-not-loop?
 153 ] unit-test
 154
 155 { t } [
 156     [ a'' ] build-tree analyze-recursive
 157     \ b'' label-is-loop?
 158 ] unit-test
 159
 160 { t } [
 161     [ b'' ] build-tree analyze-recursive
 162     \ a'' label-is-loop?
 163 ] unit-test
 164
 165 { t } [
 166     [ b'' ] build-tree analyze-recursive
 167     \ b'' label-is-not-loop?
 168 ] unit-test
 169
 170 : loop-in-non-loop ( x quot: ( i -- ) -- )
 171     over 0 > [
 172         [ [ 1 - ] dip loop-in-non-loop ] [ call ] 2bi
 173     ] [ 2drop ] if ; inline recursive
 174
 175 { t } [
 176     [ 10 [ [ drop ] each-integer ] loop-in-non-loop ]
 177     build-tree analyze-recursive
 178     \ (each-integer) label-is-loop?
 179 ] unit-test
 180
 181 DEFER: a'''
 182
 183 : b''' ( -- )
 184     blah [ b''' ] [ a''' b''' ] if ; inline recursive
 185
 186 : a''' ( -- )
 187     blah [ b''' ] [ a''' ] if ; inline recursive
 188
 189 { t } [
 190     [ b''' ] build-tree analyze-recursive
 191     \ a''' label-is-loop?
 192 ] unit-test
 193
 194 DEFER: b4
 195
 196 : a4 ( a -- b ) dup [ b4 ] when ; inline recursive
 197
 198 : b4 ( a -- b ) dup [ a4 reverse ] when ; inline recursive
 199
 200 { t } [ [ b4 ] build-tree analyze-recursive \ a4 label-is-loop? ] unit-test
 201 { t } [ [ b4 ] build-tree analyze-recursive \ b4 label-is-not-loop? ] unit-test
 202 { t } [ [ a4 ] build-tree analyze-recursive \ a4 label-is-not-loop? ] unit-test
 203 { t } [ [ a4 ] build-tree analyze-recursive \ b4 label-is-loop? ] unit-test