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_WARN_UNUSED_RESULT
 383 PARROT_CAN_RETURN_NULL
 384 STRING *
 385 key_string(PARROT_INTERP, ARGIN(PMC *key))
 386 {
 387     ASSERT_ARGS(key_string)
 388
 389     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 390         /* remember to COW strings instead of returning them directly */
 391       case KEY_string_FLAG:
 392         {
 393             STRING *s;
 394             GETATTR_Key_str_key(interp, key, s);
 395             return s;
 396         }
 397       case KEY_string_FLAG | KEY_register_FLAG:
 398         {
 399             INTVAL int_key;
 400             GETATTR_Key_int_key(interp, key, int_key);
 401             return REG_STR(interp, int_key);
 402         }
 403       case KEY_pmc_FLAG | KEY_register_FLAG:
 404         {
 405             INTVAL int_key;
 406             PMC *reg;
 407             GETATTR_Key_int_key(interp, key, int_key);
 408             reg = REG_PMC(interp, int_key);
 409             return VTABLE_get_string(interp, reg);
 410         }
 411       case KEY_integer_FLAG:
 412         {
 413             INTVAL int_key;
 414             GETATTR_Key_int_key(interp, key, int_key);
 415             return Parrot_str_from_int(interp, int_key);
 416         }
 417       case KEY_integer_FLAG | KEY_register_FLAG:
 418         {
 419             INTVAL int_key;
 420             GETATTR_Key_int_key(interp, key, int_key);
 421             return Parrot_str_from_int(interp, REG_INT(interp, int_key));
 422         }
 423       case KEY_number_FLAG:
 424         {
 425             FLOATVAL num_key;
 426             GETATTR_Key_num_key(interp, key, num_key);
 427             return Parrot_str_from_num(interp, num_key);
 428         }
 429       case KEY_number_FLAG | KEY_register_FLAG:
 430         {
 431             INTVAL int_key;
 432             GETATTR_Key_int_key(interp, key, int_key);
 433             return Parrot_str_from_num(interp, REG_NUM(interp, int_key));
 434         }
 435       default:
 436       case KEY_pmc_FLAG:
 437         return VTABLE_get_string(interp, key);
 438     }
 439 }
 440
 441
 442 /*
 443
 444 =item C<PMC * key_pmc(PARROT_INTERP, PMC *key)>
 445
 446 These functions return the integer/number/string/PMC values of C<key> if
 447 possible. Otherwise they throw exceptions.
 448
 449 =cut
 450
 451 */
 452
 453 PARROT_EXPORT
 454 PARROT_CANNOT_RETURN_NULL
 455 PARROT_WARN_UNUSED_RESULT
 456 PMC *
 457 key_pmc(PARROT_INTERP, ARGIN(PMC *key))
 458 {
 459     ASSERT_ARGS(key_pmc)
 460     INTVAL int_key;
 461
 462     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 463       case KEY_pmc_FLAG | KEY_register_FLAG:
 464         GETATTR_Key_int_key(interp, key, int_key);
 465         return REG_PMC(interp, int_key);
 466       default:
 467         return key;
 468     }
 469 }
 470
 471
 472 /*
 473
 474 =item C<PMC * key_next(PARROT_INTERP, PMC *key)>
 475
 476 Returns the next key if C<key> is in a sequence of linked keys.
 477
 478 =cut
 479
 480 */
 481
 482 PARROT_EXPORT
 483 PARROT_CAN_RETURN_NULL
 484 PARROT_WARN_UNUSED_RESULT
 485 PMC *
 486 key_next(PARROT_INTERP, ARGIN(PMC *key))
 487 {
 488     ASSERT_ARGS(key_next)
 489
 490     if (VTABLE_isa(interp, key, CONST_STRING(interp, "Key"))) {
 491         PMC *next_key;
 492         GETATTR_Key_next_key(interp, key, next_key);
 493         return next_key;
 494     }
 495
 496     return NULL;
 497 }
 498
 499
 500 /*
 501
 502 =item C<PMC * key_append(PARROT_INTERP, PMC *key1, PMC *key2)>
 503
 504 Appends C<key2> to C<key1>.
 505
 506 Note that if C<key1> is not the last key in a sequence of linked keys then the
 507 last key will be found and C<key2> appended to that.
 508
 509 Returns C<key1>.
 510
 511 =cut
 512
 513 */
 514
 515 PARROT_EXPORT
 516 PARROT_CANNOT_RETURN_NULL
 517 PARROT_IGNORABLE_RESULT
 518 PMC *
 519 key_append(PARROT_INTERP, ARGMOD(PMC *key1), ARGIN(PMC *key2))
 520 {
 521     ASSERT_ARGS(key_append)
 522     PMC *tail = key1;
 523     PMC *tail_next;
 524
 525     GETATTR_Key_next_key(interp, tail, tail_next);
 526
 527     while (tail_next) {
 528         tail = tail_next;
 529         GETATTR_Key_next_key(interp, tail, tail_next);
 530     }
 531
 532     SETATTR_Key_next_key(interp, tail, key2);
 533
 534     return key1;
 535 }
 536
 537
 538 /*
 539
 540 =item C<void key_mark(PARROT_INTERP, PMC *key)>
 541
 542 Marks C<key> as live.
 543
 544 =cut
 545
 546 */
 547
 548 PARROT_EXPORT
 549 void
 550 key_mark(PARROT_INTERP, ARGIN(PMC *key))
 551 {
 552     ASSERT_ARGS(key_mark)
 553     PMC          *next_key;
 554     const UINTVAL flags = PObj_get_FLAGS(key) & KEY_type_FLAGS;
 555
 556     if (flags == KEY_string_FLAG) {
 557         STRING *str_key;
 558         GETATTR_Key_str_key(interp, key, str_key);
 559         Parrot_gc_mark_STRING_alive(interp, str_key);
 560     }
 561
 562     /* Mark next key */
 563     if ((flags == KEY_string_FLAG) || (flags == KEY_pmc_FLAG)) {
 564         GETATTR_Key_next_key(interp, key, next_key);
 565         Parrot_gc_mark_PMC_alive(interp, next_key);
 566     }
 567
 568 }
 569
 570
 571 /*
 572
 573 =item C<STRING * key_set_to_string(PARROT_INTERP, PMC *key)>
 574
 575 Translates a series of key values into strings, quoted or bracketed if
 576 appropriate.  Takes an interpreter name and pointer to a key.  Returns a
 577 string value corresponding to the key.
 578
 579 =cut
 580
 581 */
 582
 583 PARROT_EXPORT
 584 PARROT_CANNOT_RETURN_NULL
 585 PARROT_WARN_UNUSED_RESULT
 586 STRING *
 587 key_set_to_string(PARROT_INTERP, ARGIN_NULLOK(PMC *key))
 588 {
 589     ASSERT_ARGS(key_set_to_string)
 590     STRING * const semicolon = CONST_STRING(interp, " ; ");
 591     STRING * const quote     = CONST_STRING(interp, "'");
 592     STRING        *value     = Parrot_str_new(interp, "[ ", 2);
 593     PMC           *next_key;
 594     INTVAL         int_key;
 595     STRING        *str_key;
 596
 597     while (key != NULL) {
 598         switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 599           case KEY_integer_FLAG:
 600             GETATTR_Key_int_key(interp, key, int_key);
 601             value = Parrot_str_concat(interp, value,
 602                         Parrot_str_from_int(interp, int_key));
 603             break;
 604           case KEY_number_FLAG:
 605             GETATTR_Key_int_key(interp, key, int_key);
 606             value = Parrot_str_concat(interp, value,
 607                         Parrot_str_from_num(interp, (FLOATVAL)int_key));
 608             break;
 609           case KEY_string_FLAG:
 610             GETATTR_Key_str_key(interp, key, str_key);
 611             value = Parrot_str_concat(interp, value, quote);
 612             value = Parrot_str_concat(interp, value, str_key);
 613             value = Parrot_str_concat(interp, value, quote);
 614             break;
 615           case KEY_pmc_FLAG:
 616             value = Parrot_str_concat(interp, value,
 617                         VTABLE_get_string(interp, key));
 618             break;
 619           case KEY_integer_FLAG | KEY_register_FLAG:
 620             GETATTR_Key_int_key(interp, key, int_key);
 621             value = Parrot_str_concat(interp, value,
 622                         Parrot_str_from_int(interp,
 623                             REG_INT(interp, int_key)));
 624             break;
 625           case KEY_number_FLAG | KEY_register_FLAG:
 626             GETATTR_Key_int_key(interp, key, int_key);
 627             value = Parrot_str_concat(interp, value,
 628                         Parrot_str_from_num(interp,
 629                             REG_NUM(interp, int_key)));
 630             break;
 631           case KEY_string_FLAG | KEY_register_FLAG:
 632             value = Parrot_str_concat(interp, value, quote);
 633             GETATTR_Key_int_key(interp, key, int_key);
 634             value = Parrot_str_concat(interp, value,
 635                     REG_STR(interp, int_key));
 636             value = Parrot_str_concat(interp, value, quote);
 637             break;
 638           case KEY_pmc_FLAG | KEY_register_FLAG:
 639             {
 640                 PMC *reg;
 641                 GETATTR_Key_int_key(interp, key, int_key);
 642                 reg = REG_PMC(interp, int_key);
 643                 value = Parrot_str_concat(interp, value,
 644                             VTABLE_get_string(interp, reg));
 645             }
 646             break;
 647           default:
 648             value = Parrot_str_concat(interp, value, CONST_STRING(interp, "Key type unknown"));
 649             break;
 650         }
 651
 652         GETATTR_Key_next_key(interp, key, next_key);
 653         if (next_key)
 654             value = Parrot_str_concat(interp, value, semicolon);
 655
 656         GETATTR_Key_next_key(interp, key, key);
 657     }
 658
 659     value = Parrot_str_concat(interp, value, Parrot_str_new(interp, " ]", 2));
 660     return value;
 661 }
 662
 663 /*
 664
 665 =back
 666
 667 =head1 SEE ALSO
 668
 669 F<include/parrot/key.h>.
 670
 671 =cut
 672
 673 */
 674
 675
 676 /*
 677  * Local variables:
 678  *   c-file-style: "parrot"
 679  * End:
 680  * vim: expandtab shiftwidth=4:
 681  */