library/test/compiler/optimizer.factor

   1 IN: temporary
   2 USING: assembler compiler compiler-backend generic inference
   3 kernel kernel-internals lists math prettyprint sequences strings
   4 test vectors words ;
   5
   6 ! Some dataflow tests
   7 ! [ 3 ] [ 1 2 3 (subst-value) ] unit-test
   8 ! [ 1 ] [ 1 2 2 (subst-value) ] unit-test
   9 !
  10 ! [ { "one" "one" "three" "three" } ]
  11 ! [
  12 !     { "one" "two" "three" } { 1 2 3 } { 1 1 3 3 }
  13 !     clone [ (subst-values) ] keep
  14 ! ] unit-test
  15 !
  16 ! [ << meet f { "one" 2 3 } >> ]
  17 ! [ "one" 1 << meet f { 1 2 3 } >> clone (subst-value) ] unit-test
  18
  19 ! Literal kill tests
  20 : kill-set*
  21     dataflow kill-set [ literal-value ] map ;
  22
  23 : foo 1 2 3 ;
  24
  25 [ { } ] [ \ foo word-def dataflow kill-set ] unit-test
  26
  27 [ { [ 1 ] [ 2 ] } ] [ [ [ 1 ] [ 2 ] ifte ] kill-set* ] unit-test
  28
  29 [ { [ 1 ] [ 2 ] } ] [ [ [ 1 ] [ 2 ] ifte ] kill-set* ] unit-test
  30
  31 : literal-kill-test-1 4 compiled-offset cell 2 * - ; compiled
  32
  33 [ 4 ] [ literal-kill-test-1 drop ] unit-test
  34
  35 : literal-kill-test-2 3 compiled-offset cell 2 * - ; compiled
  36
  37 [ 3 ] [ literal-kill-test-2 drop ] unit-test
  38
  39 : literal-kill-test-3 10 3 /mod drop ; compiled
  40
  41 [ 3 ] [ literal-kill-test-3 ] unit-test
  42
  43 [ { [ 3 ] [ dup ] 3 } ] [ [ [ 3 ] [ dup ] ifte drop ] kill-set* ] unit-test
  44
  45 : literal-kill-test-4
  46     5 swap [ 3 ] [ dup ] ifte 2drop ; compiled
  47
  48 [ ] [ t literal-kill-test-4 ] unit-test
  49 [ ] [ f literal-kill-test-4 ] unit-test
  50
  51 [ { 5 [ 3 ] [ dup ] 3 } ] [ \ literal-kill-test-4 word-def kill-set* ] unit-test
  52
  53 : literal-kill-test-5
  54     5 swap [ 5 ] [ dup ] ifte 2drop ; compiled
  55
  56 [ ] [ t literal-kill-test-5 ] unit-test
  57 [ ] [ f literal-kill-test-5 ] unit-test
  58
  59 [ { 5 [ 5 ] [ dup ] 5 } ] [ \ literal-kill-test-5 word-def kill-set* ] unit-test
  60
  61 : literal-kill-test-6
  62     5 swap [ dup ] [ dup ] ifte 2drop ; compiled
  63
  64 [ ] [ t literal-kill-test-6 ] unit-test
  65 [ ] [ f literal-kill-test-6 ] unit-test
  66
  67 [ { 5 [ dup ] [ dup ] } ] [ \ literal-kill-test-6 word-def kill-set* ] unit-test
  68
  69 : literal-kill-test-7
  70     [ 1 2 3 ] >r + r> drop ; compiled
  71
  72 [ 4 ] [ 2 2 literal-kill-test-7 ] unit-test
  73
  74 ! Test method inlining
  75 [ string ] [
  76     \ string
  77     [ repeated integer string mirror array reversed sbuf
  78     slice vector diagonal general-list ]
  79     min-class
  80 ] unit-test
  81
  82 [ f ] [
  83     \ fixnum
  84     [ fixnum integer letter ]
  85     min-class
  86 ] unit-test
  87
  88 [ fixnum ] [
  89     \ fixnum
  90     [ fixnum integer object ]
  91     min-class
  92 ] unit-test
  93
  94 [ integer ] [
  95     \ fixnum
  96     [ integer float object ]
  97     min-class
  98 ] unit-test
  99
 100 [ object ] [
 101     \ word
 102     [ integer float object ]
 103     min-class
 104 ] unit-test
 105
 106 GENERIC: xyz
 107 M: cons xyz xyz ;
 108
 109 [ ] [ \ xyz compile ] unit-test
 110
 111 ! Test predicate inlining
 112 : pred-test-1
 113     dup cons? [
 114         dup general-list? [ "general-list" ] [ "nope" ] ifte
 115     ] [
 116         "not a cons"
 117     ] ifte ; compiled
 118
 119 [ [[ 1 2 ]] "general-list" ] [ [[ 1 2 ]] pred-test-1 ] unit-test
 120
 121 : pred-test-2
 122     dup fixnum? [
 123         dup integer? [ "integer" ] [ "nope" ] ifte
 124     ] [
 125         "not a fixnum"
 126     ] ifte ; compiled
 127
 128 [ 1 "integer" ] [ 1 pred-test-2 ] unit-test
 129
 130 TUPLE: pred-test ;
 131
 132 : pred-test-3
 133     dup tuple? [
 134         dup pred-test? [ "pred-test" ] [ "nope" ] ifte
 135     ] [
 136         "not a tuple"
 137     ] ifte ; compiled
 138
 139 [ << pred-test >> "pred-test" ] [ << pred-test >> pred-test-3 ] unit-test
 140
 141 : pred-test-4
 142     dup pred-test? [
 143         dup tuple? [ "pred-test" ] [ "nope" ] ifte
 144     ] [
 145         "not a tuple"
 146     ] ifte ; compiled
 147
 148 [ << pred-test >> "pred-test" ] [ << pred-test >> pred-test-4 ] unit-test
 149
 150 : inline-test
 151     "nom" = ; compiled
 152
 153 [ t ] [ "nom" inline-test ] unit-test
 154 [ f ] [ "shayin" inline-test ] unit-test
 155 [ f ] [ 3 inline-test ] unit-test
 156
 157 : fixnum-declarations >fixnum 24 shift 1234 bitxor ; compiled
 158
 159 [ ] [ 1000000 fixnum-declarations . ] unit-test
 160
 161 ! regression
 162
 163 : literal-not-branch 0 not [ ] [ ] ifte ; compiled
 164
 165 [ ] [ literal-not-branch ] unit-test