basis/math/vectors/simd/simd-tests.factor

   1 USING: accessors arrays classes compiler compiler.tree.debugger
   2 effects fry io kernel kernel.private math math.functions
   3 math.private math.vectors math.vectors.simd
   4 math.vectors.simd.private prettyprint random sequences system
   5 tools.test vocabs assocs compiler.cfg.debugger words
   6 locals math.vectors.specialization combinators cpu.architecture
   7 math.vectors.conversion.backend
   8 math.vectors.simd.intrinsics namespaces byte-arrays alien
   9 specialized-arrays classes.struct eval classes.algebra sets
  10 quotations math.constants compiler.units ;
  11 QUALIFIED-WITH: alien.c-types c
  12 SPECIALIZED-ARRAY: c:float
  13 SIMD: c:char
  14 SIMD: c:uchar
  15 SIMD: c:short
  16 SIMD: c:ushort
  17 SIMD: c:int
  18 SIMD: c:uint
  19 SIMD: c:longlong
  20 SIMD: c:ulonglong
  21 SIMD: c:float
  22 SIMD: c:double
  23 IN: math.vectors.simd.tests
  24
  25 ! Make sure the functor doesn't generate bogus vocabularies
  26 2 [ [ "USE: math.vectors.simd SIMD: rubinius" eval( -- ) ] must-fail ] times
  27
  28 [ f ] [ "math.vectors.simd.instances.rubinius" vocab ] unit-test
  29
  30 ! Test type propagation
  31 [ V{ float } ] [ [ { float-4 } declare norm-sq ] final-classes ] unit-test
  32
  33 [ V{ float } ] [ [ { float-4 } declare norm ] final-classes ] unit-test
  34
  35 [ V{ float-4 } ] [ [ { float-4 } declare normalize ] final-classes ] unit-test
  36
  37 [ V{ float-4 } ] [ [ { float-4 float-4 } declare v+ ] final-classes ] unit-test
  38
  39 [ V{ float } ] [ [ { float-4 } declare second ] final-classes ] unit-test
  40
  41 [ V{ int-4 } ] [ [ { int-4 int-4 } declare v+ ] final-classes ] unit-test
  42
  43 [ t ] [ [ { int-4 } declare second ] final-classes first integer class<= ] unit-test
  44
  45 [ V{ longlong-2 } ] [ [ { longlong-2 longlong-2 } declare v+ ] final-classes ] unit-test
  46
  47 [ V{ integer } ] [ [ { longlong-2 } declare second ] final-classes ] unit-test
  48
  49 [ V{ int-8 } ] [ [ { int-8 int-8 } declare v+ ] final-classes ] unit-test
  50
  51 [ t ] [ [ { int-8 } declare second ] final-classes first integer class<= ] unit-test
  52
  53 ! Test puns; only on x86
  54 cpu x86? [
  55     [ double-2{ 4 1024 } ] [
  56         float-4{ 0 1 0 2 }
  57         [ { float-4 } declare dup v+ underlying>> double-2 boa dup v+ ] compile-call
  58     ] unit-test
  59
  60     [ 33.0 ] [
  61         double-2{ 1 2 } double-2{ 10 20 }
  62         [ { double-2 double-2 } declare v+ underlying>> 3.0 float* ] compile-call
  63     ] unit-test
  64 ] when
  65
  66 ! Fuzz testing
  67 CONSTANT: simd-classes
  68     {
  69         char-16
  70         uchar-16
  71         char-32
  72         uchar-32
  73         short-8
  74         ushort-8
  75         short-16
  76         ushort-16
  77         int-4
  78         uint-4
  79         int-8
  80         uint-8
  81         longlong-2
  82         ulonglong-2
  83         longlong-4
  84         ulonglong-4
  85         float-4
  86         float-8
  87         double-2
  88         double-4
  89     }
  90
  91 : with-ctors ( -- seq )
  92     simd-classes [ [ name>> "-with" append ] [ vocabulary>> ] bi lookup ] map ;
  93
  94 : boa-ctors ( -- seq )
  95     simd-classes [ [ name>> "-boa" append ] [ vocabulary>> ] bi lookup ] map ;
  96
  97 : check-optimizer ( seq quot eq-quot -- failures )
  98     '[
  99         @
 100         [ dup [ class ] { } map-as ] dip '[ _ declare @ ]
 101         {
 102             [ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ]
 103             [ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ]
 104             [ [ call ] dip call ]
 105             [ [ call ] dip compile-call ]
 106         } 2cleave
 107         @ not
 108     ] filter ; inline
 109
 110 "== Checking -new constructors" print
 111
 112 [ { } ] [
 113     simd-classes [ [ [ ] ] dip '[ _ new ] ] [ = ] check-optimizer
 114 ] unit-test
 115
 116 [ { } ] [
 117     simd-classes [ '[ _ new ] compile-call [ zero? ] all? not ] filter
 118 ] unit-test
 119
 120 "== Checking -with constructors" print
 121
 122 [ { } ] [
 123     with-ctors [
 124         [ 1000 random '[ _ ] ] dip '[ _ execute ]
 125     ] [ = ] check-optimizer
 126 ] unit-test
 127
 128 [ HEX: ffffffff ] [ HEX: ffffffff uint-4-with first ] unit-test
 129
 130 [ HEX: ffffffff ] [ HEX: ffffffff [ uint-4-with ] compile-call first ] unit-test
 131
 132 [ HEX: ffffffff ] [ [ HEX: ffffffff uint-4-with ] compile-call first ] unit-test
 133
 134 "== Checking -boa constructors" print
 135
 136 [ { } ] [
 137     boa-ctors [
 138         [ stack-effect in>> length [ 1000 random ] [ ] replicate-as ] keep
 139         '[ _ execute ]
 140     ] [ = ] check-optimizer
 141 ] unit-test
 142
 143 [ HEX: ffffffff ] [ HEX: ffffffff 2 3 4 [ uint-4-boa ] compile-call first ] unit-test
 144
 145 "== Checking vector operations" print
 146
 147 : random-int-vector ( class -- vec )
 148     new [ drop 1,000 random ] map ;
 149 : random-float-vector ( class -- vec )
 150     new [
 151         drop
 152         1000 random
 153         10 swap <array> 0/0. suffix random
 154     ] map ;
 155
 156 : random-vector ( class elt-class -- vec )
 157     float =
 158     [ random-float-vector ]
 159     [ random-int-vector ] if ;
 160
 161 :: check-vector-op ( word inputs class elt-class -- inputs quot )
 162     inputs [
 163         {
 164             { +vector+ [ class elt-class random-vector ] }
 165             { +scalar+ [ 1000 random elt-class float = [ >float ] when ] }
 166         } case
 167     ] [ ] map-as
 168     word '[ _ execute ] ;
 169
 170 : remove-float-words ( alist -- alist' )
 171     { vsqrt n/v v/n v/ normalize } unique assoc-diff ;
 172
 173 : remove-integer-words ( alist -- alist' )
 174     { vlshift vrshift } unique assoc-diff ;
 175
 176 : boolean-ops ( -- words )
 177     { vand vandn vor vxor vnot } ;
 178
 179 : remove-boolean-words ( alist -- alist' )
 180     boolean-ops unique assoc-diff ;
 181
 182 : remove-special-words ( alist -- alist' )
 183     ! These have their own tests later
 184     {
 185         hlshift hrshift vshuffle vbroadcast
 186         vany? vall? vnone?
 187         (v>float) (v>integer)
 188         (vpack-signed) (vpack-unsigned)
 189         (vunpack-head) (vunpack-tail)
 190     } unique assoc-diff ;
 191
 192 : ops-to-check ( elt-class -- alist )
 193     [ vector-words >alist ] dip
 194     float = [ remove-integer-words ] [ remove-float-words ] if
 195     remove-boolean-words
 196     remove-special-words ;
 197
 198 : check-vector-ops ( class elt-class compare-quot -- )
 199     [
 200         [ nip ops-to-check ] 2keep
 201         '[ first2 inputs _ _ check-vector-op ]
 202     ] dip check-optimizer ; inline
 203
 204 : approx= ( x y -- ? )
 205     {
 206         { [ 2dup [ fp-nan? ] both? ] [ 2drop t ] }
 207         { [ 2dup [ float? ] both? ] [ -1.e8 ~ ] }
 208         { [ 2dup [ fp-infinity? ] either? ] [ fp-bitwise= ] }
 209         { [ 2dup [ sequence? ] both? ] [
 210             [
 211                 {
 212                     { [ 2dup [ fp-nan? ] both? ] [ 2drop t ] }
 213                     { [ 2dup [ fp-infinity? ] either? ] [ fp-bitwise= ] }
 214                     { [ 2dup [ fp-nan? ] either? not ] [ -1.e8 ~ ] }
 215                 } cond
 216             ] 2all?
 217         ] }
 218     } cond ;
 219
 220 : exact= ( x y -- ? )
 221     {
 222         { [ 2dup [ float? ] both? ] [ fp-bitwise= ] }
 223         { [ 2dup [ sequence? ] both? ] [ [ fp-bitwise= ] 2all? ] }
 224     } cond ;
 225
 226 : simd-classes&reps ( -- alist )
 227     simd-classes [
 228         {
 229             { [ dup name>> "float" head? ] [ float [ approx= ] ] }
 230             { [ dup name>> "double" head? ] [ float [ exact= ] ] }
 231             [ fixnum [ = ] ]
 232         } cond 3array
 233     ] map ;
 234
 235 simd-classes&reps [
 236     [ [ { } ] ] dip first3 '[ _ _ _ check-vector-ops ] unit-test
 237 ] each
 238
 239 "== Checking boolean operations" print
 240
 241 : random-boolean-vector ( class -- vec )
 242     new [ drop 2 random zero? ] map ;
 243
 244 :: check-boolean-op ( word inputs class elt-class -- inputs quot )
 245     inputs [
 246         {
 247             { +vector+ [ class random-boolean-vector ] }
 248             { +scalar+ [ 1000 random elt-class float = [ >float ] when ] }
 249         } case
 250     ] [ ] map-as
 251     word '[ _ execute ] ;
 252
 253 : check-boolean-ops ( class elt-class compare-quot -- )
 254     [
 255         [ boolean-ops [ dup word-schema ] { } map>assoc ] 2dip
 256         '[ first2 inputs _ _ check-boolean-op ]
 257     ] dip check-optimizer ; inline
 258
 259 simd-classes&reps [
 260     [ [ { } ] ] dip first3 '[ _ _ _ check-boolean-ops ] unit-test
 261 ] each
 262
 263 "== Checking vector blend" print
 264
 265 [ char-16{ 0 1 22 33 4 5 6 77 8 99 110 121 12 143 14 15 } ]
 266 [
 267     char-16{ t  t  f  f  t  t  t  f  t  f   f   f   t   f   t   t }
 268     char-16{ 0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15 }
 269     char-16{ 0 11 22 33 44 55 66 77 88 99 110 121 132 143 154 165 } v?
 270 ] unit-test
 271
 272 [ char-16{ 0 1 22 33 4 5 6 77 8 99 110 121 12 143 14 15 } ]
 273 [
 274     char-16{ t  t  f  f  t  t  t  f  t  f   f   f   t   f   t   t }
 275     char-16{ 0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15 }
 276     char-16{ 0 11 22 33 44 55 66 77 88 99 110 121 132 143 154 165 }
 277     [ { char-16 char-16 char-16 } declare v? ] compile-call
 278 ] unit-test
 279
 280 [ int-4{ 1 22 33 4 } ]
 281 [ int-4{ t f f t } int-4{ 1 2 3 4 } int-4{ 11 22 33 44 } v? ] unit-test
 282
 283 [ int-4{ 1 22 33 4 } ]
 284 [
 285     int-4{ t f f t } int-4{ 1 2 3 4 } int-4{ 11 22 33 44 }
 286     [ { int-4 int-4 int-4 } declare v? ] compile-call
 287 ] unit-test
 288
 289 [ float-4{ 1.0 22.0 33.0 4.0 } ]
 290 [ float-4{ t f f t } float-4{ 1.0 2.0 3.0 4.0 } float-4{ 11.0 22.0 33.0 44.0 } v? ] unit-test
 291
 292 [ float-4{ 1.0 22.0 33.0 4.0 } ]
 293 [
 294     float-4{ t f f t } float-4{ 1.0 2.0 3.0 4.0 } float-4{ 11.0 22.0 33.0 44.0 }
 295     [ { float-4 float-4 float-4 } declare v? ] compile-call
 296 ] unit-test
 297
 298 "== Checking shifts and permutations" print
 299
 300 [ int-4{ 256 512 1024 2048 } ]
 301 [ int-4{ 1 2 4 8 } 1 hlshift ] unit-test
 302
 303 [ int-4{ 256 512 1024 2048 } ]
 304 [ int-4{ 1 2 4 8 } [ { int-4 } declare 1 hlshift ] compile-call ] unit-test
 305
 306 [ int-4{ 256 512 1024 2048 } ]
 307 [ int-4{ 1 2 4 8 } 1 [ { int-4 fixnum } declare hlshift ] compile-call ] unit-test
 308
 309 [ int-4{ 1 2 4 8 } ]
 310 [ int-4{ 256 512 1024 2048 } 1 hrshift ] unit-test
 311
 312 [ int-4{ 1 2 4 8 } ]
 313 [ int-4{ 256 512 1024 2048 } [ { int-4 } declare 1 hrshift ] compile-call ] unit-test
 314
 315 [ int-4{ 1 2 4 8 } ]
 316 [ int-4{ 256 512 1024 2048 } 1 [ { int-4 fixnum } declare hrshift ] compile-call ] unit-test
 317
 318 ! Invalid inputs should not cause the compiler to throw errors
 319 [ ] [
 320     [ [ { int-4 } declare t hrshift ] (( a -- b )) define-temp drop ] with-compilation-unit
 321 ] unit-test
 322
 323 [ ] [
 324     [ [ { int-4 } declare { 3 2 1 } vshuffle ] (( a -- b )) define-temp drop ] with-compilation-unit
 325 ] unit-test
 326
 327 ! Shuffles
 328 : shuffles-for ( n -- shuffles )
 329     {
 330         { 2 [
 331             {
 332                 { 0 1 }
 333                 { 1 1 }
 334                 { 1 0 }
 335                 { 0 0 }
 336             }
 337         ] }
 338         { 4 [
 339             {
 340                 { 1 2 3 0 }
 341                 { 0 1 2 3 }
 342                 { 1 1 2 2 }
 343                 { 0 0 1 1 }
 344                 { 2 2 3 3 }
 345                 { 0 1 0 1 }
 346                 { 2 3 2 3 }
 347                 { 0 0 2 2 }
 348                 { 1 1 3 3 }
 349                 { 0 1 0 1 }
 350                 { 2 2 3 3 }
 351             }
 352         ] }
 353         { 8 [
 354             4 shuffles-for
 355             4 shuffles-for
 356             [ [ 4 + ] map ] map
 357             [ append ] 2map
 358         ] }
 359         [ dup '[ _ random ] replicate 1array ]
 360     } case ;
 361
 362 simd-classes [
 363     [ [ { } ] ] dip
 364     [ new length shuffles-for ] keep
 365     '[
 366         _ [ [ _ new [ length iota ] keep like 1quotation ] dip '[ _ vshuffle ] ]
 367         [ = ] check-optimizer
 368     ] unit-test
 369 ] each
 370
 371 "== Checking vector tests" print
 372
 373 :: test-vector-tests-bool ( vector declaration -- none? any? all? )
 374     vector
 375     [ [ declaration declare vnone? ] compile-call ]
 376     [ [ declaration declare vany?  ] compile-call ]
 377     [ [ declaration declare vall?  ] compile-call ] tri ; inline
 378
 379 : yes ( -- x ) t ;
 380 : no ( -- x ) f ;
 381
 382 :: test-vector-tests-branch ( vector declaration -- none? any? all? )
 383     vector
 384     [ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ]
 385     [ [ declaration declare vany?  [ yes ] [ no ] if ] compile-call ]
 386     [ [ declaration declare vall?  [ yes ] [ no ] if ] compile-call ] tri ; inline
 387
 388 SYMBOL: !!inconsistent!!
 389
 390 : ?inconsistent ( a b -- ab/inconsistent )
 391     2dup = [ drop ] [ 2drop !!inconsistent!! ] if ;
 392
 393 :: test-vector-tests ( vector decl -- none? any? all? )
 394     vector decl test-vector-tests-bool :> bool-all :> bool-any :> bool-none
 395     vector decl test-vector-tests-branch :> branch-all :> branch-any :> branch-none
 396
 397     bool-none branch-none ?inconsistent
 398     bool-any  branch-any  ?inconsistent
 399     bool-all  branch-all  ?inconsistent ; inline
 400
 401 [ f t t ]
 402 [ float-4{ t t t t } { float-4 } test-vector-tests ] unit-test
 403 [ f t f ]
 404 [ float-4{ f t t t } { float-4 } test-vector-tests ] unit-test
 405 [ t f f ]
 406 [ float-4{ f f f f } { float-4 } test-vector-tests ] unit-test
 407
 408 [ f t t ]
 409 [ double-2{ t t } { double-2 } test-vector-tests ] unit-test
 410 [ f t f ]
 411 [ double-2{ f t } { double-2 } test-vector-tests ] unit-test
 412 [ t f f ]
 413 [ double-2{ f f } { double-2 } test-vector-tests ] unit-test
 414
 415 [ f t t ]
 416 [ int-4{ t t t t } { int-4 } test-vector-tests ] unit-test
 417 [ f t f ]
 418 [ int-4{ f t t t } { int-4 } test-vector-tests ] unit-test
 419 [ t f f ]
 420 [ int-4{ f f f f } { int-4 } test-vector-tests ] unit-test
 421
 422 [ f t t ]
 423 [ float-8{ t t t t t t t t } { float-8 } test-vector-tests ] unit-test
 424 [ f t f ]
 425 [ float-8{ f t t t t f t t } { float-8 } test-vector-tests ] unit-test
 426 [ t f f ]
 427 [ float-8{ f f f f f f f f } { float-8 } test-vector-tests ] unit-test
 428
 429 [ f t t ]
 430 [ double-4{ t t t t } { double-4 } test-vector-tests ] unit-test
 431 [ f t f ]
 432 [ double-4{ f t t f } { double-4 } test-vector-tests ] unit-test
 433 [ t f f ]
 434 [ double-4{ f f f f } { double-4 } test-vector-tests ] unit-test
 435
 436 [ f t t ]
 437 [ int-8{ t t t t t t t t } { int-8 } test-vector-tests ] unit-test
 438 [ f t f ]
 439 [ int-8{ f t t t t f f f } { int-8 } test-vector-tests ] unit-test
 440 [ t f f ]
 441 [ int-8{ f f f f f f f f } { int-8 } test-vector-tests ] unit-test
 442
 443 "== Checking element access" print
 444
 445 ! Test element access -- it should box bignums for int-4 on x86
 446 : test-accesses ( seq -- failures )
 447     [ length >array ] keep
 448     '[ [ _ 1quotation ] dip '[ _ swap nth ] ] [ = ] check-optimizer ; inline
 449
 450 [ { } ] [ float-4{ 1.0 2.0 3.0 4.0 } test-accesses ] unit-test
 451 [ { } ] [ int-4{ HEX: 7fffffff 3 4 -8 } test-accesses ] unit-test
 452 [ { } ] [ uint-4{ HEX: ffffffff 2 3 4 } test-accesses ] unit-test
 453
 454 [ HEX: 7fffffff ] [ int-4{ HEX: 7fffffff 3 4 -8 } first ] unit-test
 455 [ -8 ] [ int-4{ HEX: 7fffffff 3 4 -8 } last ] unit-test
 456 [ HEX: ffffffff ] [ uint-4{ HEX: ffffffff 2 3 4 } first ] unit-test
 457
 458 [ { } ] [ double-2{ 1.0 2.0 } test-accesses ] unit-test
 459 [ { } ] [ longlong-2{ 1 2 } test-accesses ] unit-test
 460 [ { } ] [ ulonglong-2{ 1 2 } test-accesses ] unit-test
 461
 462 [ { } ] [ float-8{ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 } test-accesses ] unit-test
 463 [ { } ] [ int-8{ 1 2 3 4 5 6 7 8 } test-accesses ] unit-test
 464 [ { } ] [ uint-8{ 1 2 3 4 5 6 7 8 } test-accesses ] unit-test
 465
 466 [ { } ] [ double-4{ 1.0 2.0 3.0 4.0 } test-accesses ] unit-test
 467 [ { } ] [ longlong-4{ 1 2 3 4 } test-accesses ] unit-test
 468 [ { } ] [ ulonglong-4{ 1 2 3 4 } test-accesses ] unit-test
 469
 470 "== Checking broadcast" print
 471 : test-broadcast ( seq -- failures )
 472     [ length >array ] keep
 473     '[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ; inline
 474
 475 [ { } ] [ float-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
 476 [ { } ] [ int-4{ HEX: 7fffffff 3 4 -8 } test-broadcast ] unit-test
 477 [ { } ] [ uint-4{ HEX: ffffffff 2 3 4 } test-broadcast ] unit-test
 478
 479 [ { } ] [ double-2{ 1.0 2.0 } test-broadcast ] unit-test
 480 [ { } ] [ longlong-2{ 1 2 } test-broadcast ] unit-test
 481 [ { } ] [ ulonglong-2{ 1 2 } test-broadcast ] unit-test
 482
 483 [ { } ] [ float-8{ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 } test-broadcast ] unit-test
 484 [ { } ] [ int-8{ 1 2 3 4 5 6 7 8 } test-broadcast ] unit-test
 485 [ { } ] [ uint-8{ 1 2 3 4 5 6 7 8 } test-broadcast ] unit-test
 486
 487 [ { } ] [ double-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
 488 [ { } ] [ longlong-4{ 1 2 3 4 } test-broadcast ] unit-test
 489 [ { } ] [ ulonglong-4{ 1 2 3 4 } test-broadcast ] unit-test
 490
 491 ! Make sure we use the fallback in the correct situations
 492 [ int-4{ 3 3 3 3 } ] [ int-4{ 12 34 3 17 } 2 [ { int-4 fixnum } declare vbroadcast ] compile-call ] unit-test
 493
 494 "== Checking alien operations" print
 495
 496 [ float-4{ 1 2 3 4 } ] [
 497     [
 498         float-4{ 1 2 3 4 }
 499         underlying>> 0 float-4-rep alien-vector
 500     ] compile-call float-4 boa
 501 ] unit-test
 502
 503 [ B{ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 } ] [
 504     16 [ 1 ] B{ } replicate-as 16 <byte-array>
 505     [
 506         0 [
 507             { byte-array c-ptr fixnum } declare
 508             float-4-rep set-alien-vector
 509         ] compile-call
 510     ] keep
 511 ] unit-test
 512
 513 [ float-array{ 1 2 3 4 } ] [
 514     [
 515         float-array{ 1 2 3 4 } underlying>>
 516         float-array{ 4 3 2 1 } clone
 517         [ underlying>> 0 float-4-rep set-alien-vector ] keep
 518     ] compile-call
 519 ] unit-test
 520
 521 STRUCT: simd-struct
 522 { x float-4 }
 523 { y double-2 }
 524 { z double-4 }
 525 { w float-8 } ;
 526
 527 [ t ] [ [ simd-struct <struct> ] compile-call >c-ptr [ 0 = ] all? ] unit-test
 528
 529 [
 530     float-4{ 1 2 3 4 }
 531     double-2{ 2 1 }
 532     double-4{ 4 3 2 1 }
 533     float-8{ 1 2 3 4 5 6 7 8 }
 534 ] [
 535     simd-struct <struct>
 536     float-4{ 1 2 3 4 } >>x
 537     double-2{ 2 1 } >>y
 538     double-4{ 4 3 2 1 } >>z
 539     float-8{ 1 2 3 4 5 6 7 8 } >>w
 540     { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave
 541 ] unit-test
 542
 543 [
 544     float-4{ 1 2 3 4 }
 545     double-2{ 2 1 }
 546     double-4{ 4 3 2 1 }
 547     float-8{ 1 2 3 4 5 6 7 8 }
 548 ] [
 549     [
 550         simd-struct <struct>
 551         float-4{ 1 2 3 4 } >>x
 552         double-2{ 2 1 } >>y
 553         double-4{ 4 3 2 1 } >>z
 554         float-8{ 1 2 3 4 5 6 7 8 } >>w
 555         { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave
 556     ] compile-call
 557 ] unit-test
 558
 559 "== Misc tests" print
 560
 561 [ ] [ char-16 new 1array stack. ] unit-test
 562
 563 ! CSSA bug
 564 [ 8000000 ] [
 565     int-8{ 1000 1000 1000 1000 1000 1000 1000 1000 }
 566     [ { int-8 } declare dup [ * ] [ + ] 2map-reduce ] compile-call
 567 ] unit-test
 568
 569 ! Coalescing was too aggressive
 570 :: broken ( axis theta -- a b c )
 571    axis { float-4 } declare drop
 572    theta { float } declare drop
 573
 574    theta cos float-4-with :> cc
 575    theta sin float-4-with :> ss
 576
 577    axis cc v+ :> diagonal
 578
 579    diagonal cc ss ; inline
 580
 581 [ t ] [
 582     float-4{ 1.0 0.0 1.0 0.0 } pi [ broken 3array ]
 583     [ compile-call ] [ call ] 3bi =
 584 ] unit-test