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

   1 USING: kernel compiler.tree.builder compiler.tree
   2 compiler.tree.propagation compiler.tree.recursive
   3 compiler.tree.normalization tools.test math math.order
   4 accessors sequences arrays kernel.private vectors
   5 alien.accessors alien.c-types sequences.private
   6 byte-arrays classes.algebra classes.tuple.private
   7 math.functions math.private strings layouts
   8 compiler.tree.propagation.info compiler.tree.def-use
   9 compiler.tree.debugger compiler.tree.checker
  10 slots.private words hashtables classes assocs locals
  11 specialized-arrays.double system sorting math.libm
  12 math.intervals ;
  13 IN: compiler.tree.propagation.tests
  14
  15 \ propagate must-infer
  16
  17 [ V{ } ] [ [ ] final-classes ] unit-test
  18
  19 [ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test
  20
  21 [ V{ fixnum } ] [ [ 1 >r r> ] final-classes ] unit-test
  22
  23 [ V{ fixnum object } ] [ [ 1 swap ] final-classes ] unit-test
  24
  25 [ V{ array } ] [ [ 10 f <array> ] final-classes ] unit-test
  26
  27 [ V{ array } ] [ [ { array } declare ] final-classes ] unit-test
  28
  29 [ V{ array } ] [ [ 10 f <array> swap [ ] [ ] if ] final-classes ] unit-test
  30
  31 [ V{ fixnum } ] [ [ dup fixnum? [ ] [ drop 3 ] if ] final-classes ] unit-test
  32
  33 [ V{ 69 } ] [ [ [ 69 ] [ 69 ] if ] final-literals ] unit-test
  34
  35 [ V{ fixnum } ] [ [ { fixnum } declare bitnot ] final-classes ] unit-test
  36
  37 ! Test type propagation for math ops
  38 : cleanup-math-class ( obj -- class )
  39     { null fixnum bignum integer ratio rational float real complex number }
  40     [ class= ] with find nip ;
  41
  42 : final-math-class ( quot -- class )
  43     final-classes first cleanup-math-class ;
  44
  45 [ number ] [ [ + ] final-math-class ] unit-test
  46
  47 [ bignum ] [ [ { fixnum bignum } declare + ] final-math-class ] unit-test
  48
  49 [ integer ] [ [ { fixnum integer } declare + ] final-math-class ] unit-test
  50
  51 [ bignum ] [ [ { integer bignum } declare + ] final-math-class ] unit-test
  52
  53 [ integer ] [ [ { fixnum fixnum } declare + ] final-math-class ] unit-test
  54
  55 [ float ] [ [ { float integer } declare + ] final-math-class ] unit-test
  56
  57 [ float ] [ [ { real float } declare + ] final-math-class ] unit-test
  58
  59 [ float ] [ [ { float real } declare + ] final-math-class ] unit-test
  60
  61 [ rational ] [ [ { ratio ratio } declare + ] final-math-class ] unit-test
  62
  63 [ rational ] [ [ { rational ratio } declare + ] final-math-class ] unit-test
  64
  65 [ number ] [ [ { complex complex } declare + ] final-math-class ] unit-test
  66
  67 [ float ] [ [ /f ] final-math-class ] unit-test
  68
  69 [ float ] [ [ { real real } declare /f ] final-math-class ] unit-test
  70
  71 [ integer ] [ [ /i ] final-math-class ] unit-test
  72
  73 [ integer ] [ [ { integer float } declare /i ] final-math-class ] unit-test
  74
  75 [ integer ] [ [ { float float } declare /i ] final-math-class ] unit-test
  76
  77 [ integer ] [ [ { integer } declare bitnot ] final-math-class ] unit-test
  78
  79 [ null ] [ [ { null null } declare + ] final-math-class ] unit-test
  80
  81 [ null ] [ [ { null fixnum } declare + ] final-math-class ] unit-test
  82
  83 [ float ] [ [ { float fixnum } declare + ] final-math-class ] unit-test
  84
  85 [ bignum ] [ [ { bignum bignum } declare bitxor ] final-math-class ] unit-test
  86
  87 [ float ] [ [ { float float } declare mod ] final-math-class ] unit-test
  88
  89 [ V{ integer } ] [ [ 255 bitand ] final-classes ] unit-test
  90
  91 [ V{ integer } ] [
  92     [ [ 255 bitand ] [ 65535 bitand ] bi + ] final-classes
  93 ] unit-test
  94
  95 [ V{ fixnum } ] [
  96     [
  97         { fixnum } declare [ 255 bitand ] [ 65535 bitand ] bi +
  98     ] final-classes
  99 ] unit-test
 100
 101 [ V{ integer } ] [
 102     [ { fixnum } declare [ 255 bitand ] keep + ] final-classes
 103 ] unit-test
 104
 105 [ V{ integer } ] [
 106     [ { fixnum } declare 615949 * ] final-classes
 107 ] unit-test
 108
 109 [ V{ fixnum } ] [
 110     [ 255 bitand >fixnum 3 bitor ] final-classes
 111 ] unit-test
 112
 113 [ V{ 0 } ] [
 114     [ >fixnum 1 mod ] final-literals
 115 ] unit-test
 116
 117 [ V{ 69 } ] [
 118     [ >fixnum swap [ 1 mod 69 + ] [ drop 69 ] if ] final-literals
 119 ] unit-test
 120
 121 [ V{ fixnum } ] [
 122     [ >fixnum dup 10 > [ 1 - ] when ] final-classes
 123 ] unit-test
 124
 125 [ V{ integer } ] [ [ >fixnum 2 * ] final-classes ] unit-test
 126
 127 [ V{ integer } ] [
 128     [ >fixnum dup 10 < drop 2 * ] final-classes
 129 ] unit-test
 130
 131 [ V{ integer } ] [
 132     [ >fixnum dup 10 < [ 2 * ] when ] final-classes
 133 ] unit-test
 134
 135 [ V{ integer } ] [
 136     [ >fixnum dup 10 < [ 2 * ] [ 2 * ] if ] final-classes
 137 ] unit-test
 138
 139 [ V{ fixnum } ] [
 140     [ >fixnum dup 10 < [ dup -10 > [ 2 * ] when ] when ] final-classes
 141 ] unit-test
 142
 143 [ V{ f } ] [
 144     [ dup 10 < [ dup 8 > [ drop 9 ] unless ] [ drop 9 ] if ] final-literals
 145 ] unit-test
 146
 147 [ V{ 9 } ] [
 148     [
 149         123 bitand
 150         dup 10 < [ dup 8 > [ drop 9 ] unless ] [ drop 9 ] if
 151     ] final-literals
 152 ] unit-test
 153
 154 [ V{ string } ] [
 155     [ dup string? not [ "Oops" throw ] [ ] if ] final-classes
 156 ] unit-test
 157
 158 [ V{ string } ] [
 159     [ dup string? not not >boolean [ ] [ "Oops" throw ] if ] final-classes
 160 ] unit-test
 161
 162 [ f ] [ [ t xor ] final-classes first null-class? ] unit-test
 163
 164 [ t ] [ [ t or ] final-classes first true-class? ] unit-test
 165
 166 [ t ] [ [ t swap or ] final-classes first true-class? ] unit-test
 167
 168 [ t ] [ [ f and ] final-classes first false-class? ] unit-test
 169
 170 [ t ] [ [ f swap and ] final-classes first false-class? ] unit-test
 171
 172 [ t ] [ [ dup not or ] final-classes first true-class? ] unit-test
 173
 174 [ t ] [ [ dup not swap or ] final-classes first true-class? ] unit-test
 175
 176 [ t ] [ [ dup not and ] final-classes first false-class? ] unit-test
 177
 178 [ t ] [ [ dup not swap and ] final-classes first false-class? ] unit-test
 179
 180 [ t ] [ [ over [ drop f ] when [ "A" throw ] unless ] final-classes first false-class? ] unit-test
 181
 182 [ V{ fixnum } ] [
 183     [
 184         >fixnum
 185         dup [ 10 < ] [ -10 > ] bi and not [ 2 * ] unless
 186     ] final-classes
 187 ] unit-test
 188
 189 [ V{ fixnum } ] [
 190     [ { fixnum } declare (clone) ] final-classes
 191 ] unit-test
 192
 193 [ V{ vector } ] [
 194     [ vector new ] final-classes
 195 ] unit-test
 196
 197 [ V{ fixnum } ] [
 198     [
 199         { fixnum byte-array } declare
 200         [ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe
 201         >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift
 202         255 min 0 max
 203     ] final-classes
 204 ] unit-test
 205
 206 [ V{ fixnum } ] [
 207     [ 0 dup 10 > [ 2 * ] when ] final-classes
 208 ] unit-test
 209
 210 [ V{ f } ] [
 211     [ [ 0.0 ] [ -0.0 ] if ] final-literals
 212 ] unit-test
 213
 214 [ V{ 1.5 } ] [
 215     [ /f 1.5 min 1.5 max ] final-literals
 216 ] unit-test
 217
 218 [ V{ 1.5 } ] [
 219     [
 220         /f
 221         dup 1.5 <= [ dup 1.5 >= [ ] [ drop 1.5 ] if ] [ drop 1.5 ] if
 222     ] final-literals
 223 ] unit-test
 224
 225 [ V{ 1.5 } ] [
 226     [
 227         /f
 228         dup 1.5 <= [ dup 10 >= [ ] [ drop 1.5 ] if ] [ drop 1.5 ] if
 229     ] final-literals
 230 ] unit-test
 231
 232 [ V{ f } ] [
 233     [
 234         /f
 235         dup 0.0 <= [ dup 0.0 >= [ drop 0.0 ] unless ] [ drop 0.0 ] if
 236     ] final-literals
 237 ] unit-test
 238
 239 [ V{ fixnum } ] [
 240     [ 0 dup 10 > [ 100 * ] when ] final-classes
 241 ] unit-test
 242
 243 [ V{ fixnum } ] [
 244     [ 0 dup 10 > [ drop "foo" ] when ] final-classes
 245 ] unit-test
 246
 247 [ V{ fixnum } ] [
 248     [ { fixnum } declare 3 3 - + ] final-classes
 249 ] unit-test
 250
 251 [ V{ t } ] [
 252     [ dup 10 < [ 3 * 30 < ] [ drop t ] if ] final-literals
 253 ] unit-test
 254
 255 [ V{ "d" } ] [
 256     [
 257         3 {
 258             [ "a" ]
 259             [ "b" ]
 260             [ "c" ]
 261             [ "d" ]
 262             [ "e" ]
 263             [ "f" ]
 264             [ "g" ]
 265             [ "h" ]
 266         } dispatch
 267     ] final-literals
 268 ] unit-test
 269
 270 [ V{ "hi" } ] [
 271     [ [ "hi" ] [ 123 3 throw ] if ] final-literals
 272 ] unit-test
 273
 274 [ V{ fixnum } ] [
 275     [ >fixnum dup 100 < [ 1+ ] [ "Oops" throw ] if ] final-classes
 276 ] unit-test
 277
 278 [ V{ -1 } ] [
 279     [ 0 dup 100 < not [ 1+ ] [ 1- ] if ] final-literals
 280 ] unit-test
 281
 282 [ V{ 2 } ] [
 283     [ [ 1 ] [ 1 ] if 1 + ] final-literals
 284 ] unit-test
 285
 286 [ V{ object } ] [
 287     [ 0 * 10 < ] final-classes
 288 ] unit-test
 289
 290 [ V{ 27 } ] [
 291     [
 292         123 bitand dup 10 < over 8 > and [ 3 * ] [ "B" throw ] if
 293     ] final-literals
 294 ] unit-test
 295
 296 [ V{ 27 } ] [
 297     [
 298         dup number? over sequence? and [
 299             dup 10 < over 8 <= not and [ 3 * ] [ "A" throw ] if
 300         ] [ "B" throw ] if
 301     ] final-literals
 302 ] unit-test
 303
 304 [ V{ string string } ] [
 305     [
 306         2dup [ dup string? [ "Oops" throw ] unless ] bi@ 2drop
 307     ] final-classes
 308 ] unit-test
 309
 310 [ V{ fixnum } ] [
 311     [ { fixnum fixnum } declare 7 bitand neg shift ] final-classes
 312 ] unit-test
 313
 314 [ V{ fixnum } ] [
 315     [ { fixnum } declare 1 swap 7 bitand shift ] final-classes
 316 ] unit-test
 317
 318 cell-bits 32 = [
 319     [ V{ integer } ] [
 320         [ { fixnum } declare 1 swap 31 bitand shift ]
 321         final-classes
 322     ] unit-test
 323 ] when
 324
 325 ! Array length propagation
 326 [ V{ t } ] [ [ 10 f <array> length 10 = ] final-literals ] unit-test
 327
 328 [ V{ t } ] [ [ [ 10 f <array> length ] [ 10 <byte-array> length ] if 10 = ] final-literals ] unit-test
 329
 330 [ V{ t } ] [ [ [ 1 f <array> ] [ 2 f <array> ] if length 3 < ] final-literals ] unit-test
 331
 332 [ V{ 10 } ] [
 333     [ { fixnum } declare dup 10 eq? [ "A" throw ] unless ] final-literals
 334 ] unit-test
 335
 336 ! Slot propagation
 337 TUPLE: prop-test-tuple { x integer } ;
 338
 339 [ V{ integer } ] [ [ { prop-test-tuple } declare x>> ] final-classes ] unit-test
 340
 341 TUPLE: fold-boa-test-tuple { x read-only } { y read-only } { z read-only } ;
 342
 343 [ V{ T{ fold-boa-test-tuple f 1 2 3 } } ]
 344 [ [ 1 2 3 fold-boa-test-tuple boa ] final-literals ]
 345 unit-test
 346
 347 TUPLE: immutable-prop-test-tuple { x sequence read-only } ;
 348
 349 [ V{ T{ immutable-prop-test-tuple f "hey" } } ] [
 350     [ "hey" immutable-prop-test-tuple boa ] final-literals
 351 ] unit-test
 352
 353 [ V{ { 1 2 } } ] [
 354     [ { 1 2 } immutable-prop-test-tuple boa x>> ] final-literals
 355 ] unit-test
 356
 357 [ V{ array } ] [
 358     [ { array } declare immutable-prop-test-tuple boa x>> ] final-classes
 359 ] unit-test
 360
 361 [ V{ complex } ] [
 362     [ <complex> ] final-classes
 363 ] unit-test
 364
 365 [ V{ complex } ] [
 366     [ { float float } declare dup 0.0 <= [ "Oops" throw ] [ rect> ] if ] final-classes
 367 ] unit-test
 368
 369 [ V{ float float } ] [
 370     [
 371         { float float } declare
 372         dup 0.0 <= [ "Oops" throw ] when rect>
 373         [ real>> ] [ imaginary>> ] bi
 374     ] final-classes
 375 ] unit-test
 376
 377 [ V{ complex } ] [
 378     [
 379         { float float object } declare
 380         [ "Oops" throw ] [ <complex> ] if
 381     ] final-classes
 382 ] unit-test
 383
 384 [ ] [ [ dup 3 slot swap 4 slot dup 3 slot swap 4 slot ] final-info drop ] unit-test
 385
 386 [ V{ number } ] [ [ [ "Oops" throw ] [ 2 + ] if ] final-classes ] unit-test
 387 [ V{ number } ] [ [ [ 2 + ] [ "Oops" throw ] if ] final-classes ] unit-test
 388
 389 [ V{ POSTPONE: f } ] [
 390     [ dup 1.0 <= [ drop f ] [ 0 number= ] if ] final-classes
 391 ] unit-test
 392
 393 ! Don't fold this
 394 TUPLE: mutable-tuple-test { x sequence } ;
 395
 396 [ V{ sequence } ] [
 397     [ "hey" mutable-tuple-test boa x>> ] final-classes
 398 ] unit-test
 399
 400 [ V{ sequence } ] [
 401     [ T{ mutable-tuple-test f "hey" } x>> ] final-classes
 402 ] unit-test
 403
 404 [ V{ array } ] [
 405     [ T{ mutable-tuple-test f "hey" } layout-of ] final-classes
 406 ] unit-test
 407
 408 ! Mixed mutable and immutable slots
 409 TUPLE: mixed-mutable-immutable { x integer } { y sequence read-only } ;
 410
 411 [ V{ integer array } ] [
 412     [
 413         3 { 2 1 } mixed-mutable-immutable boa [ x>> ] [ y>> ] bi
 414     ] final-classes
 415 ] unit-test
 416
 417 [ V{ array integer } ] [
 418     [
 419         3 { 2 1 } mixed-mutable-immutable boa [ y>> ] [ x>> ] bi
 420     ] final-classes
 421 ] unit-test
 422
 423 [ V{ integer array } ] [
 424     [
 425         [ 2drop T{ mixed-mutable-immutable f 3 { } } ]
 426         [ { array } declare mixed-mutable-immutable boa ] if
 427         [ x>> ] [ y>> ] bi
 428     ] final-classes
 429 ] unit-test
 430
 431 ! Recursive propagation
 432 : recursive-test-1 ( a -- b ) recursive-test-1 ; inline recursive
 433
 434 [ V{ null } ] [ [ recursive-test-1 ] final-classes ] unit-test
 435
 436 : recursive-test-2 ( a -- b ) dup 10 < [ recursive-test-2 ] when ; inline recursive
 437
 438 [ V{ real } ] [ [ recursive-test-2 ] final-classes ] unit-test
 439
 440 : recursive-test-3 ( a -- b ) dup 10 < drop ; inline recursive
 441
 442 [ V{ real } ] [ [ recursive-test-3 ] final-classes ] unit-test
 443
 444 [ V{ real } ] [ [ [ dup 10 < ] [ ] [ ] while ] final-classes ] unit-test
 445
 446 [ V{ float } ] [
 447     [ { float } declare 10 [ 2.3 * ] times ] final-classes
 448 ] unit-test
 449
 450 [ V{ fixnum } ] [
 451     [ 0 10 [ nip ] each-integer ] final-classes
 452 ] unit-test
 453
 454 [ V{ t } ] [
 455     [ t 10 [ nip 0 >= ] each-integer ] final-literals
 456 ] unit-test
 457
 458 : recursive-test-4 ( i n -- )
 459     2dup < [ [ 1+ ] dip recursive-test-4 ] [ 2drop ] if ; inline recursive
 460
 461 [ ] [ [ recursive-test-4 ] final-info drop ] unit-test
 462
 463 : recursive-test-5 ( a -- b )
 464     dup 1 <= [ drop 1 ] [ dup 1 - recursive-test-5 * ] if ; inline recursive
 465
 466 [ V{ integer } ] [ [ { integer } declare recursive-test-5 ] final-classes ] unit-test
 467
 468 : recursive-test-6 ( a -- b )
 469     dup 1 <= [ drop 1 ] [ dup 1 - recursive-test-6 swap 2 - recursive-test-6 + ] if ; inline recursive
 470
 471 [ V{ integer } ] [ [ { fixnum } declare recursive-test-6 ] final-classes ] unit-test
 472
 473 : recursive-test-7 ( a -- b )
 474     dup 10 < [ 1+ recursive-test-7 ] when ; inline recursive
 475
 476 [ V{ fixnum } ] [ [ 0 recursive-test-7 ] final-classes ] unit-test
 477
 478 [ V{ fixnum } ] [ [ 1 10 [ dup 10 < [ 2 * ] when ] times ] final-classes ] unit-test
 479
 480 [ V{ integer } ] [ [ 0 2 100 ^ [ nip ] each-integer ] final-classes ] unit-test
 481
 482 [ ] [ [ [ ] [ ] compose curry call ] final-info drop ] unit-test
 483
 484 [ V{ } ] [
 485     [ [ drop ] [ drop ] compose curry (each-integer) ] final-classes
 486 ] unit-test
 487
 488 GENERIC: iterate ( obj -- next-obj ? )
 489 M: fixnum iterate f ;
 490 M: array iterate first t ;
 491
 492 : dead-loop ( obj -- final-obj )
 493     iterate [ dead-loop ] when ; inline recursive
 494
 495 [ V{ fixnum } ] [ [ { fixnum } declare dead-loop ] final-classes ] unit-test
 496
 497 : hang-1 ( m -- x )
 498     dup 0 number= [ hang-1 ] unless ; inline recursive
 499
 500 [ ] [ [ 3 hang-1 ] final-info drop ] unit-test
 501
 502 : hang-2 ( m n -- x )
 503     over 0 number= [
 504         nip
 505     ] [
 506         dup [
 507             drop 1 hang-2
 508         ] [
 509             dupd hang-2 hang-2
 510         ] if
 511     ] if ; inline recursive
 512
 513 [ ] [ [ 3 over hang-2 ] final-info drop ] unit-test
 514
 515 [ ] [
 516     [
 517         dup fixnum? [ 3 over hang-2 ] [ 3 over hang-2 ] if
 518     ] final-info drop
 519 ] unit-test
 520
 521 [ V{ word } ] [
 522     [ { hashtable } declare hashtable instance? ] final-classes
 523 ] unit-test
 524
 525 [ V{ POSTPONE: f } ] [
 526     [ { vector } declare hashtable instance? ] final-classes
 527 ] unit-test
 528
 529 [ V{ object } ] [
 530     [ { assoc } declare hashtable instance? ] final-classes
 531 ] unit-test
 532
 533 [ V{ word } ] [
 534     [ { string } declare string? ] final-classes
 535 ] unit-test
 536
 537 [ V{ POSTPONE: f } ] [
 538     [ 3 string? ] final-classes
 539 ] unit-test
 540
 541 [ V{ fixnum } ] [
 542     [ { fixnum } declare [ ] curry obj>> ] final-classes
 543 ] unit-test
 544
 545 [ V{ fixnum } ] [
 546     [ { fixnum fixnum } declare [ nth-unsafe ] curry call ] final-classes
 547 ] unit-test
 548
 549 [ V{ f } ] [
 550     [ 10 eq? [ drop 3 ] unless ] final-literals
 551 ] unit-test
 552
 553 GENERIC: bad-generic ( a -- b )
 554 M: fixnum bad-generic 1 fixnum+fast ;
 555 : bad-behavior ( -- b ) 4 bad-generic ; inline recursive
 556
 557 [ V{ fixnum } ] [ [ bad-behavior ] final-classes ] unit-test
 558
 559 [ V{ number } ] [
 560     [
 561         0 10 [ bad-generic dup 123 bitand drop bad-generic 1 + ] times
 562     ] final-classes
 563 ] unit-test
 564
 565 GENERIC: infinite-loop ( a -- b )
 566 M: integer infinite-loop infinite-loop ;
 567
 568 [ ] [ [ { integer } declare infinite-loop ] final-classes drop ] unit-test
 569
 570 [ V{ tuple } ] [ [ tuple-layout <tuple> ] final-classes ] unit-test
 571
 572 [ ] [ [ instance? ] final-classes drop ] unit-test
 573
 574 [ f ] [ [ V{ } clone ] final-info first literal?>> ] unit-test
 575
 576 : fold-throw-test ( a -- b ) "A" throw ; foldable
 577
 578 [ ] [ [ 0 fold-throw-test ] final-info drop ] unit-test
 579
 580 : too-deep ( a b -- c )
 581     dup [ drop ] [ 2dup too-deep too-deep * ] if ; inline recursive
 582
 583 [ ] [ [ too-deep ] final-info drop ] unit-test
 584
 585 [ ] [ [ reversed boa slice boa nth-unsafe * ] final-info drop ] unit-test
 586
 587 MIXIN: empty-mixin
 588
 589 [ ] [ [ { empty-mixin } declare empty-mixin? ] final-info drop ] unit-test
 590
 591 [ V{ fixnum } ] [ [ [ bignum-shift drop ] keep ] final-classes ] unit-test
 592
 593 [ V{ float } ] [
 594     [
 595         [ { float float } declare <complex> ]
 596         [ 2drop C{ 0.0 0.0 } ]
 597         if real-part
 598     ] final-classes
 599 ] unit-test
 600
 601 [ V{ POSTPONE: f } ] [
 602     [ { float } declare 0 eq? ] final-classes
 603 ] unit-test
 604
 605 [ V{ integer } ] [
 606     [ { integer fixnum } declare mod ] final-classes
 607 ] unit-test
 608
 609 [ V{ integer } ] [
 610     [ { fixnum integer } declare bitand ] final-classes
 611 ] unit-test
 612
 613 [ V{ double-array } ] [ [| | double-array{ } ] final-classes ] unit-test
 614
 615 [ V{ t } ] [ [ netbsd unix? ] final-literals ] unit-test
 616
 617 [ V{ array } ] [ [ [ <=> ] sort [ <=> ] sort ] final-classes ] unit-test
 618
 619 [ V{ float } ] [ [ fsqrt ] final-classes ] unit-test
 620
 621 [ V{ t } ] [ [ { fixnum } declare 10 mod >float -20 > ] final-literals ] unit-test
 622
 623 [ T{ interval f { 0 t } { 127 t } } ] [
 624     [ { integer } declare 127 bitand ] final-info first interval>>
 625 ] unit-test
 626
 627 [ V{ bignum } ] [
 628     [ { bignum } declare dup 1- bitxor ] final-classes
 629 ] unit-test
 630
 631 [ V{ bignum integer } ] [
 632     [ { bignum integer } declare [ shift ] keep ] final-classes
 633 ] unit-test
 634
 635 [ V{ fixnum } ] [
 636     [ { fixnum } declare log2 ] final-classes
 637 ] unit-test
 638
 639 [ V{ word } ] [
 640     [ { fixnum } declare log2 0 >= ] final-classes
 641 ] unit-test
 642
 643 [ V{ POSTPONE: f } ] [
 644     [ { word object } declare equal? ] final-classes
 645 ] unit-test
 646
 647 ! [ V{ string } ] [
 648 !     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 649 ! ] unit-test
 650
 651 ! [ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test
 652
 653 ! [ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test
 654
 655 ! [ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test
 656
 657 ! [ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test