basis/compiler/tests/templates-early.factor

   1 ! Testing templates machinery without compiling anything
   2 IN: compiler.tests
   3 USING: compiler compiler.generator compiler.generator.registers
   4 compiler.generator.registers.private tools.test namespaces
   5 sequences words kernel math effects definitions compiler.units
   6 accessors cpu.architecture make ;
   7
   8 : <int-vreg> ( n -- vreg ) int-regs <vreg> ;
   9
  10 [
  11     [ ] [ init-templates ] unit-test
  12
  13     [ V{ 3 } ] [ 3 fresh-object fresh-objects get ] unit-test
  14
  15     [ ] [ 0 <int-vreg> phantom-push ] unit-test
  16
  17     [ ] [ compute-free-vregs ] unit-test
  18
  19     [ f ] [ 0 <int-vreg> int-regs free-vregs member? ] unit-test
  20
  21     [ f ] [
  22         [
  23             copy-templates
  24             1 <int-vreg> phantom-push
  25             compute-free-vregs
  26             1 <int-vreg> int-regs free-vregs member?
  27         ] with-scope
  28     ] unit-test
  29
  30     [ t ] [ 1 <int-vreg> int-regs free-vregs member? ] unit-test
  31 ] with-scope
  32
  33 [
  34     [ ] [ init-templates ] unit-test
  35
  36     [ ] [ T{ effect f 3 { 1 2 0 } f } phantom-shuffle ] unit-test
  37
  38     [ 3 ] [ live-locs length ] unit-test
  39
  40     [ ] [ T{ effect f 2 { 1 0 } f } phantom-shuffle ] unit-test
  41
  42     [ 2 ] [ live-locs length ] unit-test
  43 ] with-scope
  44
  45 [
  46     [ ] [ init-templates ] unit-test
  47
  48     H{ } clone compiled set
  49
  50     [ ] [ gensym gensym begin-compiling ] unit-test
  51
  52     [ t ] [ [ end-basic-block ] { } make empty? ] unit-test
  53
  54     3 fresh-object
  55
  56     [ f ] [ [ end-basic-block ] { } make empty? ] unit-test
  57 ] with-scope
  58
  59 [
  60     [ ] [ init-templates ] unit-test
  61
  62     H{
  63         { +input+ { { f "x" } } }
  64     } clone [
  65         [ 1 0 ] [ +input+ get { } { } guess-vregs ] unit-test
  66         [ ] [ finalize-contents ] unit-test
  67         [ ] [ [ template-inputs ] { } make drop ] unit-test
  68     ] bind
  69 ] with-scope
  70
  71 ! Test template picking strategy
  72 SYMBOL: template-chosen
  73
  74 : template-test ( a b -- c d ) ;
  75
  76 \ template-test {
  77     {
  78         [
  79             1 template-chosen get push
  80         ] H{
  81             { +input+ { { f "obj" } { [ ] "n" } } }
  82             { +output+ { "obj" "obj" } }
  83         }
  84     }
  85     {
  86         [
  87             2 template-chosen get push
  88         ] H{
  89             { +input+ { { f "obj" } { f "n" } } }
  90             { +output+ { "obj" "n" } }
  91         }
  92     }
  93 } define-intrinsics
  94
  95 [ V{ 2 } ] [
  96     V{ } clone template-chosen set
  97     0 0 [ template-test ] compile-call 2drop
  98     template-chosen get
  99 ] unit-test
 100
 101 [ V{ 1 } ] [
 102     V{ } clone template-chosen set
 103     1 [ dup 0 template-test ] compile-call 3drop
 104     template-chosen get
 105 ] unit-test
 106
 107 [ V{ 1 } ] [
 108     V{ } clone template-chosen set
 109     1 [ 0 template-test ] compile-call 2drop
 110     template-chosen get
 111 ] unit-test
 112
 113 ! Regression
 114 [
 115     [ ] [ init-templates ] unit-test
 116
 117     ! dup dup
 118     [ ] [
 119         T{ effect f { "x" } { "x" "x" } } phantom-shuffle
 120         T{ effect f { "x" } { "x" "x" } } phantom-shuffle
 121     ] unit-test
 122
 123     ! This is not empty since a load instruction is emitted
 124     [ f ] [
 125         [ { { f "x" } } +input+ set load-inputs ] { } make
 126         empty?
 127     ] unit-test
 128
 129     ! This is empty since we already loaded the value
 130     [ t ] [
 131         [ { { f "x" } } +input+ set load-inputs ] { } make
 132         empty?
 133     ] unit-test
 134
 135     ! This is empty since we didn't change the stack
 136     [ t ] [ [ end-basic-block ] { } make empty? ] unit-test
 137 ] with-scope
 138
 139 ! Regression
 140 [
 141     [ ] [ init-templates ] unit-test
 142
 143     ! >r r>
 144     [ ] [
 145         1 phantom->r
 146         1 phantom-r>
 147     ] unit-test
 148
 149     ! This is empty since we didn't change the stack
 150     [ t ] [ [ end-basic-block ] { } make empty? ] unit-test
 151
 152     ! >r r>
 153     [ ] [
 154         1 phantom->r
 155         1 phantom-r>
 156     ] unit-test
 157
 158     [ ] [ { object } set-operand-classes ] unit-test
 159
 160     ! This is empty since we didn't change the stack
 161     [ t ] [ [ end-basic-block ] { } make empty? ] unit-test
 162 ] with-scope
 163
 164 ! Regression
 165 [
 166     [ ] [ init-templates ] unit-test
 167
 168     [ ] [ { object object } set-operand-classes ] unit-test
 169
 170     ! 2dup
 171     [ ] [
 172         T{ effect f { "x" "y" } { "x" "y" "x" "y" } }
 173         phantom-shuffle
 174     ] unit-test
 175
 176     [ ] [
 177         2 phantom-datastack get phantom-input
 178         [ { { f "a" } { f "b" } } lazy-load ] { } make drop
 179     ] unit-test
 180
 181     [ t ] [
 182         phantom-datastack get stack>> [ cached? ] all?
 183     ] unit-test
 184
 185     ! >r
 186     [ ] [
 187         1 phantom->r
 188     ] unit-test
 189
 190     ! This should not fail
 191     [ ] [ [ end-basic-block ] { } make drop ] unit-test
 192 ] with-scope
 193
 194 ! Regression
 195 SYMBOL: templates-chosen
 196
 197 V{ } clone templates-chosen set
 198
 199 : template-choice-1 ;
 200
 201 \ template-choice-1
 202 [ "template-choice-1" templates-chosen get push ]
 203 H{
 204     { +input+ { { f "obj" } { [ ] "n" } } }
 205     { +output+ { "obj" } }
 206 } define-intrinsic
 207
 208 : template-choice-2 ;
 209
 210 \ template-choice-2
 211 [ "template-choice-2" templates-chosen get push drop ]
 212 { { f "x" } { f "y" } } define-if-intrinsic
 213
 214 [ ] [
 215     [ 2 template-choice-1 template-choice-2 ]
 216     [ define-temp ] with-compilation-unit drop
 217 ] unit-test
 218
 219 [ V{ "template-choice-1" "template-choice-2" } ]
 220 [ templates-chosen get ] unit-test