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 =item C<void key_set_integer(PARROT_INTERP, PMC *key, INTVAL value)>
 152
 153 Set the integer C<value> in C<key>.
 154
 155 =cut
 156
 157 */
 158
 159 PARROT_EXPORT
 160 void
 161 key_set_integer(PARROT_INTERP, ARGMOD(PMC *key), INTVAL value)
 162 {
 163     ASSERT_ARGS(key_set_integer)
 164     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 165     PObj_get_FLAGS(key) |=  KEY_integer_FLAG;
 166     SETATTR_Key_int_key(interp, key, value);
 167
 168     return;
 169 }
 170
 171
 172 /*
 173
 174 =item C<void key_set_register(PARROT_INTERP, PMC *key, INTVAL value, INTVAL
 175 flag)>
 176
 177 Set the register C<value> in C<key>.
 178
 179 =cut
 180
 181 */
 182
 183 PARROT_EXPORT
 184 void
 185 key_set_register(PARROT_INTERP, ARGMOD(PMC *key), INTVAL value, INTVAL flag)
 186 {
 187     ASSERT_ARGS(key_set_register)
 188     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 189     PObj_get_FLAGS(key) |=  KEY_register_FLAG | flag;
 190     SETATTR_Key_int_key(interp, key, value);
 191
 192     return;
 193 }
 194
 195
 196 /*
 197
 198 =item C<void key_set_number(PARROT_INTERP, PMC *key, FLOATVAL value)>
 199
 200 Set the number C<value> in C<key>.
 201
 202 =cut
 203
 204 */
 205
 206 PARROT_EXPORT
 207 void
 208 key_set_number(PARROT_INTERP, ARGMOD(PMC *key), FLOATVAL value)
 209 {
 210     ASSERT_ARGS(key_set_number)
 211     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 212     PObj_get_FLAGS(key) |=  KEY_number_FLAG;
 213     SETATTR_Key_num_key(interp, key, value);
 214
 215     return;
 216 }
 217
 218
 219 /*
 220
 221 =item C<void key_set_string(PARROT_INTERP, PMC *key, STRING *value)>
 222
 223 Set the string C<value> in C<key>.
 224
 225 =cut
 226
 227 */
 228
 229 PARROT_EXPORT
 230 void
 231 key_set_string(PARROT_INTERP, ARGMOD(PMC *key), ARGIN(STRING *value))
 232 {
 233     ASSERT_ARGS(key_set_string)
 234     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 235     PObj_get_FLAGS(key) |=  KEY_string_FLAG;
 236     SETATTR_Key_str_key(interp, key, value);
 237
 238     return;
 239 }
 240
 241 /*
 242
 243 =item C<INTVAL key_type(PARROT_INTERP, const PMC *key)>
 244
 245 Returns the type of C<key>.
 246
 247 =cut
 248
 249 */
 250
 251 PARROT_EXPORT
 252 PARROT_PURE_FUNCTION
 253 PARROT_WARN_UNUSED_RESULT
 254 INTVAL
 255 key_type(SHIM_INTERP, ARGIN(const PMC *key))
 256 {
 257     ASSERT_ARGS(key_type)
 258     return (PObj_get_FLAGS(key) & KEY_type_FLAGS) & ~KEY_register_FLAG;
 259 }
 260
 261
 262 /*
 263
 264 =item C<INTVAL key_integer(PARROT_INTERP, PMC *key)>
 265
 266 Translates a key value into an integer.
 267 Takes an interpreter name and pointer to a key.
 268 Returns an integer value corresponding to the key.
 269
 270 =cut
 271
 272 */
 273
 274 PARROT_EXPORT
 275 PARROT_WARN_UNUSED_RESULT
 276 INTVAL
 277 key_integer(PARROT_INTERP, ARGIN(PMC *key))
 278 {
 279     ASSERT_ARGS(key_integer)
 280     INTVAL   int_key;
 281     STRING  *str_key;
 282     FLOATVAL num_key;
 283
 284     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 285       case KEY_integer_FLAG:
 286         GETATTR_Key_int_key(interp, key, int_key);
 287         return int_key;
 288       case KEY_integer_FLAG | KEY_register_FLAG:
 289         GETATTR_Key_int_key(interp, key, int_key);
 290         return REG_INT(interp, int_key);
 291
 292       case KEY_number_FLAG:
 293         GETATTR_Key_num_key(interp, key, num_key);
 294         return (INTVAL)num_key;
 295       case KEY_number_FLAG | KEY_register_FLAG:
 296         GETATTR_Key_int_key(interp, key, int_key);
 297         return (INTVAL)REG_NUM(interp, int_key);
 298
 299       case KEY_pmc_FLAG | KEY_register_FLAG:
 300         {
 301             PMC *reg;
 302             GETATTR_Key_int_key(interp, key, int_key);
 303             reg = REG_PMC(interp, int_key);
 304             return VTABLE_get_integer(interp, reg);
 305         }
 306
 307       case KEY_string_FLAG:
 308         GETATTR_Key_str_key(interp, key, str_key);
 309         return Parrot_str_to_int(interp, str_key);
 310       case KEY_string_FLAG | KEY_register_FLAG:
 311         {
 312             STRING *s_reg;
 313             GETATTR_Key_int_key(interp, key, int_key);
 314             s_reg = REG_STR(interp, int_key);
 315             return Parrot_str_to_int(interp, s_reg);
 316         }
 317
 318       default:
 319             break;
 320     }
 321
 322     return VTABLE_get_integer(interp, key);
 323 }
 324
 325
 326 /*
 327
 328 =item C<FLOATVAL key_number(PARROT_INTERP, PMC *key)>
 329
 330 Translates a key value into a number.
 331 Takes an interpreter name and pointer to a key.
 332 Returns a number value corresponding to the key.
 333 Throws an exception if the key is not a valid number.
 334
 335 =cut
 336
 337 */
 338
 339 PARROT_EXPORT
 340 PARROT_WARN_UNUSED_RESULT
 341 FLOATVAL
 342 key_number(PARROT_INTERP, ARGIN(PMC *key))
 343 {
 344     ASSERT_ARGS(key_number)
 345     INTVAL   int_key;
 346     FLOATVAL num_key;
 347
 348     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 349       case KEY_number_FLAG:
 350         GETATTR_Key_num_key(interp, key, num_key);
 351         return num_key;
 352       case KEY_number_FLAG | KEY_register_FLAG:
 353         GETATTR_Key_int_key(interp, key, int_key);
 354         return REG_NUM(interp, int_key);
 355       case KEY_pmc_FLAG:
 356         return VTABLE_get_number(interp, key);
 357       case KEY_pmc_FLAG | KEY_register_FLAG:
 358         {
 359             PMC *reg;
 360             GETATTR_Key_int_key(interp, key, int_key);
 361             reg = REG_PMC(interp, int_key);
 362             return VTABLE_get_number(interp, reg);
 363         }
 364       default:
 365         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
 366             "Key not a number!\n");
 367     }
 368 }
 369
 370
 371 /*
 372
 373 =item C<STRING * key_string(PARROT_INTERP, PMC *key)>
 374
 375 Translates a key value into a string.  Takes an interpreter name and pointer to
 376 a key.  Returns a string value corresponding to the key.
 377
 378 =cut
 379
 380 */
 381
 382 PARROT_EXPORT
 383 PARROT_WARN_UNUSED_RESULT
 384 PARROT_CAN_RETURN_NULL
 385 STRING *
 386 key_string(PARROT_INTERP, ARGIN(PMC *key))
 387 {
 388     ASSERT_ARGS(key_string)
 389
 390     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 391         /* remember to COW strings instead of returning them directly */
 392       case KEY_string_FLAG:
 393         {
 394             STRING *s;
 395             GETATTR_Key_str_key(interp, key, s);
 396             return s;
 397         }
 398       case KEY_string_FLAG | KEY_register_FLAG:
 399         {
 400             INTVAL int_key;
 401             GETATTR_Key_int_key(interp, key, int_key);
 402             return REG_STR(interp, int_key);
 403         }
 404       case KEY_pmc_FLAG | KEY_register_FLAG:
 405         {
 406             INTVAL int_key;
 407             PMC *reg;
 408             GETATTR_Key_int_key(interp, key, int_key);
 409             reg = REG_PMC(interp, int_key);
 410             return VTABLE_get_string(interp, reg);
 411         }
 412       case KEY_integer_FLAG:
 413         {
 414             INTVAL int_key;
 415             GETATTR_Key_int_key(interp, key, int_key);
 416             return Parrot_str_from_int(interp, int_key);
 417         }
 418       case KEY_integer_FLAG | KEY_register_FLAG:
 419         {
 420             INTVAL int_key;
 421             GETATTR_Key_int_key(interp, key, int_key);
 422             return Parrot_str_from_int(interp, REG_INT(interp, int_key));
 423         }
 424       case KEY_number_FLAG:
 425         {
 426             FLOATVAL num_key;
 427             GETATTR_Key_num_key(interp, key, num_key);
 428             return Parrot_str_from_num(interp, num_key);
 429         }
 430       case KEY_number_FLAG | KEY_register_FLAG:
 431         {
 432             INTVAL int_key;
 433             GETATTR_Key_int_key(interp, key, int_key);
 434             return Parrot_str_from_num(interp, REG_NUM(interp, int_key));
 435         }
 436       default:
 437       case KEY_pmc_FLAG:
 438         return VTABLE_get_string(interp, key);
 439     }
 440 }
 441
 442
 443 /*
 444
 445 =item C<PMC * key_pmc(PARROT_INTERP, PMC *key)>
 446
 447 These functions return the integer/number/string/PMC values of C<key> if
 448 possible. Otherwise they throw exceptions.
 449
 450 =cut
 451
 452 */
 453
 454 PARROT_EXPORT
 455 PARROT_CANNOT_RETURN_NULL
 456 PARROT_WARN_UNUSED_RESULT
 457 PMC *
 458 key_pmc(PARROT_INTERP, ARGIN(PMC *key))
 459 {
 460     ASSERT_ARGS(key_pmc)
 461     INTVAL int_key;
 462
 463     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 464       case KEY_pmc_FLAG | KEY_register_FLAG:
 465         GETATTR_Key_int_key(interp, key, int_key);
 466         return REG_PMC(interp, int_key);
 467       default:
 468         return key;
 469     }
 470 }
 471
 472
 473 /*
 474
 475 =item C<PMC * key_next(PARROT_INTERP, PMC *key)>
 476
 477 Returns the next key if C<key> is in a sequence of linked keys.
 478
 479 =cut
 480
 481 */
 482
 483 PARROT_EXPORT
 484 PARROT_CAN_RETURN_NULL
 485 PARROT_WARN_UNUSED_RESULT
 486 PMC *
 487 key_next(PARROT_INTERP, ARGIN(PMC *key))
 488 {
 489     ASSERT_ARGS(key_next)
 490
 491     if (VTABLE_isa(interp, key, CONST_STRING(interp, "Key"))) {
 492         PMC *next_key;
 493         GETATTR_Key_next_key(interp, key, next_key);
 494         return next_key;
 495     }
 496
 497     return NULL;
 498 }
 499
 500
 501 /*
 502
 503 =item C<PMC * key_append(PARROT_INTERP, PMC *key1, PMC *key2)>
 504
 505 Appends C<key2> to C<key1>.
 506
 507 Note that if C<key1> is not the last key in a sequence of linked keys then the
 508 last key will be found and C<key2> appended to that.
 509
 510 Returns C<key1>.
 511
 512 =cut
 513
 514 */
 515
 516 PARROT_EXPORT
 517 PARROT_CANNOT_RETURN_NULL
 518 PARROT_IGNORABLE_RESULT
 519 PMC *
 520 key_append(PARROT_INTERP, ARGMOD(PMC *key1), ARGIN(PMC *key2))
 521 {
 522     ASSERT_ARGS(key_append)
 523     PMC *tail = key1;
 524     PMC *tail_next;
 525
 526     GETATTR_Key_next_key(interp, tail, tail_next);
 527
 528     while (tail_next) {
 529         tail = tail_next;
 530         GETATTR_Key_next_key(interp, tail, tail_next);
 531     }
 532
 533     SETATTR_Key_next_key(interp, tail, key2);
 534
 535     return key1;
 536 }
 537
 538
 539 /*
 540
 541 =item C<void key_mark(PARROT_INTERP, PMC *key)>
 542
 543 Marks C<key> as live.
 544
 545 =cut
 546
 547 */
 548
 549 PARROT_EXPORT
 550 void
 551 key_mark(PARROT_INTERP, ARGIN(PMC *key))
 552 {
 553     ASSERT_ARGS(key_mark)
 554     PMC          *next_key;
 555     const UINTVAL flags = PObj_get_FLAGS(key) & KEY_type_FLAGS;
 556
 557     if (flags == KEY_string_FLAG) {
 558         STRING *str_key;
 559         GETATTR_Key_str_key(interp, key, str_key);
 560         Parrot_gc_mark_STRING_alive(interp, str_key);
 561     }
 562
 563     /* Mark next key */
 564     if ((flags == KEY_string_FLAG) || (flags == KEY_pmc_FLAG)) {
 565         GETATTR_Key_next_key(interp, key, next_key);
 566         Parrot_gc_mark_PMC_alive(interp, next_key);
 567     }
 568
 569 }
 570
 571
 572 /*
 573
 574 =item C<STRING * key_set_to_string(PARROT_INTERP, PMC *key)>
 575
 576 Translates a series of key values into strings, quoted or bracketed if
 577 appropriate.  Takes an interpreter name and pointer to a key.  Returns a
 578 string value corresponding to the key.
 579
 580 =cut
 581
 582 */
 583
 584 PARROT_EXPORT
 585 PARROT_CANNOT_RETURN_NULL
 586 PARROT_WARN_UNUSED_RESULT
 587 STRING *
 588 key_set_to_string(PARROT_INTERP, ARGIN_NULLOK(PMC *key))
 589 {
 590     ASSERT_ARGS(key_set_to_string)
 591     STRING * const semicolon = CONST_STRING(interp, " ; ");
 592     STRING * const quote     = CONST_STRING(interp, "'");
 593     STRING        *value     = Parrot_str_new(interp, "[ ", 2);
 594     PMC           *next_key;
 595     INTVAL         int_key;
 596     STRING        *str_key;
 597
 598     while (key != NULL) {
 599         switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 600           case KEY_integer_FLAG:
 601             GETATTR_Key_int_key(interp, key, int_key);
 602             value = Parrot_str_concat(interp, value,
 603                         Parrot_str_from_int(interp, int_key));
 604             break;
 605           case KEY_number_FLAG:
 606             GETATTR_Key_int_key(interp, key, int_key);
 607             value = Parrot_str_concat(interp, value,
 608                         Parrot_str_from_num(interp, (FLOATVAL)int_key));
 609             break;
 610           case KEY_string_FLAG:
 611             GETATTR_Key_str_key(interp, key, str_key);
 612             value = Parrot_str_concat(interp, value, quote);
 613             value = Parrot_str_concat(interp, value, str_key);
 614             value = Parrot_str_concat(interp, value, quote);
 615             break;
 616           case KEY_pmc_FLAG:
 617             value = Parrot_str_concat(interp, value,
 618                         VTABLE_get_string(interp, key));
 619             break;
 620           case KEY_integer_FLAG | KEY_register_FLAG:
 621             GETATTR_Key_int_key(interp, key, int_key);
 622             value = Parrot_str_concat(interp, value,
 623                         Parrot_str_from_int(interp,
 624                             REG_INT(interp, int_key)));
 625             break;
 626           case KEY_number_FLAG | KEY_register_FLAG:
 627             GETATTR_Key_int_key(interp, key, int_key);
 628             value = Parrot_str_concat(interp, value,
 629                         Parrot_str_from_num(interp,
 630                             REG_NUM(interp, int_key)));
 631             break;
 632           case KEY_string_FLAG | KEY_register_FLAG:
 633             value = Parrot_str_concat(interp, value, quote);
 634             GETATTR_Key_int_key(interp, key, int_key);
 635             value = Parrot_str_concat(interp, value,
 636                     REG_STR(interp, int_key));
 637             value = Parrot_str_concat(interp, value, quote);
 638             break;
 639           case KEY_pmc_FLAG | KEY_register_FLAG:
 640             {
 641                 PMC *reg;
 642                 GETATTR_Key_int_key(interp, key, int_key);
 643                 reg = REG_PMC(interp, int_key);
 644                 value = Parrot_str_concat(interp, value,
 645                             VTABLE_get_string(interp, reg));
 646             }
 647             break;
 648           default:
 649             value = Parrot_str_concat(interp, value, CONST_STRING(interp, "Key type unknown"));
 650             break;
 651         }
 652
 653         GETATTR_Key_next_key(interp, key, next_key);
 654         if (next_key)
 655             value = Parrot_str_concat(interp, value, semicolon);
 656
 657         GETATTR_Key_next_key(interp, key, key);
 658     }
 659
 660     value = Parrot_str_concat(interp, value, Parrot_str_new(interp, " ]", 2));
 661     return value;
 662 }
 663
 664 /*
 665
 666 =back
 667
 668 =head1 SEE ALSO
 669
 670 F<include/parrot/key.h>.
 671
 672 =cut
 673
 674 */
 675
 676
 677 /*
 678  * Local variables:
 679  *   c-file-style: "parrot"
 680  * End:
 681  * vim: expandtab shiftwidth=4:
 682  */