src/key.c

   1 /*
   2 Copyright (C) 2001-2010, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/key.c - Base vtable calling functions
   8
   9 =head1 DESCRIPTION
  10
  11 The base vtable calling functions.
  12
  13 =head2 Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/parrot.h"
  22 #include "parrot/key.h"
  23 #include "key.str"
  24 #include "pmc/pmc_key.h"
  25 #include "pmc/pmc_callcontext.h"
  26
  27 /* HEADERIZER HFILE: include/parrot/key.h */
  28
  29 /*
  30
  31 =item C<PMC * key_new(PARROT_INTERP)>
  32
  33 Returns a new C<Key> PMC.
  34
  35 =cut
  36
  37 */
  38
  39 PARROT_EXPORT
  40 PARROT_CANNOT_RETURN_NULL
  41 PARROT_WARN_UNUSED_RESULT
  42 PMC *
  43 key_new(PARROT_INTERP)
  44 {
  45     ASSERT_ARGS(key_new)
  46     return Parrot_pmc_new(interp, enum_class_Key);
  47 }
  48
  49
  50 /*
  51
  52 =item C<PMC * key_new_integer(PARROT_INTERP, INTVAL value)>
  53
  54 Returns a new integer C<Key> PMC with value C<value>.
  55
  56 =cut
  57
  58 */
  59
  60 PARROT_EXPORT
  61 PARROT_CANNOT_RETURN_NULL
  62 PARROT_WARN_UNUSED_RESULT
  63 PMC *
  64 key_new_integer(PARROT_INTERP, INTVAL value)
  65 {
  66     ASSERT_ARGS(key_new_integer)
  67     PMC * const key = Parrot_pmc_new(interp, enum_class_Key);
  68
  69     PObj_get_FLAGS(key) |= KEY_integer_FLAG;
  70     SETATTR_Key_int_key(interp, key, value);
  71
  72     return key;
  73 }
  74
  75
  76 /*
  77
  78 =item C<PMC * key_new_number(PARROT_INTERP, FLOATVAL value)>
  79
  80 Returns a new number C<Key> PMC with value C<value>.
  81
  82 =cut
  83
  84 */
  85
  86 PARROT_EXPORT
  87 PARROT_CANNOT_RETURN_NULL
  88 PARROT_WARN_UNUSED_RESULT
  89 PMC *
  90 key_new_number(PARROT_INTERP, FLOATVAL value)
  91 {
  92     ASSERT_ARGS(key_new_number)
  93     PMC * const key = Parrot_pmc_new(interp, enum_class_Key);
  94
  95     PObj_get_FLAGS(key) |= KEY_number_FLAG;
  96     SETATTR_Key_num_key(interp, key, value);
  97
  98     return key;
  99 }
 100
 101
 102 /*
 103
 104 =item C<PMC * key_new_string(PARROT_INTERP, STRING *value)>
 105
 106 Returns a new string C<Key> PMC with value C<value>.
 107
 108 =cut
 109
 110 */
 111
 112 PARROT_EXPORT
 113 PARROT_CANNOT_RETURN_NULL
 114 PARROT_WARN_UNUSED_RESULT
 115 PMC *
 116 key_new_string(PARROT_INTERP, ARGIN(STRING *value))
 117 {
 118     ASSERT_ARGS(key_new_string)
 119     PMC * const key = Parrot_pmc_new(interp, enum_class_Key);
 120
 121     PObj_get_FLAGS(key) |= KEY_string_FLAG;
 122     SETATTR_Key_str_key(interp, key, value);
 123
 124     return key;
 125 }
 126
 127
 128 /*
 129
 130 =item C<PMC * key_new_cstring(PARROT_INTERP, const char *value)>
 131
 132 Returns a new string C<Key> PMC with value C<value> converted to a
 133 C<STRING>.
 134
 135 =cut
 136
 137 */
 138
 139 PARROT_EXPORT
 140 PARROT_CANNOT_RETURN_NULL
 141 PARROT_WARN_UNUSED_RESULT
 142 PMC *
 143 key_new_cstring(PARROT_INTERP, ARGIN_NULLOK(const char *value))
 144 {
 145     ASSERT_ARGS(key_new_cstring)
 146     return key_new_string(interp, Parrot_str_new(interp, value, 0));
 147 }
 148
 149
 150 /*
 151
 152 =item C<PMC * key_new_pmc(PARROT_INTERP, PMC *value)>
 153
 154 Returns a new PMC C<Key> PMC with value C<value>.
 155
 156 =cut
 157
 158 */
 159
 160 PARROT_EXPORT
 161 PARROT_CANNOT_RETURN_NULL
 162 PARROT_WARN_UNUSED_RESULT
 163 PMC *
 164 key_new_pmc(PARROT_INTERP, ARGIN(PMC *value))
 165 {
 166     ASSERT_ARGS(key_new_pmc)
 167     PMC * const key = Parrot_pmc_new(interp, enum_class_Key);
 168
 169     PObj_get_FLAGS(key) |= KEY_pmc_FLAG;
 170     Parrot_ex_throw_from_c_args(interp, NULL, 1, "this is broken - see slice.pmc");
 171 }
 172
 173
 174 /*
 175
 176 =item C<void key_set_integer(PARROT_INTERP, PMC *key, INTVAL value)>
 177
 178 Set the integer C<value> in C<key>.
 179
 180 =cut
 181
 182 */
 183
 184 PARROT_EXPORT
 185 void
 186 key_set_integer(PARROT_INTERP, ARGMOD(PMC *key), INTVAL value)
 187 {
 188     ASSERT_ARGS(key_set_integer)
 189     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 190     PObj_get_FLAGS(key) |=  KEY_integer_FLAG;
 191     SETATTR_Key_int_key(interp, key, value);
 192
 193     return;
 194 }
 195
 196
 197 /*
 198
 199 =item C<void key_set_register(PARROT_INTERP, PMC *key, INTVAL value, INTVAL
 200 flag)>
 201
 202 Set the register C<value> in C<key>.
 203
 204 =cut
 205
 206 */
 207
 208 PARROT_EXPORT
 209 void
 210 key_set_register(PARROT_INTERP, ARGMOD(PMC *key), INTVAL value, INTVAL flag)
 211 {
 212     ASSERT_ARGS(key_set_register)
 213     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 214     PObj_get_FLAGS(key) |=  KEY_register_FLAG | flag;
 215     SETATTR_Key_int_key(interp, key, value);
 216
 217     return;
 218 }
 219
 220
 221 /*
 222
 223 =item C<void key_set_number(PARROT_INTERP, PMC *key, FLOATVAL value)>
 224
 225 Set the number C<value> in C<key>.
 226
 227 =cut
 228
 229 */
 230
 231 PARROT_EXPORT
 232 void
 233 key_set_number(PARROT_INTERP, ARGMOD(PMC *key), FLOATVAL value)
 234 {
 235     ASSERT_ARGS(key_set_number)
 236     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 237     PObj_get_FLAGS(key) |=  KEY_number_FLAG;
 238     SETATTR_Key_num_key(interp, key, value);
 239
 240     return;
 241 }
 242
 243
 244 /*
 245
 246 =item C<void key_set_string(PARROT_INTERP, PMC *key, STRING *value)>
 247
 248 Set the string C<value> in C<key>.
 249
 250 =cut
 251
 252 */
 253
 254 PARROT_EXPORT
 255 void
 256 key_set_string(PARROT_INTERP, ARGMOD(PMC *key), ARGIN(STRING *value))
 257 {
 258     ASSERT_ARGS(key_set_string)
 259     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 260     PObj_get_FLAGS(key) |=  KEY_string_FLAG;
 261     SETATTR_Key_str_key(interp, key, value);
 262
 263     return;
 264 }
 265
 266
 267 /*
 268
 269 =item C<void key_set_pmc(PARROT_INTERP, PMC *key, PMC *value)>
 270
 271 Set the PMC C<value> in C<key>.
 272
 273 =cut
 274
 275 */
 276
 277 PARROT_EXPORT
 278 void
 279 key_set_pmc(PARROT_INTERP, ARGMOD(PMC *key), ARGIN(PMC *value))
 280 {
 281     ASSERT_ARGS(key_set_pmc)
 282     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 283     PObj_get_FLAGS(key) |=  KEY_pmc_FLAG;
 284
 285     /*
 286      * XXX leo
 287      * what for is this indirection?
 288      */
 289     Parrot_ex_throw_from_c_args(interp, NULL, 1, "this is broken - see slice.pmc");
 290 }
 291
 292
 293 /*
 294
 295 =item C<INTVAL key_type(PARROT_INTERP, const PMC *key)>
 296
 297 Returns the type of C<key>.
 298
 299 =cut
 300
 301 */
 302
 303 PARROT_EXPORT
 304 PARROT_PURE_FUNCTION
 305 PARROT_WARN_UNUSED_RESULT
 306 INTVAL
 307 key_type(SHIM_INTERP, ARGIN(const PMC *key))
 308 {
 309     ASSERT_ARGS(key_type)
 310     return (PObj_get_FLAGS(key) & KEY_type_FLAGS) & ~KEY_register_FLAG;
 311 }
 312
 313
 314 /*
 315
 316 =item C<INTVAL key_integer(PARROT_INTERP, PMC *key)>
 317
 318 Translates a key value into an integer.
 319 Takes an interpreter name and pointer to a key.
 320 Returns an integer value corresponding to the key.
 321
 322 =cut
 323
 324 */
 325
 326 PARROT_EXPORT
 327 PARROT_WARN_UNUSED_RESULT
 328 INTVAL
 329 key_integer(PARROT_INTERP, ARGIN(PMC *key))
 330 {
 331     ASSERT_ARGS(key_integer)
 332     INTVAL   int_key;
 333     STRING  *str_key;
 334     FLOATVAL num_key;
 335
 336     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 337       case KEY_integer_FLAG:
 338         GETATTR_Key_int_key(interp, key, int_key);
 339         return int_key;
 340       case KEY_integer_FLAG | KEY_register_FLAG:
 341         GETATTR_Key_int_key(interp, key, int_key);
 342         return REG_INT(interp, int_key);
 343
 344       case KEY_number_FLAG:
 345         GETATTR_Key_num_key(interp, key, num_key);
 346         return (INTVAL)num_key;
 347       case KEY_number_FLAG | KEY_register_FLAG:
 348         GETATTR_Key_int_key(interp, key, int_key);
 349         return (INTVAL)REG_NUM(interp, int_key);
 350
 351       case KEY_pmc_FLAG | KEY_register_FLAG:
 352         {
 353             PMC *reg;
 354             GETATTR_Key_int_key(interp, key, int_key);
 355             reg = REG_PMC(interp, int_key);
 356             return VTABLE_get_integer(interp, reg);
 357         }
 358
 359       case KEY_string_FLAG:
 360         GETATTR_Key_str_key(interp, key, str_key);
 361         return Parrot_str_to_int(interp, str_key);
 362       case KEY_string_FLAG | KEY_register_FLAG:
 363         {
 364             STRING *s_reg;
 365             GETATTR_Key_int_key(interp, key, int_key);
 366             s_reg = REG_STR(interp, int_key);
 367             return Parrot_str_to_int(interp, s_reg);
 368         }
 369
 370       default:
 371             break;
 372     }
 373
 374     return VTABLE_get_integer(interp, key);
 375 }
 376
 377
 378 /*
 379
 380 =item C<FLOATVAL key_number(PARROT_INTERP, PMC *key)>
 381
 382 Translates a key value into a number.
 383 Takes an interpreter name and pointer to a key.
 384 Returns a number value corresponding to the key.
 385 Throws an exception if the key is not a valid number.
 386
 387 =cut
 388
 389 */
 390
 391 PARROT_EXPORT
 392 PARROT_WARN_UNUSED_RESULT
 393 FLOATVAL
 394 key_number(PARROT_INTERP, ARGIN(PMC *key))
 395 {
 396     ASSERT_ARGS(key_number)
 397     INTVAL   int_key;
 398     FLOATVAL num_key;
 399
 400     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 401       case KEY_number_FLAG:
 402         GETATTR_Key_num_key(interp, key, num_key);
 403         return num_key;
 404       case KEY_number_FLAG | KEY_register_FLAG:
 405         GETATTR_Key_int_key(interp, key, int_key);
 406         return REG_NUM(interp, int_key);
 407       case KEY_pmc_FLAG:
 408         return VTABLE_get_number(interp, key);
 409       case KEY_pmc_FLAG | KEY_register_FLAG:
 410         {
 411             PMC *reg;
 412             GETATTR_Key_int_key(interp, key, int_key);
 413             reg = REG_PMC(interp, int_key);
 414             return VTABLE_get_number(interp, reg);
 415         }
 416       default:
 417         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
 418             "Key not a number!\n");
 419     }
 420 }
 421
 422
 423 /*
 424
 425 =item C<STRING * key_string(PARROT_INTERP, PMC *key)>
 426
 427 Translates a key value into a string.  Takes an interpreter name and pointer to
 428 a key.  Returns a string value corresponding to the key.
 429
 430 =cut
 431
 432 */
 433
 434 PARROT_WARN_UNUSED_RESULT
 435 PARROT_CAN_RETURN_NULL
 436 STRING *
 437 key_string(PARROT_INTERP, ARGIN(PMC *key))
 438 {
 439     ASSERT_ARGS(key_string)
 440
 441     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 442         /* remember to COW strings instead of returning them directly */
 443       case KEY_string_FLAG:
 444         {
 445             STRING *s;
 446             GETATTR_Key_str_key(interp, key, s);
 447             return s;
 448         }
 449       case KEY_string_FLAG | KEY_register_FLAG:
 450         {
 451             INTVAL int_key;
 452             GETATTR_Key_int_key(interp, key, int_key);
 453             return REG_STR(interp, int_key);
 454         }
 455       case KEY_pmc_FLAG | KEY_register_FLAG:
 456         {
 457             INTVAL int_key;
 458             PMC *reg;
 459             GETATTR_Key_int_key(interp, key, int_key);
 460             reg = REG_PMC(interp, int_key);
 461             return VTABLE_get_string(interp, reg);
 462         }
 463       case KEY_integer_FLAG:
 464         {
 465             INTVAL int_key;
 466             GETATTR_Key_int_key(interp, key, int_key);
 467             return Parrot_str_from_int(interp, int_key);
 468         }
 469       case KEY_integer_FLAG | KEY_register_FLAG:
 470         {
 471             INTVAL int_key;
 472             GETATTR_Key_int_key(interp, key, int_key);
 473             return Parrot_str_from_int(interp, REG_INT(interp, int_key));
 474         }
 475       case KEY_number_FLAG:
 476         {
 477             FLOATVAL num_key;
 478             GETATTR_Key_num_key(interp, key, num_key);
 479             return Parrot_str_from_num(interp, num_key);
 480         }
 481       case KEY_number_FLAG | KEY_register_FLAG:
 482         {
 483             INTVAL int_key;
 484             GETATTR_Key_int_key(interp, key, int_key);
 485             return Parrot_str_from_num(interp, REG_NUM(interp, int_key));
 486         }
 487       default:
 488       case KEY_pmc_FLAG:
 489         return VTABLE_get_string(interp, key);
 490     }
 491 }
 492
 493
 494 /*
 495
 496 =item C<PMC * key_pmc(PARROT_INTERP, PMC *key)>
 497
 498 These functions return the integer/number/string/PMC values of C<key> if
 499 possible. Otherwise they throw exceptions.
 500
 501 =cut
 502
 503 */
 504
 505 PARROT_EXPORT
 506 PARROT_CANNOT_RETURN_NULL
 507 PARROT_WARN_UNUSED_RESULT
 508 PMC *
 509 key_pmc(PARROT_INTERP, ARGIN(PMC *key))
 510 {
 511     ASSERT_ARGS(key_pmc)
 512     INTVAL int_key;
 513
 514     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 515       case KEY_pmc_FLAG | KEY_register_FLAG:
 516         GETATTR_Key_int_key(interp, key, int_key);
 517         return REG_PMC(interp, int_key);
 518       default:
 519         return key;
 520     }
 521 }
 522
 523
 524 /*
 525
 526 =item C<PMC * key_next(PARROT_INTERP, PMC *key)>
 527
 528 Returns the next key if C<key> is in a sequence of linked keys.
 529
 530 =cut
 531
 532 */
 533
 534 PARROT_EXPORT
 535 PARROT_CAN_RETURN_NULL
 536 PARROT_WARN_UNUSED_RESULT
 537 PMC *
 538 key_next(PARROT_INTERP, ARGIN(PMC *key))
 539 {
 540     ASSERT_ARGS(key_next)
 541
 542     if (VTABLE_isa(interp, key, CONST_STRING(interp, "Key"))) {
 543         PMC *next_key;
 544         GETATTR_Key_next_key(interp, key, next_key);
 545         return next_key;
 546     }
 547
 548     return NULL;
 549 }
 550
 551
 552 /*
 553
 554 =item C<PMC * key_append(PARROT_INTERP, PMC *key1, PMC *key2)>
 555
 556 Appends C<key2> to C<key1>.
 557
 558 Note that if C<key1> is not the last key in a sequence of linked keys then the
 559 last key will be found and C<key2> appended to that.
 560
 561 Returns C<key1>.
 562
 563 =cut
 564
 565 */
 566
 567 PARROT_EXPORT
 568 PARROT_CANNOT_RETURN_NULL
 569 PARROT_IGNORABLE_RESULT
 570 PMC *
 571 key_append(PARROT_INTERP, ARGMOD(PMC *key1), ARGIN(PMC *key2))
 572 {
 573     ASSERT_ARGS(key_append)
 574     PMC *tail = key1;
 575     PMC *tail_next;
 576
 577     GETATTR_Key_next_key(interp, tail, tail_next);
 578
 579     while (tail_next) {
 580         tail = tail_next;
 581         GETATTR_Key_next_key(interp, tail, tail_next);
 582     }
 583
 584     SETATTR_Key_next_key(interp, tail, key2);
 585
 586     return key1;
 587 }
 588
 589
 590 /*
 591
 592 =item C<void key_mark(PARROT_INTERP, PMC *key)>
 593
 594 Marks C<key> as live.
 595
 596 =cut
 597
 598 */
 599
 600 PARROT_EXPORT
 601 void
 602 key_mark(PARROT_INTERP, ARGIN(PMC *key))
 603 {
 604     ASSERT_ARGS(key_mark)
 605     PMC          *next_key;
 606     const UINTVAL flags = PObj_get_FLAGS(key) & KEY_type_FLAGS;
 607
 608     if (flags == KEY_string_FLAG) {
 609         STRING *str_key;
 610         GETATTR_Key_str_key(interp, key, str_key);
 611         Parrot_gc_mark_STRING_alive(interp, str_key);
 612     }
 613
 614     /* Mark next key */
 615     if ((flags == KEY_string_FLAG) || (flags == KEY_pmc_FLAG)) {
 616         GETATTR_Key_next_key(interp, key, next_key);
 617         Parrot_gc_mark_PMC_alive(interp, next_key);
 618     }
 619
 620 }
 621
 622
 623 /*
 624
 625 =item C<STRING * key_set_to_string(PARROT_INTERP, PMC *key)>
 626
 627 Translates a series of key values into strings, quoted or bracketed if
 628 appropriate.  Takes an interpreter name and pointer to a key.  Returns a
 629 string value corresponding to the key.
 630
 631 =cut
 632
 633 */
 634
 635 PARROT_EXPORT
 636 PARROT_CANNOT_RETURN_NULL
 637 PARROT_WARN_UNUSED_RESULT
 638 STRING *
 639 key_set_to_string(PARROT_INTERP, ARGIN_NULLOK(PMC *key))
 640 {
 641     ASSERT_ARGS(key_set_to_string)
 642     STRING * const semicolon = CONST_STRING(interp, " ; ");
 643     STRING * const quote     = CONST_STRING(interp, "'");
 644     STRING        *value     = Parrot_str_new(interp, "[ ", 2);
 645     PMC           *next_key;
 646     INTVAL         int_key;
 647     STRING        *str_key;
 648
 649     while (key != NULL) {
 650         switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 651           case KEY_integer_FLAG:
 652             GETATTR_Key_int_key(interp, key, int_key);
 653             value = Parrot_str_concat(interp, value,
 654                         Parrot_str_from_int(interp, int_key));
 655             break;
 656           case KEY_number_FLAG:
 657             GETATTR_Key_int_key(interp, key, int_key);
 658             value = Parrot_str_concat(interp, value,
 659                         Parrot_str_from_num(interp, (FLOATVAL)int_key));
 660             break;
 661           case KEY_string_FLAG:
 662             GETATTR_Key_str_key(interp, key, str_key);
 663             value = Parrot_str_concat(interp, value, quote);
 664             value = Parrot_str_concat(interp, value, str_key);
 665             value = Parrot_str_concat(interp, value, quote);
 666             break;
 667           case KEY_pmc_FLAG:
 668             value = Parrot_str_concat(interp, value,
 669                         VTABLE_get_string(interp, key));
 670             break;
 671           case KEY_integer_FLAG | KEY_register_FLAG:
 672             GETATTR_Key_int_key(interp, key, int_key);
 673             value = Parrot_str_concat(interp, value,
 674                         Parrot_str_from_int(interp,
 675                             REG_INT(interp, int_key)));
 676             break;
 677           case KEY_number_FLAG | KEY_register_FLAG:
 678             GETATTR_Key_int_key(interp, key, int_key);
 679             value = Parrot_str_concat(interp, value,
 680                         Parrot_str_from_num(interp,
 681                             REG_NUM(interp, int_key)));
 682             break;
 683           case KEY_string_FLAG | KEY_register_FLAG:
 684             value = Parrot_str_concat(interp, value, quote);
 685             GETATTR_Key_int_key(interp, key, int_key);
 686             value = Parrot_str_concat(interp, value,
 687                     REG_STR(interp, int_key));
 688             value = Parrot_str_concat(interp, value, quote);
 689             break;
 690           case KEY_pmc_FLAG | KEY_register_FLAG:
 691             {
 692                 PMC *reg;
 693                 GETATTR_Key_int_key(interp, key, int_key);
 694                 reg = REG_PMC(interp, int_key);
 695                 value = Parrot_str_concat(interp, value,
 696                             VTABLE_get_string(interp, reg));
 697             }
 698             break;
 699           default:
 700             value = Parrot_str_concat(interp, value, CONST_STRING(interp, "Key type unknown"));
 701             break;
 702         }
 703
 704         GETATTR_Key_next_key(interp, key, next_key);
 705         if (next_key)
 706             value = Parrot_str_concat(interp, value, semicolon);
 707
 708         GETATTR_Key_next_key(interp, key, key);
 709     }
 710
 711     value = Parrot_str_concat(interp, value, Parrot_str_new(interp, " ]", 2));
 712     return value;
 713 }
 714
 715 /*
 716
 717 =back
 718
 719 =head1 SEE ALSO
 720
 721 F<include/parrot/key.h>.
 722
 723 =cut
 724
 725 */
 726
 727
 728 /*
 729  * Local variables:
 730  *   c-file-style: "parrot"
 731  * End:
 732  * vim: expandtab shiftwidth=4:
 733  */