languages/cardinal/src/classes/Array.pir

   1 ## $Id$
   2
   3 =head1 NAME
   4
   5 src/classes/CardinalArray.pir - Cardinal CardinalArray class and related functions
   6 Stolen from Rakudo
   7
   8 =head1 Methods
   9
  10 =over 4
  11
  12 =cut
  13
  14 .namespace ['CardinalArray']
  15
  16 .sub 'onload' :anon :load :init
  17     .local pmc cardinalmeta, arrayproto
  18     cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
  19     arrayproto = cardinalmeta.'new_class'('CardinalArray', 'parent'=>'ResizablePMCArray CardinalObject')
  20     cardinalmeta.'register'('ResizablePMCArray', 'parent'=>'CardinalObject', 'protoobject'=>arrayproto)
  21 .end
  22
  23
  24 =item get_string()    (vtable method)
  25
  26 Return the elements of the list concatenated.
  27
  28 =cut
  29
  30 .sub 'get_string' :vtable :method
  31     $S0 = join ', ', self
  32     $S0 = concat '[', $S0
  33     $S0 = concat $S0, ']'
  34     .return ($S0)
  35 .end
  36
  37 =item to_s()    (method)
  38
  39 Return a CardinalString representing the Array.
  40
  41 =cut
  42
  43 .sub 'to_s' :method
  44     $S0 = self.get_string()
  45     $P0 = new 'CardinalString'
  46     $P0 = $S0
  47     .return($P0)
  48 .end
  49
  50 =item clone()    (vtable method)
  51
  52 Clones the list.
  53
  54 =cut
  55
  56 .sub 'clone' :vtable :method
  57     $P0 = 'list'(self)
  58     .return ($P0)
  59 .end
  60
  61
  62 =item ACCEPTS(topic)
  63
  64 =cut
  65
  66 .sub 'ACCEPTS' :method
  67     .param pmc topic
  68     .local int i
  69
  70     .local string what
  71     what = topic.'WHAT'()
  72     if what == "CardinalArray" goto acc_list
  73     goto no_match
  74
  75 acc_list:
  76     # Smartmatch against another list. Smartmatch each
  77     # element.
  78     .local int count_1, count_2
  79     count_1 = elements self
  80     count_2 = elements topic
  81     if count_1 != count_2 goto no_match
  82     i = 0
  83 list_cmp_loop:
  84     if i >= count_1 goto list_cmp_loop_end
  85     .local pmc elem_1, elem_2
  86     elem_1 = self[i]
  87     elem_2 = topic[i]
  88     ($I0) = elem_1.ACCEPTS(elem_2)
  89     unless $I0 goto no_match
  90     inc i
  91     goto list_cmp_loop
  92 list_cmp_loop_end:
  93     goto match
  94
  95 no_match:
  96     $P0 = get_hll_global ['Bool'], 'False'
  97     .return($P0)
  98 match:
  99     $P0 = get_hll_global ['Bool'], 'True'
 100     .return($P0)
 101 .end
 102
 103
 104 =item elems()
 105
 106 Return the number of elements in the list.
 107
 108 =cut
 109
 110 .sub 'elems' :method
 111     $I0 = elements self
 112     .return ($I0)
 113 .end
 114
 115 =item unshift(ELEMENTS)
 116
 117 Prepends ELEMENTS to the front of the list.
 118
 119 =cut
 120
 121 .sub 'unshift' :method
 122     .param pmc args :slurpy
 123     .local int narg
 124     .local int i
 125
 126     narg = args
 127     i = 0
 128
 129     .local pmc tmp
 130   loop:
 131     if i == narg goto done
 132     pop tmp, args
 133     unshift self, tmp
 134     inc i
 135     goto loop
 136   done:
 137 .end
 138
 139 =item keys()
 140
 141 Returns a CardinalArray containing the keys of the CardinalArray.
 142
 143 =cut
 144
 145 .sub 'keys' :method
 146     .local pmc elem
 147     .local pmc res
 148     .local int len
 149     .local int i
 150
 151     res = new 'CardinalArray'
 152     len = elements self
 153     i = 0
 154
 155   loop:
 156     if i == len goto done
 157
 158     elem = new 'CardinalInteger'
 159     elem = i
 160     res.'push'(elem)
 161
 162     inc i
 163     goto loop
 164
 165   done:
 166     .return(res)
 167 .end
 168
 169 =item values()
 170
 171 Returns a CardinalArray containing the values of the CardinalArray.
 172
 173 =cut
 174
 175 .sub 'values' :method
 176     .local pmc elem
 177     .local pmc res
 178     .local int len
 179     .local int i
 180
 181     res = new 'CardinalArray'
 182     len = elements self
 183     i = 0
 184
 185   loop:
 186     if i == len goto done
 187
 188     elem = new 'CardinalInteger'
 189     elem = self[i]
 190     res.'push'(elem)
 191
 192     inc i
 193     goto loop
 194
 195   done:
 196     .return(res)
 197 .end
 198
 199 =item shift()
 200
 201 Shifts the first item off the list and returns it.
 202
 203 =cut
 204
 205 .sub 'shift' :method
 206     .local pmc x
 207     x = shift self
 208     .return (x)
 209 .end
 210
 211 =item pop()
 212
 213 Treats the list as a stack, popping the last item off the list and returning it.
 214
 215 =cut
 216
 217 .sub 'pop' :method
 218     .local pmc x
 219     .local int len
 220
 221     len = elements self
 222
 223     if len == 0 goto empty
 224     pop x, self
 225     goto done
 226
 227   empty:
 228     x = undef()
 229     goto done
 230
 231   done:
 232     .return (x)
 233 .end
 234
 235 =item push(ELEMENTS)
 236
 237 Treats the list as a stack, pushing ELEMENTS onto the end of the list.  Returns the new length of the list.
 238
 239 =cut
 240
 241 .sub 'push' :method
 242     .param pmc args :slurpy
 243     .local int len
 244     .local pmc tmp
 245     .local int i
 246
 247     len = args
 248     i = 0
 249
 250   loop:
 251     if i == len goto done
 252     shift tmp, args
 253     push self, tmp
 254     inc i
 255     goto loop
 256   done:
 257     len = elements self
 258     .return (len)
 259 .end
 260
 261 =item join(SEPARATOR)
 262
 263 Returns a string comprised of all of the list, separated by the string SEPARATOR.  Given an empty list, join returns the empty string.
 264
 265 =cut
 266
 267 .sub 'join' :method
 268     .param string sep
 269     .local string res
 270     .local string tmp
 271     .local int len
 272     .local int i
 273
 274     res = ""
 275
 276     len = elements self
 277     if len == 0 goto done
 278
 279     len = len - 1
 280     i = 0
 281
 282   loop:
 283     if i == len goto last
 284
 285     tmp = self[i]
 286     concat res, tmp
 287     concat res, sep
 288
 289     inc i
 290     goto loop
 291
 292   last:
 293     tmp = self[i]
 294     concat res, tmp
 295
 296   done:
 297     .return(res)
 298 .end
 299
 300 =item reverse()
 301
 302 Returns a list of the elements in revese order.
 303
 304 =cut
 305
 306 .sub 'reverse' :method
 307     .local pmc res
 308     .local int len
 309     .local int i
 310
 311     res = new 'CardinalArray'
 312
 313     len = elements self
 314     if len == 0 goto done
 315     i = 0
 316
 317     .local pmc elem
 318 loop:
 319     if len == 0 goto done
 320
 321     dec len
 322     elem = self[len]
 323     res[i] = elem
 324     inc i
 325
 326     goto loop
 327
 328 done:
 329     .return(res)
 330 .end
 331
 332 =item delete()
 333
 334 Deletes the given elements from the CardinalArray, replacing them with Undef.  Returns a CardinalArray of removed elements.
 335
 336 =cut
 337
 338 .sub delete :method
 339     .param pmc indices :slurpy
 340     .local pmc newelem
 341     .local pmc elem
 342     .local int last
 343     .local pmc res
 344     .local int ind
 345     .local int len
 346     .local int i
 347
 348     newelem = undef()
 349     res = new 'CardinalArray'
 350
 351     # Index of the last element in the array
 352     last = elements self
 353     dec last
 354
 355     len = elements indices
 356     i = 0
 357
 358   loop:
 359     if i == len goto done
 360
 361     ind = indices[i]
 362
 363     if ind == -1 goto endofarray
 364     if ind == last goto endofarray
 365     goto restofarray
 366
 367   endofarray:
 368     # If we're at the end of the array, remove the element entirely
 369     elem = pop self
 370     res.push(elem)
 371     goto next
 372
 373   restofarray:
 374     # Replace the element with undef.
 375     elem = self[ind]
 376     res.push(elem)
 377
 378     self[ind] = newelem
 379
 380   next:
 381     inc i
 382     goto loop
 383   done:
 384     .return(res)
 385 .end
 386
 387 =item exists(INDEX)
 388
 389 Checks to see if the specified index or indices have been assigned to.  Returns a Bool value.
 390
 391 =cut
 392
 393 .sub exists :method
 394     .param pmc indices :slurpy
 395     .local int test
 396     .local int len
 397     .local pmc res
 398     .local int ind
 399     .local int i
 400
 401     test = 1
 402     len = elements indices
 403     i = 0
 404
 405   loop:
 406     if i == len goto done
 407
 408     ind = indices[i]
 409
 410     test = exists self[ind]
 411     if test == 0 goto done
 412
 413     inc i
 414     goto loop
 415
 416   done:
 417     .return 'prefix:?'(test)
 418 .end
 419
 420 =item kv()
 421
 422 =cut
 423
 424 .sub kv :method
 425     .local pmc elem
 426     .local pmc res
 427     .local int len
 428     .local int i
 429
 430     res = new 'CardinalArray'
 431     len = elements self
 432     i = 0
 433
 434   loop:
 435     if i == len goto done
 436
 437     elem = new 'CardinalInteger'
 438     elem = i
 439     res.'push'(elem)
 440
 441     elem = self[i]
 442     res.'push'(elem)
 443
 444     inc i
 445     goto loop
 446
 447   done:
 448     .return(res)
 449 .end
 450
 451 =item pairs()
 452
 453 =cut
 454
 455 .sub pairs :method
 456     .local pmc pair
 457     .local pmc key
 458     .local pmc val
 459     .local pmc res
 460     .local int len
 461     .local int i
 462
 463     res = new 'CardinalArray'
 464     len = elements self
 465     i = 0
 466
 467   loop:
 468     if i == len goto done
 469
 470     key = new 'CardinalInteger'
 471     key = i
 472
 473     val = self[i]
 474
 475     pair = new 'Pair'
 476     pair[key] = val
 477
 478     res.'push'(pair)
 479
 480     inc i
 481     goto loop
 482
 483   done:
 484     .return(res)
 485 .end
 486
 487 =item grep(...)
 488
 489 =cut
 490
 491 .sub grep :method
 492     .param pmc test
 493     .local pmc retv
 494     .local pmc block
 495     .local pmc block_res
 496     .local pmc block_arg
 497     .local int narg
 498     .local int i
 499
 500     retv = new 'CardinalArray'
 501     narg = elements self
 502     i = 0
 503
 504   loop:
 505     if i == narg goto done
 506     block_arg = self[i]
 507
 508     newclosure block, test
 509     block_res = block(block_arg)
 510
 511     if block_res goto grepped
 512     goto next
 513
 514   grepped:
 515     retv.'push'(block_arg)
 516     goto next
 517
 518   next:
 519     inc i
 520     goto loop
 521
 522   done:
 523     .return(retv)
 524 .end
 525
 526 =item first(...)
 527
 528 =cut
 529
 530 .sub first :method
 531     .param pmc test
 532     .local pmc retv
 533     .local pmc block
 534     .local pmc block_res
 535     .local pmc block_arg
 536     .local int narg
 537     .local int i
 538
 539     narg = elements self
 540     i = 0
 541
 542   loop:
 543     if i == narg goto nomatch
 544     block_arg = self[i]
 545
 546     newclosure block, test
 547     block_res = block(block_arg)
 548
 549     if block_res goto matched
 550
 551     inc i
 552     goto loop
 553
 554   matched:
 555     retv = block_arg
 556     goto done
 557
 558   nomatch:
 559     retv = new 'Undef'
 560     goto done
 561
 562   done:
 563     .return(retv)
 564 .end
 565
 566
 567 =item each(block)
 568
 569 Run C<block> once for each item in C<self>, with the item passed as an arg.
 570
 571 =cut
 572
 573 .sub 'each' :method
 574     .param pmc block
 575     $P0 = new 'Iterator', self
 576   each_loop:
 577     unless $P0 goto each_loop_end
 578     $P1 = shift $P0
 579     block($P1)
 580     goto each_loop
 581   each_loop_end:
 582 .end
 583
 584
 585 .sub '[]' :method
 586     .param pmc i
 587     $P0 = self[i]
 588     .return($P0)
 589 .end
 590
 591 .sub '[]=' :method
 592     .param pmc k
 593     .param pmc v
 594     self[k] = v
 595     .return()
 596 .end
 597
 598
 599
 600
 601 =back
 602
 603 =head1 Functions
 604
 605 =over 4
 606
 607 =item C<list(...)>
 608
 609 Build a CardinalArray from its arguments.
 610
 611 =cut
 612
 613 .namespace []
 614
 615 .sub 'list'
 616     .param pmc args            :slurpy
 617     .local pmc list, item
 618     list = new 'CardinalArray'
 619   args_loop:
 620     unless args goto args_end
 621     item = shift args
 622     $I0 = defined item
 623     unless $I0 goto add_item
 624     $I0 = isa item, 'CardinalArray'
 625     if $I0 goto add_item
 626     $I0 = does item, 'array'
 627     unless $I0 goto add_item
 628     splice args, item, 0, 0
 629     goto args_loop
 630   add_item:
 631     push list, item
 632     goto args_loop
 633   args_end:
 634     .return (list)
 635 .end
 636
 637
 638 =item C<infix:,(...)>
 639
 640 Operator form for building a list from its arguments.
 641
 642 =cut
 643
 644 .sub 'infix:,'
 645     .param pmc args            :slurpy
 646     .return 'list'(args :flat)
 647 .end
 648
 649
 650 =item C<infix:Z(...)>
 651
 652 The zip operator.
 653
 654 =cut
 655
 656 .sub 'infix:Z'
 657     .param pmc args :slurpy
 658     .local int num_args
 659     num_args = elements args
 660
 661     # Empty list of no arguments.
 662     if num_args > 0 goto has_args
 663     $P0 = new 'CardinalArray'
 664     .return($P0)
 665 has_args:
 666
 667     # Get minimum element count - what we'll zip to.
 668     .local int min_elem
 669     .local int i
 670     i = 0
 671     $P0 = args[0]
 672     min_elem = elements $P0
 673 min_elems_loop:
 674     if i >= num_args goto min_elems_loop_end
 675     $P0 = args[i]
 676     $I0 = elements $P0
 677     unless $I0 < min_elem goto not_min
 678     min_elem = $I0
 679 not_min:
 680     inc i
 681     goto min_elems_loop
 682 min_elems_loop_end:
 683
 684     # Now build result list of lists.
 685     .local pmc res
 686     res = new 'CardinalArray'
 687     i = 0
 688 zip_loop:
 689     if i >= min_elem goto zip_loop_end
 690     .local pmc cur_list
 691     cur_list = new 'CardinalArray'
 692     .local int j
 693     j = 0
 694 zip_elem_loop:
 695     if j >= num_args goto zip_elem_loop_end
 696     $P0 = args[j]
 697     $P0 = $P0[i]
 698     cur_list[j] = $P0
 699     inc j
 700     goto zip_elem_loop
 701 zip_elem_loop_end:
 702     res[i] = cur_list
 703     inc i
 704     goto zip_loop
 705 zip_loop_end:
 706
 707     .return(res)
 708 .end
 709
 710
 711 =item C<infix:X(...)>
 712
 713 The non-hyper cross operator.
 714
 715 =cut
 716
 717 .sub 'infix:X'
 718     .param pmc args            :slurpy
 719     .local pmc res
 720     res = new 'CardinalArray'
 721
 722     # Algorithm: we'll maintain a list of counters for each list, incrementing
 723     # the counter for the right-most list and, when it we reach its final
 724     # element, roll over the counter to the next list to the left as we go.
 725     .local pmc counters
 726     .local pmc list_elements
 727     .local int num_args
 728     counters = new 'FixedIntegerCardinalArray'
 729     list_elements = new 'FixedIntegerCardinalArray'
 730     num_args = elements args
 731     counters = num_args
 732     list_elements = num_args
 733
 734     # Get element count for each list.
 735     .local int i
 736     .local pmc cur_list
 737     i = 0
 738 elem_get_loop:
 739     if i >= num_args goto elem_get_loop_end
 740     cur_list = args[i]
 741     $I0 = elements cur_list
 742     list_elements[i] = $I0
 743     inc i
 744     goto elem_get_loop
 745 elem_get_loop_end:
 746
 747     # Now we'll start to produce them.
 748     .local int res_count
 749     res_count = 0
 750 produce_next:
 751
 752     # Start out by building list at current counters.
 753     .local pmc new_list
 754     new_list = new 'CardinalArray'
 755     i = 0
 756 cur_perm_loop:
 757     if i >= num_args goto cur_perm_loop_end
 758     $I0 = counters[i]
 759     $P0 = args[i]
 760     $P1 = $P0[$I0]
 761     new_list[i] = $P1
 762     inc i
 763     goto cur_perm_loop
 764 cur_perm_loop_end:
 765     res[res_count] = new_list
 766     inc res_count
 767
 768     # Now increment counters.
 769     i = num_args - 1
 770 inc_counter_loop:
 771     $I0 = counters[i]
 772     $I1 = list_elements[i]
 773     inc $I0
 774     counters[i] = $I0
 775
 776     # In simple case, we just increment this and we're done.
 777     if $I0 < $I1 goto inc_counter_loop_end
 778
 779     # Otherwise we have to carry.
 780     counters[i] = 0
 781
 782     # If we're on the first element, all done.
 783     if i == 0 goto all_done
 784
 785     # Otherwise, loop.
 786     dec i
 787     goto inc_counter_loop
 788 inc_counter_loop_end:
 789     goto produce_next
 790
 791 all_done:
 792     .return(res)
 793 .end
 794
 795
 796 =item C<infix:min(...)>
 797
 798 The min operator.
 799
 800 =cut
 801
 802 .sub 'infix:min'
 803     .param pmc args :slurpy
 804
 805     # If we have no arguments, undefined.
 806     .local int elems
 807     elems = elements args
 808     if elems > 0 goto have_args
 809     $P0 = undef()
 810     .return($P0)
 811 have_args:
 812
 813     # Find minimum.
 814     .local pmc cur_min
 815     .local int i
 816     cur_min = args[0]
 817     i = 1
 818 find_min_loop:
 819     if i >= elems goto find_min_loop_end
 820     $P0 = args[i]
 821     $I0 = 'infix:cmp'($P0, cur_min)
 822     if $I0 != -1 goto not_min
 823     set cur_min, $P0
 824 not_min:
 825     inc i
 826     goto find_min_loop
 827 find_min_loop_end:
 828
 829     .return(cur_min)
 830 .end
 831
 832
 833 =item C<infix:max(...)>
 834
 835 The max operator.
 836
 837 =cut
 838
 839 .sub 'infix:max'
 840     .param pmc args :slurpy
 841
 842     # If we have no arguments, undefined.
 843     .local int elems
 844     elems = elements args
 845     if elems > 0 goto have_args
 846     $P0 = undef()
 847     .return($P0)
 848 have_args:
 849
 850     # Find maximum.
 851     .local pmc cur_max
 852     .local int i
 853     cur_max = args[0]
 854     i = 1
 855 find_max_loop:
 856     if i >= elems goto find_max_loop_end
 857     $P0 = args[i]
 858     $I0 = 'infix:cmp'($P0, cur_max)
 859     if $I0 != 1 goto not_max
 860     set cur_max, $P0
 861 not_max:
 862     inc i
 863     goto find_max_loop
 864 find_max_loop_end:
 865
 866     .return(cur_max)
 867 .end
 868
 869 =item C<reverse(LIST)>
 870
 871 Returns the elements of LIST in the opposite order.
 872
 873 =cut
 874
 875 .sub 'reverse'
 876     .param pmc list :slurpy
 877     .local string type
 878     .local pmc retv
 879     .local pmc elem
 880     .local int len
 881     .local int i
 882
 883     len = elements list
 884
 885     if len > 1 goto islist
 886
 887     # If we're not a list, check if we're a string.
 888     elem = list[0]
 889     typeof type, elem
 890
 891     # This is a bit of a work around - some operators (ie. ~) return
 892     # a String object instead of a CardinalString.
 893     eq type, 'String', parrotstring
 894     eq type, 'CardinalString', perl6string
 895     goto islist
 896
 897   parrotstring:
 898     .local string tmps
 899     tmps = elem
 900     elem = new 'CardinalString'
 901     elem = tmps
 902
 903   perl6string:
 904     retv = elem.'reverse'()
 905     goto done
 906
 907   islist:
 908     retv = new 'CardinalArray'
 909     i = 0
 910
 911   loop:
 912     if i == len goto done
 913     elem = list[i]
 914     retv.'unshift'(elem)
 915     inc i
 916     goto loop
 917
 918   done:
 919     .return(retv)
 920 .end
 921
 922 .sub keys :multi('CardinalArray')
 923   .param pmc list
 924
 925   .return list.'keys'()
 926 .end
 927
 928 .sub values :multi('CardinalArray')
 929   .param pmc list
 930
 931   .return list.'values'()
 932 .end
 933
 934 .sub delete :multi('CardinalArray')
 935   .param pmc list
 936   .param pmc indices :slurpy
 937
 938   .return list.'delete'(indices :flat)
 939 .end
 940
 941 .sub exists :multi('CardinalArray')
 942   .param pmc list
 943   .param pmc indices :slurpy
 944
 945   .return list.'exists'(indices :flat)
 946 .end
 947
 948 .sub kv :multi('CardinalArray')
 949     .param pmc list
 950
 951     .return list.'kv'()
 952 .end
 953
 954 .sub pairs :multi('CardinalArray')
 955     .param pmc list
 956
 957     .return list.'pairs'()
 958 .end
 959
 960 .sub grep :multi(_,'CardinalArray')
 961     .param pmc test
 962     .param pmc list :slurpy
 963
 964     .return list.'grep'(test)
 965 .end
 966
 967 .sub first :multi(_,'CardinalArray')
 968     .param pmc test
 969     .param pmc list :slurpy
 970
 971     .return list.'first'(test)
 972 .end
 973
 974 ## TODO: join map reduce sort zip
 975
 976 =back
 977
 978 =cut
 979
 980 # Local Variables:
 981 #   mode: pir
 982 #   fill-column: 100
 983 # End:
 984 # vim: expandtab shiftwidth=4 ft=pir: