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 SIMDS: c:uchar c:short c:ushort c:int c:uint c:longlong c:ulonglong c:float c:double ;
  15 IN: math.vectors.simd.tests
  16
  17 ! Make sure the functor doesn't generate bogus vocabularies
  18 2 [ [ "USE: math.vectors.simd SIMD: rubinius" eval( -- ) ] must-fail ] times
  19
  20 [ f ] [ "math.vectors.simd.instances.rubinius" vocab ] unit-test
  21
  22 ! Test type propagation
  23 [ V{ float } ] [ [ { float-4 } declare norm-sq ] final-classes ] unit-test
  24
  25 [ V{ float } ] [ [ { float-4 } declare norm ] final-classes ] unit-test
  26
  27 [ V{ float-4 } ] [ [ { float-4 } declare normalize ] final-classes ] unit-test
  28
  29 [ V{ float-4 } ] [ [ { float-4 float-4 } declare v+ ] final-classes ] unit-test
  30
  31 [ V{ float } ] [ [ { float-4 } declare second ] final-classes ] unit-test
  32
  33 [ V{ int-4 } ] [ [ { int-4 int-4 } declare v+ ] final-classes ] unit-test
  34
  35 [ t ] [ [ { int-4 } declare second ] final-classes first integer class<= ] unit-test
  36
  37 [ V{ longlong-2 } ] [ [ { longlong-2 longlong-2 } declare v+ ] final-classes ] unit-test
  38
  39 [ V{ integer } ] [ [ { longlong-2 } declare second ] final-classes ] unit-test
  40
  41 [ V{ int-8 } ] [ [ { int-8 int-8 } declare v+ ] final-classes ] unit-test
  42
  43 [ t ] [ [ { int-8 } declare second ] final-classes first integer class<= ] unit-test
  44
  45 ! Test puns; only on x86
  46 cpu x86? [
  47     [ double-2{ 4 1024 } ] [
  48         float-4{ 0 1 0 2 }
  49         [ { float-4 } declare dup v+ underlying>> double-2 boa dup v+ ] compile-call
  50     ] unit-test
  51 ] when
  52
  53 ! Fuzz testing
  54 CONSTANT: simd-classes
  55     {
  56         char-16
  57         uchar-16
  58         char-32
  59         uchar-32
  60         short-8
  61         ushort-8
  62         short-16
  63         ushort-16
  64         int-4
  65         uint-4
  66         int-8
  67         uint-8
  68         longlong-2
  69         ulonglong-2
  70         longlong-4
  71         ulonglong-4
  72         float-4
  73         float-8
  74         double-2
  75         double-4
  76     }
  77
  78 : with-ctors ( -- seq )
  79     simd-classes [ [ name>> "-with" append ] [ vocabulary>> ] bi lookup ] map ;
  80
  81 : boa-ctors ( -- seq )
  82     simd-classes [ [ name>> "-boa" append ] [ vocabulary>> ] bi lookup ] map ;
  83
  84 : check-optimizer ( seq quot eq-quot -- failures )
  85     '[
  86         @
  87         [ dup [ class ] { } map-as ] dip '[ _ declare @ ]
  88         {
  89             [ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ]
  90             [ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ]
  91             [ [ call ] dip call ]
  92             [ [ call ] dip compile-call ]
  93         } 2cleave
  94         @ not
  95     ] filter ; inline
  96
  97 "== Checking -new constructors" print
  98
  99 [ { } ] [
 100     simd-classes [ [ [ ] ] dip '[ _ new ] ] [ = ] check-optimizer
 101 ] unit-test
 102
 103 [ { } ] [
 104     simd-classes [ '[ _ new ] compile-call [ zero? ] all? not ] filter
 105 ] unit-test
 106
 107 "== Checking -with constructors" print
 108
 109 [ { } ] [
 110     with-ctors [
 111         [ 1000 random '[ _ ] ] dip '[ _ execute ]
 112     ] [ = ] check-optimizer
 113 ] unit-test
 114
 115 [ HEX: ffffffff ] [ HEX: ffffffff uint-4-with first ] unit-test
 116
 117 [ HEX: ffffffff ] [ HEX: ffffffff [ uint-4-with ] compile-call first ] unit-test
 118
 119 [ HEX: ffffffff ] [ [ HEX: ffffffff uint-4-with ] compile-call first ] unit-test
 120
 121 "== Checking -boa constructors" print
 122
 123 [ { } ] [
 124     boa-ctors [
 125         [ stack-effect in>> length [ 1000 random ] [ ] replicate-as ] keep
 126         '[ _ execute ]
 127     ] [ = ] check-optimizer
 128 ] unit-test
 129
 130 [ HEX: ffffffff ] [ HEX: ffffffff 2 3 4 [ uint-4-boa ] compile-call first ] unit-test
 131
 132 "== Checking vector operations" print
 133
 134 : random-int-vector ( class -- vec )
 135     new [ drop 1,000 random ] map ;
 136 : random-float-vector ( class -- vec )
 137     new [
 138         drop
 139         1000 random
 140         10 swap <array> 0/0. suffix random
 141     ] map ;
 142
 143 : random-vector ( class elt-class -- vec )
 144     float =
 145     [ random-float-vector ]
 146     [ random-int-vector ] if ;
 147
 148 :: check-vector-op ( word inputs class elt-class -- inputs quot )
 149     inputs [
 150         {
 151             { +vector+ [ class elt-class random-vector ] }
 152             { +scalar+ [ 1000 random elt-class float = [ >float ] when ] }
 153         } case
 154     ] [ ] map-as
 155     word '[ _ execute ] ;
 156
 157 : remove-float-words ( alist -- alist' )
 158     { vsqrt n/v v/n v/ normalize } unique assoc-diff ;
 159
 160 : remove-integer-words ( alist -- alist' )
 161     { vlshift vrshift } unique assoc-diff ;
 162
 163 : boolean-ops ( -- words )
 164     { vand vandn vor vxor vnot } ;
 165
 166 : remove-boolean-words ( alist -- alist' )
 167     boolean-ops unique assoc-diff ;
 168
 169 : remove-special-words ( alist -- alist' )
 170     ! These have their own tests later
 171     {
 172         hlshift hrshift vshuffle-bytes vshuffle-elements vbroadcast
 173         vany? vall? vnone?
 174         (v>float) (v>integer)
 175         (vpack-signed) (vpack-unsigned)
 176         (vunpack-head) (vunpack-tail)
 177     } unique assoc-diff ;
 178
 179 : ops-to-check ( elt-class -- alist )
 180     [ vector-words >alist ] dip
 181     float = [ remove-integer-words ] [ remove-float-words ] if
 182     remove-boolean-words
 183     remove-special-words ;
 184
 185 : check-vector-ops ( class elt-class compare-quot -- )
 186     [
 187         [ nip ops-to-check ] 2keep
 188         '[ first2 inputs _ _ check-vector-op ]
 189     ] dip check-optimizer ; inline
 190
 191 : (approx=) ( x y -- ? )
 192     {
 193         { [ 2dup [ fp-nan? ] both? ] [ 2drop t ] }
 194         { [ 2dup [ fp-nan? ] either? ] [ 2drop f ] }
 195         { [ 2dup [ fp-infinity? ] either? ] [ fp-bitwise= ] }
 196         { [ 2dup [ float? ] both? ] [ -1.e8 ~ ] }
 197     } cond ;
 198
 199 : approx= ( x y -- ? )
 200     2dup [ sequence? ] both?
 201     [ [ (approx=) ] 2all? ] [ (approx=) ] if ;
 202
 203 : exact= ( x y -- ? )
 204     {
 205         { [ 2dup [ float? ] both? ] [ fp-bitwise= ] }
 206         { [ 2dup [ sequence? ] both? ] [ [ fp-bitwise= ] 2all? ] }
 207     } cond ;
 208
 209 : simd-classes&reps ( -- alist )
 210     simd-classes [
 211         {
 212             { [ dup name>> "float" head? ] [ float [ approx= ] ] }
 213             { [ dup name>> "double" head? ] [ float [ exact= ] ] }
 214             [ fixnum [ = ] ]
 215         } cond 3array
 216     ] map ;
 217
 218 simd-classes&reps [
 219     [ [ { } ] ] dip first3 '[ _ _ _ check-vector-ops ] unit-test
 220 ] each
 221
 222 "== Checking boolean operations" print
 223
 224 : random-boolean-vector ( class -- vec )
 225     new [ drop 2 random zero? ] map ;
 226
 227 :: check-boolean-op ( word inputs class elt-class -- inputs quot )
 228     inputs [
 229         {
 230             { +vector+ [ class random-boolean-vector ] }
 231             { +scalar+ [ 1000 random elt-class float = [ >float ] when ] }
 232         } case
 233     ] [ ] map-as
 234     word '[ _ execute ] ;
 235
 236 : check-boolean-ops ( class elt-class compare-quot -- )
 237     [
 238         [ boolean-ops [ dup word-schema ] { } map>assoc ] 2dip
 239         '[ first2 inputs _ _ check-boolean-op ]
 240     ] dip check-optimizer ; inline
 241
 242 simd-classes&reps [
 243     [ [ { } ] ] dip first3 '[ _ _ _ check-boolean-ops ] unit-test
 244 ] each
 245
 246 "== Checking vector blend" print
 247
 248 [ char-16{ 0 1 22 33 4 5 6 77 8 99 110 121 12 143 14 15 } ]
 249 [
 250     char-16{ t  t  f  f  t  t  t  f  t  f   f   f   t   f   t   t }
 251     char-16{ 0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15 }
 252     char-16{ 0 11 22 33 44 55 66 77 88 99 110 121 132 143 154 165 } v?
 253 ] unit-test
 254
 255 [ char-16{ 0 1 22 33 4 5 6 77 8 99 110 121 12 143 14 15 } ]
 256 [
 257     char-16{ t  t  f  f  t  t  t  f  t  f   f   f   t   f   t   t }
 258     char-16{ 0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15 }
 259     char-16{ 0 11 22 33 44 55 66 77 88 99 110 121 132 143 154 165 }
 260     [ { char-16 char-16 char-16 } declare v? ] compile-call
 261 ] unit-test
 262
 263 [ int-4{ 1 22 33 4 } ]
 264 [ int-4{ t f f t } int-4{ 1 2 3 4 } int-4{ 11 22 33 44 } v? ] unit-test
 265
 266 [ int-4{ 1 22 33 4 } ]
 267 [
 268     int-4{ t f f t } int-4{ 1 2 3 4 } int-4{ 11 22 33 44 }
 269     [ { int-4 int-4 int-4 } declare v? ] compile-call
 270 ] unit-test
 271
 272 [ float-4{ 1.0 22.0 33.0 4.0 } ]
 273 [ 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
 274
 275 [ float-4{ 1.0 22.0 33.0 4.0 } ]
 276 [
 277     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 }
 278     [ { float-4 float-4 float-4 } declare v? ] compile-call
 279 ] unit-test
 280
 281 "== Checking shifts and permutations" print
 282
 283 [ char-16{ 0 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 } ]
 284 [ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } 1 hlshift ] unit-test
 285
 286 [ char-16{ 0 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 } ]
 287 [ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } [ { char-16 } declare 1 hlshift ] compile-call ] unit-test
 288
 289 [ char-16{ 0 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 } ]
 290 [ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } 1 [ { char-16 fixnum } declare hlshift ] compile-call ] unit-test
 291
 292 [ char-16{ 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 0 } ]
 293 [ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } 1 hrshift ] unit-test
 294
 295 [ char-16{ 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 0 } ]
 296 [ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } [ { char-16 } declare 1 hrshift ] compile-call ] unit-test
 297
 298 [ char-16{ 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 0 } ]
 299 [ char-16{ 1 2 4 8 1 2 4 8 1 2 4 8 1 2 4 8 } 1 [ { char-16 fixnum } declare hrshift ] compile-call ] unit-test
 300
 301 ! Invalid inputs should not cause the compiler to throw errors
 302 [ ] [
 303     [ [ { int-4 } declare t hrshift ] (( a -- b )) define-temp drop ] with-compilation-unit
 304 ] unit-test
 305
 306 [ ] [
 307     [ [ { int-4 } declare { 3 2 1 } vshuffle ] (( a -- b )) define-temp drop ] with-compilation-unit
 308 ] unit-test
 309
 310 ! Shuffles
 311 : shuffles-for ( n -- shuffles )
 312     {
 313         { 2 [
 314             {
 315                 { 0 1 }
 316                 { 1 1 }
 317                 { 1 0 }
 318                 { 0 0 }
 319             }
 320         ] }
 321         { 4 [
 322             {
 323                 { 1 2 3 0 }
 324                 { 0 1 2 3 }
 325                 { 1 1 2 2 }
 326                 { 0 0 1 1 }
 327                 { 2 2 3 3 }
 328                 { 0 1 0 1 }
 329                 { 2 3 2 3 }
 330                 { 0 0 2 2 }
 331                 { 1 1 3 3 }
 332                 { 0 1 0 1 }
 333                 { 2 2 3 3 }
 334             }
 335         ] }
 336         { 8 [
 337             4 shuffles-for
 338             4 shuffles-for
 339             [ [ 4 + ] map ] map
 340             [ append ] 2map
 341         ] }
 342         [ dup '[ _ random ] replicate 1array ]
 343     } case ;
 344
 345 simd-classes [
 346     [ [ { } ] ] dip
 347     [ new length shuffles-for ] keep
 348     '[
 349         _ [ [ _ new [ length iota ] keep like 1quotation ] dip '[ _ vshuffle ] ]
 350         [ = ] check-optimizer
 351     ] unit-test
 352 ] each
 353
 354 "== Checking variable shuffles" print
 355
 356 : random-shift-vector ( class -- vec )
 357     new [ drop 16 random ] map ;
 358
 359 :: test-shift-vector ( class -- ? )
 360     class random-int-vector :> src
 361     char-16 random-shift-vector :> perm
 362     { class char-16 } :> decl
 363
 364     src perm vshuffle
 365     src perm [ decl declare vshuffle ] compile-call
 366     = ; inline
 367
 368 { char-16 uchar-16 short-8 ushort-8 int-4 uint-4 longlong-2 ulonglong-2 }
 369 [ 10 swap '[ [ t ] [ _ test-shift-vector ] unit-test ] times ] 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 TUPLE: inconsistent-vector-test bool branch ;
 389
 390 : ?inconsistent ( bool branch -- ?/inconsistent )
 391     2dup = [ drop ] [ inconsistent-vector-test boa ] if ;
 392
 393 :: test-vector-tests ( vector decl -- none? any? all? )
 394     vector decl test-vector-tests-bool :> ( bool-none bool-any bool-all )
 395     vector decl test-vector-tests-branch :> ( branch-none branch-any branch-all )
 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 longlong-2 }
 524 { z double-4 }
 525 { w int-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     longlong-2{ 2 1 }
 532     double-4{ 4 3 2 1 }
 533     int-8{ 1 2 3 4 5 6 7 8 }
 534 ] [
 535     simd-struct <struct>
 536     float-4{ 1 2 3 4 } >>x
 537     longlong-2{ 2 1 } >>y
 538     double-4{ 4 3 2 1 } >>z
 539     int-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     longlong-2{ 2 1 }
 546     double-4{ 4 3 2 1 }
 547     int-8{ 1 2 3 4 5 6 7 8 }
 548 ] [
 549     [
 550         simd-struct <struct>
 551         float-4{ 1 2 3 4 } >>x
 552         longlong-2{ 2 1 } >>y
 553         double-4{ 4 3 2 1 } >>z
 554         int-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