src/pmc/array.pmc

   1 /*
   2 Copyright (C) 2001-2009, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc/array.pmc - Array PMC
   8
   9 =head1 DESCRIPTION
  10
  11 These are the vtable functions for the Array base class.
  12
  13 =head2 Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 /*
  22
  23 =item C<static PMC *undef(PARROT_INTERP)>
  24
  25 Returns a C<Undef> PMC.
  26
  27 =cut
  28
  29 */
  30
  31 static PMC *undef(PARROT_INTERP) {
  32     return pmc_new(interp, enum_class_Undef);
  33 }
  34
  35 /*
  36
  37 =item C<static PMC *retval(PARROT_INTERP, void *ret)>
  38
  39 Processes C<*ret>, returning the appropriate PMC, or raising an
  40 exception if necessary.
  41
  42 =cut
  43
  44 */
  45
  46 static PMC *retval(PARROT_INTERP, void *ret) {
  47     PMC *value;
  48
  49     if (ret == NULL)
  50         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
  51             "Array index out of bounds!");
  52
  53     /* XXX getting non existent value, exception or undef?
  54      * current is for perlarray */
  55     if (ret == (void *)-1)
  56         value = undef(interp);
  57     else {
  58         value = *(PMC **)ret;
  59
  60         /* XXX same here */
  61         if (!value)
  62             value = undef(interp);
  63     }
  64
  65     return value;
  66 }
  67
  68 /*
  69
  70 =item C<static PMC
  71 *Parrot_Array_set_pmc_ptr(PARROT_INTERP, List *list, INTVAL key)>
  72
  73 Returns a pointer to the element at index C<key> of C<*list>. If
  74 this element was previously empty, then this function also creates
  75 and assigns an "undef" PMC to that element.
  76
  77 =cut
  78
  79 */
  80
  81 static PMC *Parrot_Array_set_pmc_ptr(PARROT_INTERP, List *list, INTVAL key) {
  82     void * const ret = list_get(interp, list, key, enum_type_PMC);
  83     PMC  *value;
  84
  85     if (ret == NULL)
  86         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
  87             "Array index out of bounds!");
  88
  89     /* assign into a sparse or not yet set value */
  90     if (ret == (void *)-1 || *(PMC **)ret == NULL) {
  91         value = undef(interp);
  92         list_assign(interp, list, key, value, enum_type_PMC);
  93     }
  94     else
  95         value = *(PMC **)ret;
  96
  97     return value;
  98 }
  99
 100
 101 pmclass Array need_ext provides array {
 102
 103 /*
 104
 105 =back
 106
 107 =head2 Methods
 108
 109 =over 4
 110
 111 =item C<void class_init()>
 112
 113 Class initialization. Creates the required memory pools.
 114
 115 =cut
 116
 117 */
 118
 119     void class_init() {
 120
 121     }
 122
 123 /*
 124
 125 =item C<void init()>
 126
 127 Initializes the PMC by calling the underlying C<list_new()> function.
 128
 129 =cut
 130
 131 */
 132
 133     VTABLE void init() {
 134         list_pmc_new(INTERP, SELF);
 135         PObj_custom_mark_SET(SELF);
 136     }
 137
 138 /*
 139
 140 =item C<void init_pmc(PMC *init)>
 141
 142 C<*init> contains the initialization information specifying initial size,
 143 number of dimensions, etc.
 144
 145 =cut
 146
 147 */
 148
 149     VTABLE void init_pmc(PMC *init) {
 150         list_pmc_new_init(INTERP, SELF, init);
 151         PObj_custom_mark_SET(SELF);
 152     }
 153
 154 /*
 155
 156 =item C<void assign_pmc(PMC *other)>
 157
 158 Copy the contents of other to self.
 159
 160 =cut
 161
 162 */
 163
 164     VTABLE void assign_pmc(PMC *other) {
 165         const INTVAL size = VTABLE_elements(INTERP, other);
 166         INTVAL       i;
 167
 168         SELF.set_integer_native(size);
 169         for (i = 0; i < size; i++) {
 170             PMC * const elem = VTABLE_get_pmc_keyed_int(INTERP, other, i);
 171             SELF.set_pmc_keyed_int(i, elem);
 172         }
 173     }
 174
 175
 176 /*
 177
 178 =item C<void set_pmc(PMC *other)>
 179
 180 Implemented as an alias to C<assign_pmc> since the behavior is the same.
 181
 182 =cut
 183
 184 */
 185
 186     VTABLE void set_pmc(PMC *other) {
 187         SELF.assign_pmc(other);
 188     }
 189
 190 /*
 191
 192 =item C<void mark()>
 193
 194 Mark the array and its contents as live.
 195
 196 =cut
 197
 198 */
 199
 200     VTABLE void mark() {
 201         list_mark(INTERP, (List *)PMC_data(SELF));
 202     }
 203
 204 /*
 205
 206 =item C<PMC *clone()>
 207
 208 Return a clone of the array.
 209
 210 =cut
 211
 212 */
 213
 214     VTABLE PMC *clone() {
 215         List       *l    = list_clone(INTERP, (List *)PMC_data(SELF));
 216         PMC * const dest = pmc_new_noinit(INTERP, SELF->vtable->base_type);
 217
 218         PObj_custom_mark_SET(dest);
 219
 220         PMC_data(dest) = l;
 221         l->container   = dest;
 222
 223         return dest;
 224     }
 225
 226 /*
 227
 228 =item C<INTVAL get_integer()>
 229
 230 Returns the number of elements in the array.
 231
 232 =cut
 233
 234 */
 235
 236     VTABLE INTVAL get_integer() {
 237         return SELF.elements();
 238     }
 239
 240 /*
 241
 242 =item C<INTVAL get_bool()>
 243
 244 Returns true if the array has one or more elements.
 245
 246 =cut
 247
 248 */
 249
 250     VTABLE INTVAL get_bool() {
 251         const INTVAL size = SELF.elements();
 252         return (INTVAL)(size != 0);
 253     }
 254
 255 /*
 256
 257 =item C<INTVAL elements()>
 258
 259 Returns the number of elements in the array.
 260
 261 =cut
 262
 263 */
 264
 265     VTABLE INTVAL elements() {
 266         return ((const List *) PMC_data(SELF))->length;
 267     }
 268
 269 /*
 270
 271 =item C<FLOATVAL get_number()>
 272
 273 Returns the number of elements in the array.
 274
 275 =cut
 276
 277 */
 278
 279     VTABLE FLOATVAL get_number() {
 280         const INTVAL e = SELF.elements();
 281         return (FLOATVAL)e;
 282     }
 283
 284 /*
 285
 286 =item C<STRING *get_string()>
 287
 288 Returns a string representation of the array.
 289
 290 =cut
 291
 292 */
 293
 294     VTABLE STRING *get_string() {
 295         return Parrot_sprintf_c(INTERP, "array[%p]", SELF);
 296     }
 297
 298 /*
 299
 300 =item C<INTVAL get_integer_keyed_int(INTVAL key)>
 301
 302 Returns the integer value of the element at index C<key>.
 303
 304 =cut
 305
 306 */
 307
 308     VTABLE INTVAL get_integer_keyed_int(INTVAL key) {
 309         PMC * const value = SELF.get_pmc_keyed_int(key);
 310
 311         return VTABLE_get_integer(INTERP, value);
 312     }
 313
 314 /*
 315
 316 =item C<INTVAL get_integer_keyed(PMC *key)>
 317
 318 Returns the integer value of the element at index C<key>.
 319
 320 =cut
 321
 322 */
 323
 324     VTABLE INTVAL get_integer_keyed(PMC *key) {
 325         INTVAL ix;
 326         PMC   *nextkey, *box;
 327
 328         if (!key)
 329             return 0;
 330
 331         ix      = VTABLE_get_integer(INTERP, key);
 332         nextkey = key_next(INTERP, key);
 333
 334         if (!nextkey)
 335             return SELF.get_integer_keyed_int(ix);
 336
 337         box = SELF.get_pmc_keyed_int(ix);
 338
 339         if (!box)
 340             box = undef(INTERP);
 341
 342         return VTABLE_get_integer_keyed(INTERP, box, nextkey);
 343     }
 344
 345 /*
 346
 347 =item C<FLOATVAL get_number_keyed_int(INTVAL key)>
 348
 349 Returns the float value of the element at index C<key>.
 350
 351 =cut
 352
 353 */
 354
 355     VTABLE FLOATVAL get_number_keyed_int(INTVAL key) {
 356         PMC * const value = SELF.get_pmc_keyed_int(key);
 357
 358         return VTABLE_get_number(INTERP, value);
 359
 360     }
 361
 362 /*
 363
 364 =item C<FLOATVAL get_number_keyed(PMC *key)>
 365
 366 Returns the float value of the element at index C<key>.
 367
 368 =cut
 369
 370 */
 371
 372     VTABLE FLOATVAL get_number_keyed(PMC *key) {
 373         INTVAL ix;
 374         PMC *nextkey, *box;
 375
 376         if (!key)
 377             return (FLOATVAL)0;
 378
 379         ix      = VTABLE_get_integer(INTERP, key);
 380         nextkey = key_next(INTERP, key);
 381
 382         if (!nextkey)
 383             return SELF.get_number_keyed_int(ix);
 384
 385         box = SELF.get_pmc_keyed_int(ix);
 386
 387         if (!box)
 388             box = undef(INTERP);
 389
 390         return VTABLE_get_number_keyed(INTERP, box, nextkey);
 391     }
 392
 393 /*
 394
 395 =item C<STRING *get_string_keyed_int(INTVAL key)>
 396
 397 Returns the string value of the element at index C<key>.
 398
 399 =cut
 400
 401 */
 402
 403     VTABLE STRING *get_string_keyed_int(INTVAL key) {
 404         PMC * const value = SELF.get_pmc_keyed_int(key);
 405
 406         return VTABLE_get_string(INTERP, value);
 407     }
 408
 409 /*
 410
 411 =item C<STRING *get_string_keyed(PMC *key)>
 412
 413 Returns the string value of the element at index C<key>.
 414
 415 =cut
 416
 417 */
 418
 419     VTABLE STRING *get_string_keyed(PMC *key) {
 420         INTVAL ix;
 421         PMC   *nextkey, *box;
 422
 423         if (!key)
 424             return NULL;
 425
 426         ix      = VTABLE_get_integer(INTERP, key);
 427         nextkey = key_next(INTERP, key);
 428
 429         if (!nextkey)
 430             return SELF.get_string_keyed_int(ix);
 431
 432         box = SELF.get_pmc_keyed_int(ix);
 433
 434         if (!box)
 435             box = undef(INTERP);
 436
 437         return VTABLE_get_string_keyed(INTERP, box, nextkey);
 438     }
 439
 440 /*
 441
 442 =item C<PMC *get_pmc_keyed_int(INTVAL key)>
 443
 444 Returns the PMC value of the element at index C<key>.
 445
 446 =cut
 447
 448 */
 449
 450     VTABLE PMC *get_pmc_keyed_int(INTVAL key) {
 451
 452         return retval(INTERP,
 453             list_get(INTERP, (List *)PMC_data(SELF), key, enum_type_PMC));
 454     }
 455
 456 /*
 457
 458 =item C<PMC *get_pmc_keyed(PMC *key)>
 459
 460 Returns the PMC value of the element at index C<key>.
 461
 462 =cut
 463
 464 */
 465
 466     VTABLE PMC *get_pmc_keyed(PMC *key) {
 467         INTVAL ix;
 468         PMC   *nextkey, *box;
 469
 470         if (!key)
 471             return NULL;
 472
 473         ix      = VTABLE_get_integer(INTERP, key);
 474         nextkey = key_next(INTERP, key);
 475
 476         if (!nextkey)
 477             return SELF.get_pmc_keyed_int(ix);
 478
 479         box = SELF.get_pmc_keyed_int(ix);
 480
 481         if (!box)
 482             box = undef(INTERP);
 483
 484         return VTABLE_get_pmc_keyed(INTERP, box, nextkey);
 485     }
 486
 487 /*
 488
 489 =item C<void set_integer_native(INTVAL size)>
 490
 491 Sets the length of the array to C<size>.
 492
 493 =cut
 494
 495 */
 496
 497     VTABLE void set_integer_native(INTVAL size) {
 498         list_set_length(INTERP, (List *)PMC_data(SELF), size);
 499     }
 500 /*
 501
 502 =item C<void set_integer_same(PMC *value)>
 503
 504 Sets the length of the array to the number of elements in C<*value>.
 505
 506 =cut
 507
 508 */
 509
 510     VTABLE void set_integer_same(PMC *value) {
 511         const INTVAL size = VTABLE_elements(INTERP, value);
 512         list_set_length(INTERP, (List *)PMC_data(SELF), size);
 513     }
 514
 515 /*
 516
 517 =item C<void set_integer_keyed_int(INTVAL key, INTVAL value)>
 518
 519 Sets the integer value of the PMC at element C<key> to C<value>.
 520
 521 =cut
 522
 523 */
 524
 525     VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) {
 526         PMC * const ptr =
 527             Parrot_Array_set_pmc_ptr(INTERP, (List *)PMC_data(SELF), key);
 528
 529         VTABLE_set_integer_native(INTERP, ptr, value);
 530     }
 531
 532 /*
 533
 534 =item C<void set_integer_keyed(PMC *key, INTVAL value)>
 535
 536 Sets the integer value of the PMC at element C<key> to C<value>.
 537
 538 =cut
 539
 540 */
 541
 542     VTABLE void set_integer_keyed(PMC *key, INTVAL value) {
 543         INTVAL ix;
 544         PMC   *nextkey, *box;
 545
 546         if (!key)
 547             return;
 548
 549         ix      = VTABLE_get_integer(INTERP, key);
 550         nextkey = key_next(INTERP, key);
 551
 552         if (!nextkey) {
 553             SELF.set_integer_keyed_int(ix, value);
 554             return;
 555         }
 556
 557         box = SELF.get_pmc_keyed_int(ix);
 558
 559         /* autovivify an Array */
 560         if (!box)
 561             box = pmc_new(INTERP, SELF.type());
 562
 563         VTABLE_set_integer_keyed(INTERP, box, nextkey, value);
 564     }
 565
 566 /*
 567
 568 =item C<void set_number_keyed_int(INTVAL key, FLOATVAL value)>
 569
 570 Sets the numeric value of the PMC at element C<key> to C<value>.
 571
 572 =cut
 573
 574 */
 575
 576     VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) {
 577         PMC * const ptr =
 578             Parrot_Array_set_pmc_ptr(INTERP, (List *)PMC_data(SELF), key);
 579
 580         VTABLE_set_number_native(INTERP, ptr, value);
 581     }
 582
 583 /*
 584
 585 =item C<void set_number_keyed(PMC *key, FLOATVAL value)>
 586
 587 Sets the numeric value of the PMC at element C<key> to C<value>.
 588
 589 =cut
 590
 591 */
 592
 593     VTABLE void set_number_keyed(PMC *key, FLOATVAL value) {
 594         INTVAL ix;
 595         PMC   *nextkey, *box;
 596
 597         if (!key)
 598             return;
 599
 600         ix      = VTABLE_get_integer(INTERP, key);
 601         nextkey = key_next(INTERP, key);
 602
 603         if (!nextkey) {
 604             SELF.set_number_keyed_int(ix, value);
 605             return;
 606         }
 607
 608         box = SELF.get_pmc_keyed_int(ix);
 609
 610         /* autovivify an Array */
 611         if (!box)
 612             box = pmc_new(INTERP, SELF.type());
 613
 614         VTABLE_set_number_keyed(INTERP, box, nextkey, value);
 615     }
 616
 617 /*
 618
 619 =item C<void set_string_keyed_int(INTVAL key, STRING *value)>
 620
 621 Sets the string value of the PMC at element C<key> to C<value>.
 622
 623 =cut
 624
 625 */
 626
 627     VTABLE void set_string_keyed_int(INTVAL key, STRING *value) {
 628         PMC * const ptr =
 629             Parrot_Array_set_pmc_ptr(INTERP, (List *)PMC_data(SELF), key);
 630
 631         VTABLE_set_string_native(INTERP, ptr, value);
 632     }
 633
 634 /*
 635
 636 =item C<void set_string_keyed(PMC *key, STRING *value)>
 637
 638 Sets the string value of the PMC at element C<key> to C<value>.
 639
 640 =cut
 641
 642 */
 643
 644     VTABLE void set_string_keyed(PMC *key, STRING *value) {
 645         INTVAL ix;
 646         PMC   *nextkey, *box;
 647
 648         if (!key)
 649             return;
 650
 651         ix      = VTABLE_get_integer(INTERP, key);
 652         nextkey = key_next(INTERP, key);
 653
 654         if (!nextkey) {
 655             VTABLE_set_string_keyed_int(INTERP, SELF, ix, value);
 656             return;
 657         }
 658
 659         box = SELF.get_pmc_keyed_int(ix);
 660
 661         /* autovivify an Array */
 662         if (!box)
 663             box = pmc_new(INTERP, SELF.type());
 664
 665         VTABLE_set_string_keyed(INTERP, box, nextkey, value);
 666     }
 667
 668 /*
 669
 670 =item C<void set_pmc_keyed_int(INTVAL idx, PMC *src)>
 671
 672 Sets the PMC at element C<idx> to C<*src>.
 673
 674 =cut
 675
 676 */
 677
 678     VTABLE void set_pmc_keyed_int(INTVAL idx, PMC *src) {
 679         const INTVAL length = ((List *)PMC_data(SELF))->length;
 680
 681         if (idx >= length || -idx > length)
 682             Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
 683                 "Array index out of bounds!");
 684
 685         list_assign(INTERP, (List *)PMC_data(SELF), idx,
 686             (void *)src, enum_type_PMC);
 687     }
 688
 689 /*
 690
 691 =item C<void set_pmc_keyed(PMC *key, PMC *value)>
 692
 693 Sets the PMC at index C<key> to C<value>.
 694
 695 =cut
 696
 697 */
 698
 699     VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
 700         PMC *box;
 701
 702         const INTVAL ix      = VTABLE_get_integer(INTERP, key);
 703         PMC * const  nextkey = key_next(INTERP, key);
 704
 705         if (!nextkey) {
 706             VTABLE_set_pmc_keyed_int(INTERP, SELF, ix, value);
 707             return;
 708         }
 709
 710         box = SELF.get_pmc_keyed_int(ix);
 711
 712         /* autovivify an Array */
 713         if (!box)
 714             box = pmc_new(INTERP, SELF.type());
 715
 716         VTABLE_set_pmc_keyed(INTERP, box, nextkey, value);
 717     }
 718
 719 /*
 720
 721 =item C<void push_integer(INTVAL value)>
 722
 723 Extends the array by adding an element of value C<value> to the end of
 724 the array.
 725
 726 =cut
 727
 728 */
 729
 730     VTABLE void push_integer(INTVAL value) {
 731         const INTVAL nextix = SELF.elements();
 732         SELF.set_integer_keyed_int(nextix, value);
 733     }
 734
 735 /*
 736
 737 =item C<void push_float(FLOATVAL value)>
 738
 739 Extends the array by adding an element of value C<value> to the end of
 740 the array.
 741
 742 =cut
 743
 744 */
 745
 746     VTABLE void push_float(FLOATVAL value) {
 747         const INTVAL nextix = SELF.elements();
 748         SELF.set_number_keyed_int(nextix, value);
 749     }
 750
 751 /*
 752
 753 =item C<void push_string(STRING *value)>
 754
 755 Extends the array by adding an element of value C<*value> to the end of
 756 the array.
 757
 758 =cut
 759
 760 */
 761
 762     VTABLE void push_string(STRING *value) {
 763         const INTVAL nextix = SELF.elements();
 764         SELF.set_string_keyed_int(nextix, value);
 765     }
 766
 767 /*
 768
 769 =item C<void push_pmc(PMC *value)>
 770
 771 Extends the array by adding an element of value C<*value> to the end of
 772 the array.
 773
 774 =cut
 775
 776 */
 777
 778     VTABLE void push_pmc(PMC *value) {
 779         const INTVAL nextix = SELF.elements();
 780         SELF.set_pmc_keyed_int(nextix, value);
 781     }
 782
 783 /*
 784
 785 =item C<void unshift_integer(INTVAL value)>
 786
 787 Extends the array by adding an element of value C<value> to the start
 788 of the array.
 789
 790 =cut
 791
 792 */
 793
 794     VTABLE void unshift_integer(INTVAL value) {
 795         PMC * const val = undef(INTERP);
 796
 797         list_unshift(INTERP, (List *)PMC_data(SELF), val, enum_type_PMC);
 798         VTABLE_set_integer_native(INTERP, val, value);
 799     }
 800
 801 /*
 802
 803 =item C<void unshift_float(FLOATVAL value)>
 804
 805 Extends the array by adding an element of value C<value> to the start
 806 of the array.
 807
 808 =cut
 809
 810 */
 811
 812     VTABLE void unshift_float(FLOATVAL value) {
 813         PMC * const val = undef(INTERP);
 814
 815         list_unshift(INTERP, (List *)PMC_data(SELF), val, enum_type_PMC);
 816         VTABLE_set_number_native(INTERP, val, value);
 817     }
 818
 819 /*
 820
 821 =item C<void unshift_string(STRING *value)>
 822
 823 Extends the array by adding an element of value C<*value> to the start
 824 of the array.
 825
 826 =cut
 827
 828 */
 829
 830     VTABLE void unshift_string(STRING *value) {
 831         PMC * const val = undef(INTERP);
 832         list_unshift(INTERP, (List *)PMC_data(SELF), val, enum_type_PMC);
 833         VTABLE_set_string_native(INTERP, val, value);
 834     }
 835
 836 /*
 837
 838 =item C<void unshift_pmc(PMC *value)>
 839
 840 Extends the array by adding an element of value C<*value> to the start
 841 of the array.
 842
 843 =cut
 844
 845 */
 846
 847     VTABLE void unshift_pmc(PMC *value) {
 848         list_unshift(INTERP, (List *)PMC_data(SELF), value, enum_type_PMC);
 849     }
 850
 851 /*
 852
 853 =item C<INTVAL pop_integer()>
 854
 855 Removes and returns an integer from the end of the array.
 856
 857 =cut
 858
 859 */
 860
 861     VTABLE INTVAL pop_integer() {
 862         PMC * const ptr = SELF.pop_pmc();
 863         return VTABLE_get_integer(INTERP, ptr);
 864     }
 865
 866 /*
 867
 868 =item C<FLOATVAL pop_float()>
 869
 870 Removes and returns a float value from the end of the array.
 871
 872 =cut
 873
 874 */
 875
 876     VTABLE FLOATVAL pop_float() {
 877         PMC * const ptr = SELF.pop_pmc();
 878         return VTABLE_get_number(INTERP, ptr);
 879     }
 880
 881 /*
 882
 883 =item C<STRING *pop_string()>
 884
 885 Removes and returns a string from the end of the array.
 886
 887 =cut
 888
 889 */
 890
 891     VTABLE STRING *pop_string() {
 892         PMC * const ptr = SELF.pop_pmc();
 893         return VTABLE_get_string(INTERP, ptr);
 894     }
 895
 896 /*
 897
 898 =item C<PMC *pop_pmc()>
 899
 900 Removes and returns a PMC from the end of the array.
 901
 902 =cut
 903
 904 */
 905
 906     VTABLE PMC *pop_pmc() {
 907         return retval(INTERP,
 908             list_pop(INTERP, (List *)PMC_data(SELF), enum_type_PMC));
 909     }
 910
 911 /*
 912
 913 =item C<INTVAL shift_integer()>
 914
 915 Removes and returns an integer from the start of the array.
 916
 917 =cut
 918
 919 */
 920
 921     VTABLE INTVAL shift_integer() {
 922         PMC * const ptr = SELF.shift_pmc();
 923         return VTABLE_get_integer(INTERP, ptr);
 924     }
 925
 926 /*
 927
 928 =item C<FLOATVAL shift_float()>
 929
 930 Removes and returns a float from the start of the array.
 931
 932 =cut
 933
 934 */
 935
 936     VTABLE FLOATVAL shift_float() {
 937         PMC * const ptr = SELF.shift_pmc();
 938         return VTABLE_get_number(INTERP, ptr);
 939     }
 940
 941 /*
 942
 943 =item C<STRING *shift_string()>
 944
 945 Removes and returns a string from the start of the array.
 946
 947 =cut
 948
 949 */
 950
 951     VTABLE STRING *shift_string() {
 952         PMC * const ptr = SELF.shift_pmc();
 953         return VTABLE_get_string(INTERP, ptr);
 954     }
 955
 956 /*
 957
 958 =item C<PMC *shift_pmc()>
 959
 960 Removes and returns a PMC from the start of the array.
 961
 962 =cut
 963
 964 */
 965
 966     VTABLE PMC *shift_pmc() {
 967         return retval(INTERP,
 968             list_shift(INTERP, (List *)PMC_data(SELF), enum_type_PMC));
 969     }
 970
 971 /*
 972
 973 =item C<void splice(PMC *value, INTVAL offset, INTVAL count)>
 974
 975 Replaces C<count> elements starting at C<offset> with the elements in
 976 C<value>.
 977
 978 If C<count> is 0 then the elements in C<value> will be inserted after
 979 C<offset>.
 980
 981 =cut
 982
 983 */
 984
 985     VTABLE void splice(PMC *value, INTVAL offset, INTVAL count) {
 986         if (SELF->vtable->base_type != value->vtable->base_type)
 987             Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
 988                 "Type mismatch in splice");
 989
 990         list_splice(INTERP, (List *)PMC_data(SELF),
 991             (List *)PMC_data(value), offset, count);
 992     }
 993
 994 /*
 995
 996 =item C<INTVAL defined_keyed_int(INTVAL key)>
 997
 998 Returns TRUE is the element at C<key> is defined; otherwise returns false.
 999
1000 =cut
1001
1002 */
1003
1004     VTABLE INTVAL defined_keyed_int(INTVAL key) {
1005         PMC  *value;
1006         void * const ret =
1007             list_get(INTERP, (List *)PMC_data(pmc), key, enum_type_PMC);
1008
1009         if (ret == NULL || ret == (void *) -1)
1010             return 0;
1011
1012         value = *(PMC **)ret;
1013
1014         if (!value)
1015             return 0;
1016
1017         return VTABLE_defined(INTERP, value);
1018     }
1019
1020 /*
1021
1022 =item C<INTVAL defined_keyed(PMC *key)>
1023
1024 Returns TRUE is the element at C<key> is defined; otherwise returns false.
1025
1026 =cut
1027
1028 */
1029
1030     VTABLE INTVAL defined_keyed(PMC *key) {
1031         PMC *box;
1032
1033         const INTVAL ix      = VTABLE_get_integer(INTERP, key);
1034         PMC * const  nextkey = key_next(INTERP, key);
1035
1036         if (!nextkey)
1037             return SELF.defined_keyed_int(ix);
1038
1039         box = SELF.get_pmc_keyed_int(ix);
1040
1041         if (!box)
1042             return 0;
1043
1044         return VTABLE_defined_keyed(INTERP, box, nextkey);
1045     }
1046
1047 /*
1048
1049 =item C<INTVAL exists_keyed_int(INTVAL key)>
1050
1051 Returns TRUE is the element at C<key> exists; otherwise returns false.
1052
1053 =cut
1054
1055 */
1056
1057     VTABLE INTVAL exists_keyed_int(INTVAL key) {
1058         void * ret = list_get(INTERP,
1059             (List *)PMC_data(pmc), key, enum_type_PMC);
1060
1061         if (ret == NULL || ret == (void *)-1)
1062             return 0;
1063
1064         return !PMC_IS_NULL(*(PMC **)ret);
1065     }
1066
1067 /*
1068
1069 =item C<INTVAL exists_keyed(PMC *key)>
1070
1071 Returns TRUE is the element at C<key> exists; otherwise returns false.
1072
1073 =cut
1074
1075 */
1076
1077     VTABLE INTVAL exists_keyed(PMC *key) {
1078         PMC *box;
1079
1080         const INTVAL ix      = VTABLE_get_integer(INTERP, key);
1081         PMC * const  nextkey = key_next(INTERP, key);
1082
1083         if (!nextkey)
1084             return SELF.exists_keyed_int(ix);
1085
1086         box = SELF.get_pmc_keyed_int(ix);
1087
1088         if (!box)
1089             return 0;
1090
1091         return VTABLE_exists_keyed(INTERP, box, nextkey);
1092     }
1093
1094 /*
1095
1096 =item C<void delete_keyed_int(INTVAL key)>
1097
1098 Removes the element at C<key>.
1099
1100 =cut
1101
1102 */
1103
1104     VTABLE void delete_keyed_int(INTVAL key) {
1105         list_splice(INTERP, (List *)PMC_data(pmc), NULL, key, 1);
1106     }
1107
1108 /*
1109
1110 =item C<void delete_keyed(PMC *key)>
1111
1112 Removes the element at C<*key>.
1113
1114 =cut
1115
1116 */
1117
1118     VTABLE void delete_keyed(PMC *key) {
1119         const INTVAL ix = VTABLE_get_integer(INTERP, key);
1120         list_splice(INTERP, (List *)PMC_data(pmc), NULL, ix, 1);
1121     }
1122
1123 /*
1124
1125 =item C<INTVAL is_equal(PMC *value)>
1126
1127 The C<==> operation. Compares two array to hold equal elements.
1128
1129 =cut
1130
1131 */
1132
1133     VTABLE INTVAL is_equal(PMC *value) {
1134         INTVAL j, n;
1135
1136         if (value->vtable->base_type != enum_class_Array)
1137             return 0;
1138
1139         n = SELF.elements();
1140
1141         if (VTABLE_elements(INTERP, value) != n)
1142             return 0;
1143
1144         for (j = 0; j < n; ++j) {
1145             PMC * const item1 = SELF.get_pmc_keyed_int(j);
1146             PMC * const item2 = VTABLE_get_pmc_keyed_int(INTERP, value, j);
1147
1148             if (item1 != item2) {
1149                 const INTVAL result = VTABLE_is_equal(INTERP, item1, item2);
1150                 if (!result)
1151                     return 0;
1152             }
1153         }
1154
1155         return 1;
1156     }
1157
1158 /*
1159
1160 =item C<PMC *slice(PMC *key, INTVAL f)>
1161
1162 Return a new iterator for the slice PMC C<key> if f == 0.
1163
1164 Return a new pythonic array slice if f == 1.
1165
1166 =item C<PMC *get_iter()>
1167
1168 Return a new iterator for SELF.
1169
1170 =cut
1171
1172 */
1173
1174     VTABLE PMC *slice(PMC *key, INTVAL f) {
1175         if (f == 0) {
1176             STRING * const name = CONST_STRING(interp, "set_key");
1177             PMC * const iter = pmc_new_init(INTERP, enum_class_Iterator, SELF);
1178             Parrot_PCCINVOKE(interp, iter, name, "P->", key);
1179             return iter;
1180         }
1181
1182         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
1183                 "Array: Unknown slice type");
1184     }
1185
1186     VTABLE PMC *get_iter() {
1187         return pmc_new_init(INTERP, enum_class_ArrayIterator, SELF);
1188     }
1189
1190 /*
1191
1192 =item C<void visit(visit_info *info)>
1193
1194 This is used by freeze/thaw to visit the contents of the array.
1195
1196 C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
1197
1198 =cut
1199
1200 */
1201
1202     VTABLE void visit(visit_info *info) {
1203         list_visit(INTERP, (List *)PMC_data(SELF), info);
1204         SUPER(info);
1205     }
1206
1207 /*
1208
1209 =item C<void freeze(visit_info *info)>
1210
1211 Used to archive the array.
1212
1213 =cut
1214
1215 */
1216
1217     VTABLE void freeze(visit_info *info) {
1218         IMAGE_IO * const io = info->image_io;
1219         SUPER(info);
1220         VTABLE_push_integer(INTERP, io, VTABLE_elements(INTERP, SELF));
1221     }
1222
1223 /*
1224
1225 =item C<void thaw(visit_info *info)>
1226
1227 Used to unarchive the array.
1228
1229 =cut
1230
1231 */
1232
1233     VTABLE void thaw(visit_info *info) {
1234         IMAGE_IO * const io = info->image_io;
1235
1236         SUPER(info);
1237         if (info->extra_flags == EXTRA_IS_NULL) {
1238             SELF.set_integer_native(VTABLE_shift_integer(INTERP, io));
1239     }
1240 }
1241
1242 /*
1243
1244 =item C<PMC *share_ro()>
1245
1246 Recursively make the array read-only and shared.
1247
1248 =cut
1249
1250 */
1251     VTABLE PMC *share_ro() {
1252         PMC *_true, *ret;
1253
1254         /* prevent infinite recursion */
1255         if (PObj_is_PMC_shared_TEST(SELF))
1256             Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
1257                     "share_ro on something that already is shared");
1258
1259         _true = pmc_new(INTERP, enum_class_Integer);
1260         VTABLE_set_integer_native(INTERP, _true, 1);
1261
1262         ret   = pt_shared_fixup(INTERP, SELF);
1263
1264         /* first set readonly */
1265         VTABLE_setprop(INTERP, ret, CONST_STRING(INTERP, "_ro"), _true);
1266
1267         /* XXX do something that deals better with sparse lists */
1268         {
1269             INTVAL i;
1270             const INTVAL max = VTABLE_elements(INTERP, ret);
1271
1272             for (i = 0; i < max; ++i) {
1273                 PMC * const value =
1274                     (PMC *)list_get(INTERP, PMC_data_typed(ret, List *),
1275                                  i, enum_type_PMC);
1276
1277                 if (!PMC_IS_NULL(value)) {
1278                     /* XXX do we need to clone first? */
1279                     PMC * const new_value = VTABLE_share_ro(INTERP, value);
1280
1281                     if (new_value != value)
1282                         list_assign(INTERP, PMC_data_typed(ret, List *),
1283                             i, new_value, enum_type_PMC);
1284                 }
1285             }
1286         }
1287
1288         /* XXX FIXME workaround lack of metadata sharing */
1289         PMC_metadata(SELF) = NULL;
1290
1291         return ret;
1292     }
1293 }
1294
1295 /*
1296
1297 =back
1298
1299 =head1 SEE ALSO
1300
1301 F<src/list.c>, F<include/parrot/list.h>
1302
1303 =head1 TODO
1304
1305 Create global immutable undef object.
1306
1307 =cut
1308
1309 */
1310
1311 /*
1312  * Local variables:
1313  *   c-file-style: "parrot"
1314  * End:
1315  * vim: expandtab shiftwidth=4:
1316  */