languages/tcl/src/grammar/expr/operators.pir

   1 # $Id$
   2
   3 =head1 NAME
   4
   5 src/grammar/expr/operators.pir - [expr] operator definitions.
   6
   7 =head2 Prefix Operators
   8
   9 =cut
  10
  11 .HLL 'Tcl', ''
  12 .namespace []
  13
  14 # unary plus
  15 .sub 'prefix:+' :multi(String)
  16     .param pmc a
  17
  18     .local pmc toNumber
  19     toNumber = get_root_global ['_tcl'], 'toNumber'
  20
  21     push_eh is_string
  22       a = toNumber(a)
  23     pop_eh
  24
  25     .return(a)
  26
  27 is_string:
  28     if a == '' goto empty_string
  29     die "can't use non-numeric string as operand of \"+\""
  30
  31 empty_string:
  32     die "can't use empty string as operand of \"+\""
  33 .end
  34
  35 .sub 'prefix:+' :multi(pmc)
  36     .param pmc a
  37     .return(a)
  38 .end
  39
  40 # unary minus
  41 .sub 'prefix:-' :multi(String)
  42     .param pmc a
  43
  44     .local pmc toNumber
  45     toNumber  = get_root_global ['_tcl'], 'toNumber'
  46
  47     push_eh is_string
  48       a = toNumber(a)
  49     pop_eh
  50     $S0 = typeof a
  51     if $S0 == "TclInt" goto is_int
  52
  53     $N0 = a
  54     $N0 = neg $N0
  55     .return($N0)
  56
  57 is_int:
  58     $I0 = a
  59     $I0 = neg $I0
  60     .return($I0)
  61
  62 is_string:
  63     if a == '' goto empty_string
  64     die "can't use non-numeric string as operand of \"-\""
  65
  66 empty_string:
  67     die "can't use empty string as operand of \"-\""
  68 .end
  69
  70 .sub 'prefix:-' :multi(pmc)
  71     .param pmc a
  72     .local pmc b
  73     b = clone a
  74     b = -b
  75     .return(b)
  76 .end
  77
  78 # bit-wise NOT
  79 .sub 'prefix:~' :multi(String)
  80     .param pmc a
  81
  82     .local pmc toNumber
  83     toNumber = get_root_global ['_tcl'], 'toNumber'
  84
  85     push_eh is_string
  86       a = toNumber(a)
  87     pop_eh
  88
  89     $S0 = typeof a
  90     if $S0 == 'TclFloat' goto cant_use_float
  91
  92     $I0 = a
  93     $I0 = bnot $I0
  94     .return($I0)
  95
  96 cant_use_float:
  97     die "can't use floating-point value as operand of \"~\""
  98
  99 is_string:
 100     if a == '' goto empty_string
 101     die "can't use non-numeric string as operand of \"~\""
 102
 103 empty_string:
 104     die "can't use empty string as operand of \"~\""
 105 .end
 106
 107 .sub 'prefix:~' :multi(Float)
 108     die "can't use floating-point value as operand of \"~\""
 109 .end
 110
 111 .sub 'prefix:~' :multi(pmc)
 112     .param int a
 113     $I0 = bnot a
 114     .return ($I0)
 115 .end
 116
 117 # logical NOT
 118 .sub 'prefix:!' :multi(String)
 119     .param pmc a
 120
 121     .local pmc toBoolean
 122     toBoolean = get_root_global ['_tcl'], 'toBoolean'
 123
 124     push_eh is_string
 125       a = toBoolean(a)
 126     pop_eh
 127
 128     $I0 = a
 129     $I0 = not $I0
 130     .return($I0)
 131
 132 is_string:
 133     if a == '' goto empty_string
 134     die "can't use non-numeric string as operand of \"!\""
 135
 136 empty_string:
 137     die "can't use empty string as operand of \"!\""
 138 .end
 139
 140 .sub 'prefix:!' :multi(pmc)
 141     .param int a
 142     $I0 = not a
 143     .return ($I0)
 144 .end
 145
 146 =head2 Infix Operators
 147
 148 &&, || (and ?:) are handled during the PGE transformation stage.
 149
 150 =cut
 151
 152 # this is used to make double-quoted strings work
 153 # (they're a series of captures that need to be concatenated)
 154 .sub 'infix:concat'
 155     .param pmc a
 156     .param pmc b
 157
 158     $S0 = a
 159     $S1 = b
 160     $S0 = $S0 . $S1
 161
 162     $P0 = new 'TclString'
 163     $P0 = $S0
 164     .return($P0)
 165 .end
 166
 167 .sub 'infix:**'
 168     .param pmc a
 169     .param pmc b
 170
 171     .local pmc toNumber
 172     toNumber = get_root_global ['_tcl'], 'toNumber'
 173
 174     push_eh is_string
 175       a = toNumber(a)
 176       b = toNumber(b)
 177     pop_eh
 178
 179     if a == 0 goto zero
 180
 181     $P0 = new 'TclFloat'
 182     $P0 = pow a, b
 183     .return ($P0)
 184
 185 is_string:
 186     if a == '' goto empty_string
 187     if b == '' goto empty_string
 188     die "can't use non-numeric string as operand of \"**\""
 189
 190 empty_string:
 191     die "can't use empty string as operand of \"**\""
 192
 193 zero:
 194     if b < 0 goto zero_with_neg
 195     if b == 0 goto zero_with_zero
 196     .return(0)
 197
 198 zero_with_zero:
 199     .return(1)
 200 zero_with_neg:
 201      die 'exponentiation of zero by negative power'
 202 .end
 203
 204 .sub 'infix:*'
 205     .param pmc a
 206     .param pmc b
 207
 208     .local pmc toNumber
 209     toNumber = get_root_global ['_tcl'], 'toNumber'
 210
 211     push_eh is_string
 212       a = toNumber(a)
 213       b = toNumber(b)
 214       $P0 = new 'TclFloat'
 215       $P0 = mul a, b
 216     pop_eh
 217     .return ($P0)
 218
 219 is_string:
 220     if a == '' goto empty_string
 221     if b == '' goto empty_string
 222     die "can't use non-numeric string as operand of \"*\""
 223
 224 empty_string:
 225     die "can't use empty string as operand of \"*\""
 226 .end
 227
 228 .sub 'infix:/'
 229     .param pmc a
 230     .param pmc b
 231
 232     .local pmc toNumber
 233     toNumber = get_root_global ['_tcl'], 'toNumber'
 234
 235     push_eh is_string
 236       a = toNumber(a)
 237       b = toNumber(b)
 238     pop_eh
 239
 240     if b == 0 goto divide_by_zero
 241
 242     $P0 = new 'TclFloat'
 243     $P0 = div a, b
 244     .return($P0)
 245
 246 divide_by_zero:
 247     $P0 = new 'TclList'
 248     $P0[0] = 'ARITH'
 249     $P0[1] = 'DIVZERO'
 250     $S0 = 'divide by zero'
 251     $P0[2] = $S0
 252     tcl_error $S0,  $P0
 253
 254 is_string:
 255     if a == '' goto empty_string
 256     if b == '' goto empty_string
 257     die "can't use non-numeric string as operand of \"/\""
 258
 259 empty_string:
 260     die "can't use empty string as operand of \"/\""
 261 .end
 262
 263 .sub 'infix:%'
 264     .param pmc a
 265     .param pmc b
 266
 267     .local pmc toNumber
 268     toNumber = get_root_global ['_tcl'], 'toNumber'
 269
 270     push_eh is_string
 271       a = toNumber(a)
 272       b = toNumber(b)
 273     pop_eh
 274
 275     $I0 = isa a, 'TclFloat'
 276     if $I0 goto is_float
 277     $I0 = isa b, 'TclFloat'
 278     if $I0 goto is_float
 279
 280     $P0 = new 'TclInt'
 281     $P0 = mod a, b
 282     .return($P0)
 283
 284 is_string:
 285     if a == '' goto empty_string
 286     if b == '' goto empty_string
 287     die "can't use non-numeric string as operand of \"%\""
 288
 289 empty_string:
 290     die "can't use empty string as operand of \"%\""
 291
 292 is_float:
 293     die "can't use floating-point value as operand of \"%\""
 294 .end
 295
 296 .sub 'infix:+'
 297     .param pmc a
 298     .param pmc b
 299
 300     .local pmc toNumber
 301     toNumber = get_root_global ['_tcl'], 'toNumber'
 302
 303     push_eh is_string
 304       a = toNumber(a)
 305       b = toNumber(b)
 306       $P0 = new 'TclFloat'
 307       $P0 = a + b
 308     pop_eh
 309     .return($P0)
 310
 311 is_string:
 312     if a == '' goto empty_string
 313     if b == '' goto empty_string
 314     die "can't use non-numeric string as operand of \"+\""
 315
 316 empty_string:
 317     die "can't use empty string as operand of \"+\""
 318 .end
 319
 320 .sub 'infix:-'
 321     .param pmc a
 322     .param pmc b
 323
 324     .local pmc toNumber
 325     toNumber = get_root_global ['_tcl'], 'toNumber'
 326
 327     push_eh is_string
 328       a = toNumber(a)
 329       b = toNumber(b)
 330       $P0 = new 'TclFloat'
 331       $P0 = a - b
 332     pop_eh
 333     .return($P0)
 334
 335 is_string:
 336     if a == '' goto empty_string
 337     if b == '' goto empty_string
 338     die "can't use non-numeric string as operand of \"-\""
 339
 340 empty_string:
 341     die "can't use empty string as operand of \"-\""
 342 .end
 343
 344 # left shift
 345 .sub 'infix:<<'     :multi(Float, pmc)
 346   die "can't use floating-point value as operand of \"<<\""
 347 .end
 348
 349 .sub 'infix:<<'     :multi(pmc, Float)
 350   die "can't use floating-point value as operand of \"<<\""
 351 .end
 352
 353 .sub 'infix:<<'     :multi(Integer, Integer)
 354     .param int a
 355     .param int b
 356
 357     $I0 = shl a, b
 358     .return($I0)
 359 .end
 360
 361 .sub 'infix:<<'     :multi(pmc, pmc)
 362     .param pmc a
 363     .param pmc b
 364
 365     .local pmc toNumber
 366     toNumber = get_root_global ['_tcl'], 'toNumber'
 367
 368     push_eh is_string
 369       a = toNumber(a)
 370       b = toNumber(b)
 371     pop_eh
 372
 373     $I0 = isa a, 'Float'
 374     if $I0 goto is_float
 375     $I0 = isa b, 'Float'
 376     if $I0 goto is_float
 377
 378     $I0 = a
 379     $I1 = b
 380     $I0 = shl $I0, $I1
 381     .return ($I0)
 382
 383 is_string:
 384     if a == '' goto empty_string
 385     if b == '' goto empty_string
 386     die "can't use non-numeric string as operand of \"<<\""
 387
 388 empty_string:
 389     die "can't use empty string as operand of \"<<\""
 390
 391 is_float:
 392   die "can't use floating-point value as operand of \"<<\""
 393 .end
 394
 395 # right shift
 396 .sub 'infix:>>'     :multi(Float, pmc)
 397   die "can't use floating-point value as operand of \">>\""
 398 .end
 399
 400 .sub 'infix:>>'     :multi(pmc, Float)
 401   die "can't use floating-point value as operand of \">>\""
 402 .end
 403
 404 .sub 'infix:>>'     :multi(Integer, Integer)
 405     .param int a
 406     .param int b
 407     $I0 = shr a, b
 408     .return ($I0)
 409 .end
 410
 411 .sub 'infix:>>'     :multi(pmc, pmc)
 412     .param pmc a
 413     .param pmc b
 414
 415     .local pmc toNumber
 416     toNumber = get_root_global ['_tcl'], 'toNumber'
 417
 418     push_eh is_string
 419       a = toNumber(a)
 420       b = toNumber(b)
 421     pop_eh
 422
 423     $I0 = isa a, 'Float'
 424     if $I0 goto is_float
 425     $I0 = isa b, 'Float'
 426     if $I0 goto is_float
 427
 428     $I0 = a
 429     $I1 = b
 430     $I0 = shr $I0, $I1
 431     .return ($I0)
 432
 433 is_string:
 434     if a == '' goto empty_string
 435     if b == '' goto empty_string
 436     die "can't use non-numeric string as operand of \">>\""
 437
 438 empty_string:
 439     die "can't use empty string as operand of \">>\""
 440
 441 is_float:
 442     die "can't use floating-point value as operand of \">>\""
 443 .end
 444
 445 # *ALL* operands
 446 .sub 'infix:<'     # boolean less than
 447     .param pmc a
 448     .param pmc b
 449
 450     .local pmc toNumber
 451     toNumber = get_root_global ['_tcl'], 'toNumber'
 452     push_eh is_string
 453       $P0 = toNumber(a)
 454       $P1 = toNumber(b)
 455       $I0 = islt $P0, $P1
 456     pop_eh
 457     .return ($I0)
 458
 459 is_string:
 460     $I0 = islt a, b
 461     .return($I0)
 462 .end
 463
 464 # *ALL* operands
 465 .sub 'infix:>'     # boolean greater than
 466     .param pmc a
 467     .param pmc b
 468
 469     .local pmc toNumber
 470     toNumber = get_root_global ['_tcl'], 'toNumber'
 471     push_eh is_string
 472       $P0 = toNumber(a)
 473       $P1 = toNumber(b)
 474       $I0 = isgt $P0, $P1
 475     pop_eh
 476     .return($I0)
 477
 478 is_string:
 479     $I0 = isgt a, b
 480     .return ($I0)
 481 .end
 482
 483 # *ALL* operands
 484 .sub 'infix:<='    # boolean less than or equal
 485     .param pmc a
 486     .param pmc b
 487
 488     .local pmc toNumber
 489     toNumber = get_root_global ['_tcl'], 'toNumber'
 490
 491     push_eh is_string
 492       $P0 = toNumber(a)
 493       $P1 = toNumber(b)
 494       $I0 = isle $P0, $P1
 495     pop_eh
 496     .return($I0)
 497
 498 is_string:
 499     $I0 = isle a, b
 500     .return ($I0)
 501 .end
 502
 503 # *ALL* operands
 504 .sub 'infix:>='    # boolean greater than or equal
 505     .param pmc a
 506     .param pmc b
 507
 508     .local pmc toNumber
 509     $P0 = get_root_namespace
 510     toNumber = $P0['_tcl'; 'toNumber']
 511
 512     push_eh is_string
 513       $P0 = toNumber(a)
 514       $P1 = toNumber(b)
 515       $I0 = isge $P0, $P1
 516     pop_eh
 517     .return($I0)
 518
 519 is_string:
 520     $I0 = isge a, b
 521     .return ($I0)
 522 .end
 523
 524 # *ALL* operands
 525 .sub 'infix:=='    # boolean equal
 526     .param pmc a
 527     .param pmc b
 528
 529     .local pmc toNumber
 530     $P0 = get_root_namespace
 531     toNumber = $P0['_tcl'; 'toNumber']
 532
 533     push_eh is_string
 534       $P0 = toNumber(a)
 535       $P1 = toNumber(b)
 536       $I0 = iseq $P0, $P1
 537     pop_eh
 538     .return($I0)
 539
 540 is_string:
 541     $S0 = a
 542     $S1 = b
 543     $I0 = iseq $S0, $S1
 544     .return ($I0)
 545 .end
 546
 547 # *ALL* operands
 548 .sub 'infix:!='    # boolean not equal
 549     .param pmc a
 550     .param pmc b
 551
 552     .local pmc toNumber
 553     $P0 = get_root_namespace
 554     toNumber = $P0['_tcl'; 'toNumber']
 555
 556     push_eh is_string
 557       $P0 = toNumber(a)
 558       $P1 = toNumber(b)
 559       $I0 = isne $P0, $P1
 560     pop_eh
 561     .return($I0)
 562
 563 is_string:
 564     $S0 = a
 565     $S1 = b
 566     $I0 = isne $S0, $S1
 567     .return ($I0)
 568 .end
 569
 570 .sub 'infix:eq'    # string equality
 571     .param string a
 572     .param string b
 573     $I0 = iseq a, b
 574     .return ($I0)
 575 .end
 576
 577 .sub 'infix:ne'    # string inequality
 578     .param pmc a
 579     .param pmc b
 580
 581     $S0 = a
 582     $S1 = b
 583     $I0 = isne $S0, $S1
 584     .return ($I0)
 585 .end
 586
 587
 588 # bitwise AND
 589 .sub 'infix:&'     :multi(String, String)
 590   .param pmc a
 591   .param pmc b
 592
 593   .local pmc toInteger
 594   toInteger = get_root_global ['_tcl'], 'toInteger'
 595
 596   push_eh is_string
 597     a = toInteger(a)
 598     b = toInteger(b)
 599   pop_eh
 600
 601   $I0 = a
 602   $I1 = b
 603   $I0 = band $I0, $I1
 604   .return($I0)
 605
 606 is_string:
 607     if a == '' goto empty_string
 608     if b == '' goto empty_string
 609     die "can't use non-numeric string as operand of \"&\""
 610
 611 empty_string:
 612     die "can't use empty string as operand of \"&\""
 613 .end
 614
 615 .sub 'infix:&'     :multi(String, Integer)
 616   .param pmc a
 617   .param int b
 618
 619   .local pmc toInteger
 620   toInteger = get_root_global ['_tcl'], 'toInteger'
 621
 622   push_eh is_string
 623     a = toInteger(a)
 624   pop_eh
 625
 626   $I0 = a
 627   $I0 = band $I0, b
 628   .return($I0)
 629
 630 is_string:
 631     if a == '' goto empty_string
 632     die "can't use non-numeric string as operand of \"&\""
 633
 634 empty_string:
 635     die "can't use empty string as operand of \"&\""
 636 .end
 637
 638 .sub 'infix:&'     :multi(Integer, String)
 639   .param int a
 640   .param pmc b
 641
 642   .local pmc toInteger
 643   toInteger = get_root_global ['_tcl'], 'toInteger'
 644
 645   push_eh is_string
 646     b = toInteger(b)
 647   pop_eh
 648
 649   $I0 = b
 650   $I0 = band a, $I0
 651   .return($I0)
 652
 653 is_string:
 654     if b == '' goto empty_string
 655     die "can't use non-numeric string as operand of \"&\""
 656
 657 empty_string:
 658     die "can't use empty string as operand of \"&\""
 659 .end
 660
 661 .sub 'infix:&'     :multi(Float, String)
 662     .param pmc a
 663     .param pmc b
 664
 665     .local pmc toInteger
 666     toInteger = get_root_global ['_tcl'], 'toInteger'
 667
 668     push_eh is_string
 669         b = toInteger(b)
 670     pop_eh
 671     die "can't use floating-point value as operand of \"&\""
 672
 673 is_string:
 674     if b == '' goto empty_string
 675     die "can't use non-numeric string as operand of \"&\""
 676
 677 empty_string:
 678     die "can't use empty string as operand of \"&\""
 679 .end
 680
 681 .sub 'infix:&'     :multi(String, Float)
 682     .param pmc a
 683     .param pmc b
 684
 685     .local pmc toInteger
 686     toInteger = get_root_global ['_tcl'], 'toInteger'
 687
 688     push_eh is_string
 689         a = toInteger(a)
 690     pop_eh
 691     die "can't use floating-point value as operand of \"&\""
 692
 693 is_string:
 694     if a == '' goto empty_string
 695     die "can't use non-numeric string as operand of \"&\""
 696
 697 empty_string:
 698     die "can't use empty string as operand of \"&\""
 699 .end
 700
 701 .sub 'infix:&'     :multi(Float, pmc)
 702   die "can't use floating-point value as operand of \"&\""
 703 .end
 704
 705 .sub 'infix:&'     :multi(pmc, Float)
 706   die "can't use floating-point value as operand of \"&\""
 707 .end
 708
 709 .sub 'infix:&'     :multi(Integer, Integer)
 710     .param int a
 711     .param int b
 712     $I0 = band a, b
 713     .return ($I0)
 714 .end
 715
 716
 717 # bitwise exclusive OR
 718 .sub 'infix:^'     :multi(String, String)
 719   .param pmc a
 720   .param pmc b
 721
 722   .local pmc toInteger
 723   toInteger = get_root_global ['_tcl'], 'toInteger'
 724
 725   push_eh is_string
 726     a = toInteger(a)
 727     b = toInteger(b)
 728   pop_eh
 729
 730   $I0 = a
 731   $I1 = b
 732   $I0 = bxor $I0, $I1
 733   .return($I0)
 734
 735 is_string:
 736     if a == '' goto empty_string
 737     if b == '' goto empty_string
 738     die "can't use non-numeric string as operand of \"^\""
 739
 740 empty_string:
 741     die "can't use empty string as operand of \"^\""
 742 .end
 743
 744 .sub 'infix:^'     :multi(String, Integer)
 745   .param pmc a
 746   .param int b
 747
 748   .local pmc toInteger
 749   toInteger = get_root_global ['_tcl'], 'toInteger'
 750
 751   push_eh is_string
 752     a = toInteger(a)
 753   pop_eh
 754
 755   $I0 = a
 756   $I0 = bxor $I0, b
 757   .return($I0)
 758
 759 is_string:
 760     if a == '' goto empty_string
 761     die "can't use non-numeric string as operand of \"^\""
 762
 763 empty_string:
 764     die "can't use empty string as operand of \"^\""
 765 .end
 766
 767 .sub 'infix:^'     :multi(Integer, String)
 768   .param int a
 769   .param pmc b
 770
 771   .local pmc toInteger
 772   toInteger = get_root_global ['_tcl'], 'toInteger'
 773
 774   push_eh is_string
 775     b = toInteger(b)
 776   pop_eh
 777
 778   $I0 = b
 779   $I0 = bxor a, $I0
 780   .return($I0)
 781
 782 is_string:
 783     if b == '' goto empty_string
 784     die "can't use non-numeric string as operand of \"^\""
 785
 786 empty_string:
 787     die "can't use empty string as operand of \"^\""
 788 .end
 789
 790 .sub 'infix:^'     :multi(Float, String)
 791     .param pmc a
 792     .param pmc b
 793
 794     .local pmc toInteger
 795     toInteger = get_root_global ['_tcl'], 'toInteger'
 796
 797     push_eh is_string
 798         b = toInteger(b)
 799     pop_eh
 800     die "can't use floating-point value as operand of \"^\""
 801
 802 is_string:
 803     if b == '' goto empty_string
 804     die "can't use non-numeric string as operand of \"^\""
 805
 806 empty_string:
 807     die "can't use empty string as operand of \"^\""
 808 .end
 809
 810 .sub 'infix:^'     :multi(String, Float)
 811     .param pmc a
 812     .param pmc b
 813
 814     .local pmc toInteger
 815     toInteger = get_root_global ['_tcl'], 'toInteger'
 816
 817     push_eh is_string
 818         a = toInteger(a)
 819     pop_eh
 820     die "can't use floating-point value as operand of \"^\""
 821
 822 is_string:
 823     if a == '' goto empty_string
 824     die "can't use non-numeric string as operand of \"^\""
 825
 826 empty_string:
 827     die "can't use empty string as operand of \"^\""
 828 .end
 829
 830 .sub 'infix:^'     :multi(Float, pmc)
 831   die "can't use floating-point value as operand of \"^\""
 832 .end
 833
 834 .sub 'infix:^'     :multi(pmc, Float)
 835   die "can't use floating-point value as operand of \"^\""
 836 .end
 837
 838 .sub 'infix:^'     :multi(Integer, Integer)
 839     .param int a
 840     .param int b
 841     $I0 = bxor a, b
 842     .return ($I0)
 843 .end
 844
 845
 846 # bitwise OR
 847 .sub 'infix:|'     :multi(String, String)
 848   .param pmc a
 849   .param pmc b
 850
 851   .local pmc toInteger
 852   toInteger = get_root_global ['_tcl'], 'toInteger'
 853
 854   push_eh is_string
 855     a = toInteger(a)
 856     b = toInteger(b)
 857   pop_eh
 858
 859   $I0 = a
 860   $I1 = b
 861   $I0 = bor $I0, $I1
 862   .return($I0)
 863
 864 is_string:
 865     if a == '' goto empty_string
 866     if b == '' goto empty_string
 867     die "can't use non-numeric string as operand of \"|\""
 868
 869 empty_string:
 870     die "can't use empty string as operand of \"|\""
 871 .end
 872
 873 .sub 'infix:|'     :multi(String, Integer)
 874   .param pmc a
 875   .param int b
 876
 877   .local pmc toInteger
 878   toInteger = get_root_global ['_tcl'], 'toInteger'
 879
 880   push_eh is_string
 881     a = toInteger(a)
 882   pop_eh
 883
 884   $I0 = a
 885   $I0 = bor $I0, b
 886   .return($I0)
 887
 888 is_string:
 889     if a == '' goto empty_string
 890     die "can't use non-numeric string as operand of \"|\""
 891
 892 empty_string:
 893     die "can't use empty string as operand of \"|\""
 894 .end
 895
 896 .sub 'infix:|'     :multi(Integer, String)
 897   .param int a
 898   .param pmc b
 899
 900   .local pmc toInteger
 901   toInteger = get_root_global ['_tcl'], 'toInteger'
 902
 903   push_eh is_string
 904     b = toInteger(b)
 905   pop_eh
 906
 907   $I0 = b
 908   $I0 = bor a, $I0
 909   .return($I0)
 910
 911 is_string:
 912     if b == '' goto empty_string
 913     die "can't use non-numeric string as operand of \"|\""
 914
 915 empty_string:
 916     die "can't use empty string as operand of \"|\""
 917 .end
 918
 919 .sub 'infix:|'     :multi(Float, String)
 920     .param pmc a
 921     .param pmc b
 922
 923     .local pmc toInteger
 924     toInteger = get_root_global ['_tcl'], 'toInteger'
 925
 926     push_eh is_string
 927         b = toInteger(b)
 928     pop_eh
 929     die "can't use floating-point value as operand of \"|\""
 930
 931 is_string:
 932     if b == '' goto empty_string
 933     die "can't use non-numeric string as operand of \"|\""
 934
 935 empty_string:
 936     die "can't use empty string as operand of \"|\""
 937 .end
 938
 939 .sub 'infix:|'     :multi(String, Float)
 940     .param pmc a
 941     .param pmc b
 942
 943     .local pmc toInteger
 944     toInteger = get_root_global ['_tcl'], 'toInteger'
 945
 946     push_eh is_string
 947         a = toInteger(a)
 948     pop_eh
 949     die "can't use floating-point value as operand of \"|\""
 950
 951 is_string:
 952     if a == '' goto empty_string
 953     die "can't use non-numeric string as operand of \"|\""
 954
 955 empty_string:
 956     die "can't use empty string as operand of \"|\""
 957 .end
 958
 959 .sub 'infix:|'     :multi(Float, pmc)
 960   die "can't use floating-point value as operand of \"|\""
 961 .end
 962
 963 .sub 'infix:|'     :multi(pmc, Float)
 964   die "can't use floating-point value as operand of \"|\""
 965 .end
 966
 967 .sub 'infix:|'     :multi(Integer, Integer)
 968     .param int a
 969     .param int b
 970     $I0 = bor a, b
 971     .return ($I0)
 972 .end
 973
 974
 975 .sub 'infix:in'
 976     .param pmc elem
 977     .param pmc list
 978
 979     .local pmc toList
 980     $P0 = get_root_namespace
 981     toList = $P0['_tcl'; 'toList']
 982
 983     .local pmc iter
 984     list = toList(list)
 985     iter = new 'Iterator', list
 986 loop:
 987     unless iter goto false
 988     $P0 = shift iter
 989     $I0 = 'infix:=='(elem, $P0)
 990     if $I0 goto true
 991     goto loop
 992 true:
 993     .return(1)
 994 false:
 995     .return(0)
 996 .end
 997
 998 .sub 'infix:ni'
 999     .param pmc elem
1000     .param pmc list
1001
1002     .local pmc toList
1003     $P0 = get_root_namespace
1004     toList = $P0['_tcl'; 'toList']
1005
1006     .local pmc iter
1007     list = toList(list)
1008     iter = new 'Iterator', list
1009 loop:
1010     unless iter goto true
1011     $P0 = shift iter
1012     $I0 = 'infix:=='(elem, $P0)
1013     if $I0 goto false
1014     goto loop
1015 true:
1016     .return(1)
1017 false:
1018     .return(0)
1019 .end
1020
1021 # Local Variables:
1022 #   mode: pir
1023 #   fill-column: 100
1024 # End:
1025 # vim: expandtab shiftwidth=4 ft=pir: