src/key.c

   1 /*
   2 Copyright (C) 2001-2008, The Perl 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
  25 /* HEADERIZER HFILE: include/parrot/key.h */
  26
  27 /*
  28
  29 =item C<PMC * key_new>
  30
  31 Returns a new C<Key> PMC.
  32
  33 =cut
  34
  35 */
  36
  37 PARROT_API
  38 PARROT_CANNOT_RETURN_NULL
  39 PARROT_WARN_UNUSED_RESULT
  40 PMC *
  41 key_new(PARROT_INTERP)
  42 {
  43     return pmc_new(interp, enum_class_Key);
  44 }
  45
  46
  47 /*
  48
  49 =item C<PMC * key_new_integer>
  50
  51 Returns a new integer C<Key> PMC with value C<value>.
  52
  53 =cut
  54
  55 */
  56
  57 PARROT_API
  58 PARROT_CANNOT_RETURN_NULL
  59 PARROT_WARN_UNUSED_RESULT
  60 PMC *
  61 key_new_integer(PARROT_INTERP, INTVAL value)
  62 {
  63     PMC * const key = pmc_new(interp, enum_class_Key);
  64
  65     PObj_get_FLAGS(key) |= KEY_integer_FLAG;
  66     PMC_int_val(key)     = value;
  67
  68     return key;
  69 }
  70
  71
  72 /*
  73
  74 =item C<PMC * key_new_number>
  75
  76 Returns a new number C<Key> PMC with value C<value>.
  77
  78 =cut
  79
  80 */
  81
  82 PARROT_API
  83 PARROT_CANNOT_RETURN_NULL
  84 PARROT_WARN_UNUSED_RESULT
  85 PMC *
  86 key_new_number(PARROT_INTERP, FLOATVAL value)
  87 {
  88     PMC * const key = pmc_new(interp, enum_class_Key);
  89
  90     PObj_get_FLAGS(key) |= KEY_number_FLAG;
  91     PMC_num_val(key)     = value;
  92
  93     return key;
  94 }
  95
  96
  97 /*
  98
  99 =item C<PMC * key_new_string>
 100
 101 Returns a new string C<Key> PMC with value C<value>.
 102
 103 =cut
 104
 105 */
 106
 107 PARROT_API
 108 PARROT_CANNOT_RETURN_NULL
 109 PARROT_WARN_UNUSED_RESULT
 110 PMC *
 111 key_new_string(PARROT_INTERP, ARGIN(STRING *value))
 112 {
 113     PMC * const key = pmc_new(interp, enum_class_Key);
 114
 115     PObj_get_FLAGS(key) |= KEY_string_FLAG;
 116     PMC_str_val(key)     = value;
 117
 118     return key;
 119 }
 120
 121
 122 /*
 123
 124 =item C<PMC * key_new_cstring>
 125
 126 Returns a new string C<Key> PMC with value C<value> converted to a
 127 C<STRING>.
 128
 129 =cut
 130
 131 */
 132
 133 PARROT_API
 134 PARROT_CANNOT_RETURN_NULL
 135 PARROT_WARN_UNUSED_RESULT
 136 PMC *
 137 key_new_cstring(PARROT_INTERP, ARGIN_NULLOK(const char *value))
 138 {
 139     return key_new_string(interp, string_from_cstring(interp, value, 0));
 140 }
 141
 142
 143 /*
 144
 145 =item C<PMC * key_new_pmc>
 146
 147 Returns a new PMC C<Key> PMC with value C<value>.
 148
 149 =cut
 150
 151 */
 152
 153 PARROT_API
 154 PARROT_CANNOT_RETURN_NULL
 155 PARROT_WARN_UNUSED_RESULT
 156 PMC *
 157 key_new_pmc(PARROT_INTERP, ARGIN(PMC *value))
 158 {
 159     PMC * const key = pmc_new(interp, enum_class_Key);
 160
 161     PObj_get_FLAGS(key) |= KEY_pmc_FLAG;
 162     real_exception(interp, NULL, 1, "this is broken - see slice.pmc");
 163 }
 164
 165
 166 /*
 167
 168 =item C<void key_set_integer>
 169
 170 Set the integer C<value> in C<key>.
 171
 172 =cut
 173
 174 */
 175
 176 PARROT_API
 177 void
 178 key_set_integer(SHIM_INTERP, ARGMOD(PMC *key), INTVAL value)
 179 {
 180     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 181     PObj_get_FLAGS(key) |=  KEY_integer_FLAG;
 182     PMC_int_val(key)     = value;
 183
 184     return;
 185 }
 186
 187
 188 /*
 189
 190 =item C<void key_set_register>
 191
 192 Set the register C<value> in C<key>.
 193
 194 =cut
 195
 196 */
 197
 198 PARROT_API
 199 void
 200 key_set_register(SHIM_INTERP, ARGMOD(PMC *key), INTVAL value, INTVAL flag)
 201 {
 202     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 203     PObj_get_FLAGS(key) |=  KEY_register_FLAG | flag;
 204     PMC_int_val(key)     = value;
 205
 206     return;
 207 }
 208
 209
 210 /*
 211
 212 =item C<void key_set_number>
 213
 214 Set the number C<value> in C<key>.
 215
 216 =cut
 217
 218 */
 219
 220 PARROT_API
 221 void
 222 key_set_number(SHIM_INTERP, ARGMOD(PMC *key), FLOATVAL value)
 223 {
 224     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 225     PObj_get_FLAGS(key) |=  KEY_number_FLAG;
 226     PMC_num_val(key)     = value;
 227
 228     return;
 229 }
 230
 231
 232 /*
 233
 234 =item C<void key_set_string>
 235
 236 Set the string C<value> in C<key>.
 237
 238 =cut
 239
 240 */
 241
 242 PARROT_API
 243 void
 244 key_set_string(SHIM_INTERP, ARGMOD(PMC *key), ARGIN(STRING *value))
 245 {
 246     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 247     PObj_get_FLAGS(key) |=  KEY_string_FLAG;
 248     PMC_str_val(key)     = value;
 249
 250     return;
 251 }
 252
 253
 254 /*
 255
 256 =item C<void key_set_pmc>
 257
 258 Set the PMC C<value> in C<key>.
 259
 260 =cut
 261
 262 */
 263
 264 PARROT_API
 265 void
 266 key_set_pmc(PARROT_INTERP, ARGMOD(PMC *key), ARGIN(PMC *value))
 267 {
 268     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 269     PObj_get_FLAGS(key) |=  KEY_pmc_FLAG;
 270
 271     /*
 272      * XXX leo
 273      * what for is this indirection?
 274      */
 275     real_exception(interp, NULL, 1, "this is broken - see slice.pmc");
 276 }
 277
 278
 279 /*
 280
 281 =item C<INTVAL key_type>
 282
 283 Returns the type of C<key>.
 284
 285 =cut
 286
 287 */
 288
 289 PARROT_API
 290 PARROT_WARN_UNUSED_RESULT
 291 INTVAL
 292 key_type(SHIM_INTERP, ARGIN(const PMC *key))
 293 {
 294     return (PObj_get_FLAGS(key) & KEY_type_FLAGS) & ~KEY_register_FLAG;
 295 }
 296
 297
 298 /*
 299
 300 =item C<INTVAL key_integer>
 301
 302 Translates a key value into an integer.
 303 Takes an interpreter name and pointer to a key.
 304 Returns an integer value corresponding to the key.
 305
 306 =cut
 307
 308 */
 309
 310 PARROT_API
 311 PARROT_WARN_UNUSED_RESULT
 312 INTVAL
 313 key_integer(PARROT_INTERP, ARGIN(PMC *key))
 314 {
 315     if (VTABLE_isa(interp, key, CONST_STRING(interp, "Key"))) {
 316         switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 317         case KEY_hash_iterator_FLAGS:
 318         case KEY_integer_FLAG:
 319             return PMC_int_val(key);
 320         case KEY_integer_FLAG | KEY_register_FLAG:
 321             return REG_INT(interp, PMC_int_val(key));
 322         case KEY_pmc_FLAG | KEY_register_FLAG:
 323             {
 324             PMC * const reg = REG_PMC(interp, PMC_int_val(key));
 325             return VTABLE_get_integer(interp, reg);
 326             }
 327         case KEY_string_FLAG:
 328             return string_to_int(interp, PMC_str_val(key));
 329         case KEY_string_FLAG | KEY_register_FLAG:
 330             {
 331             STRING * const s_reg = REG_STR(interp, PMC_int_val(key));
 332             return string_to_int(interp, s_reg);
 333             }
 334         case KEY_string_FLAG | KEY_start_slice_FLAG:
 335         case KEY_string_FLAG | KEY_inf_slice_FLAG:
 336             {
 337             STRING * const s_key = VTABLE_get_string(interp, key);
 338             return string_to_int(interp, s_key);
 339             }
 340         case KEY_start_slice_FLAG:
 341         case KEY_inf_slice_FLAG:
 342         default:
 343             break;
 344         }
 345     }
 346
 347     return VTABLE_get_integer(interp, key);
 348 }
 349
 350
 351 /*
 352
 353 =item C<FLOATVAL key_number>
 354
 355 Translates a key value into a number.
 356 Takes an interpreter name and pointer to a key.
 357 Returns a number value corresponding to the key.
 358 Throws an exception if the key is not a valid number.
 359
 360 =cut
 361
 362 */
 363
 364 PARROT_API
 365 PARROT_WARN_UNUSED_RESULT
 366 FLOATVAL
 367 key_number(PARROT_INTERP, ARGIN(PMC *key))
 368 {
 369     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 370     case KEY_number_FLAG:
 371         return PMC_num_val(key);
 372     case KEY_number_FLAG | KEY_register_FLAG:
 373         return REG_NUM(interp, PMC_int_val(key));
 374     case KEY_pmc_FLAG:
 375         return VTABLE_get_number(interp, key);
 376                                                  /*  PMC_pmc_val(key)); */
 377     case KEY_pmc_FLAG | KEY_register_FLAG:
 378         {
 379         PMC * const reg = REG_PMC(interp, PMC_int_val(key));
 380         return VTABLE_get_number(interp, reg);
 381         }
 382     default:
 383         real_exception(interp, NULL, INVALID_OPERATION, "Key not a number!\n");
 384     }
 385 }
 386
 387
 388 /*
 389
 390 =item C<STRING * key_string>
 391
 392 Translates a key value into a string.
 393 Takes an interpreter name and pointer to a key.
 394 Returns a string value corresponding to the key.
 395
 396 =cut
 397
 398 */
 399
 400 PARROT_API
 401 PARROT_WARN_UNUSED_RESULT
 402 PARROT_CANNOT_RETURN_NULL
 403 STRING *
 404 key_string(PARROT_INTERP, ARGIN(PMC *key))
 405 {
 406     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 407     case KEY_string_FLAG:
 408         return PMC_str_val(key);
 409     case KEY_string_FLAG | KEY_register_FLAG:
 410         return REG_STR(interp, PMC_int_val(key));
 411                                                    /*   PMC_pmc_val(key)); */
 412     case KEY_pmc_FLAG | KEY_register_FLAG:
 413         {
 414         PMC * const reg = REG_PMC(interp, PMC_int_val(key));
 415         return VTABLE_get_string(interp, reg);
 416         }
 417     case KEY_integer_FLAG:
 418         return string_from_int(interp, PMC_int_val(key));
 419     case KEY_integer_FLAG | KEY_register_FLAG:
 420         return string_from_int(interp, REG_INT(interp, PMC_int_val(key)));
 421     default:
 422     case KEY_pmc_FLAG:
 423         return VTABLE_get_string(interp, key);
 424     }
 425 }
 426
 427
 428 /*
 429
 430 =item C<PMC * key_pmc>
 431
 432 These functions return the integer/number/string/PMC values of C<key> if
 433 possible. Otherwise they throw exceptions.
 434
 435 =cut
 436
 437 */
 438
 439 PARROT_API
 440 PARROT_CANNOT_RETURN_NULL
 441 PARROT_WARN_UNUSED_RESULT
 442 PMC *
 443 key_pmc(PARROT_INTERP, ARGIN(PMC *key))
 444 {
 445     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 446     case KEY_pmc_FLAG | KEY_register_FLAG:
 447         return REG_PMC(interp, PMC_int_val(key));
 448     default:
 449         return key; /* PMC_pmc_val(key); */
 450     }
 451 }
 452
 453
 454 /*
 455
 456 =item C<PMC * key_next>
 457
 458 Returns the next key if C<key> is in a sequence of linked keys.
 459
 460 =cut
 461
 462 */
 463
 464 PARROT_API
 465 PARROT_CAN_RETURN_NULL
 466 PARROT_WARN_UNUSED_RESULT
 467 PMC *
 468 key_next(PARROT_INTERP, ARGIN(PMC *key))
 469 {
 470     return VTABLE_isa(interp, key, CONST_STRING(interp, "Key")) && key->pmc_ext
 471         ? (PMC *)PMC_data(key)
 472         : NULL;
 473 }
 474
 475
 476 /*
 477
 478 =item C<PMC * key_append>
 479
 480 Appends C<key2> to C<key1>.
 481
 482 Note that if C<key1> is not the last key in a sequence of linked keys then the
 483 last key will be found and C<key2> appended to that.
 484
 485 Returns C<key1>.
 486
 487 =cut
 488
 489 */
 490
 491 PARROT_API
 492 PARROT_CANNOT_RETURN_NULL
 493 PARROT_IGNORABLE_RESULT
 494 PMC *
 495 key_append(SHIM_INTERP, ARGMOD(PMC *key1), ARGIN(PMC *key2))
 496 {
 497     PMC *tail = key1;
 498
 499     while (PMC_data(tail)) {
 500         tail = (PMC *)PMC_data(tail);
 501     }
 502
 503     PMC_data(tail) = key2;
 504
 505     return key1;
 506 }
 507
 508
 509 /*
 510
 511 =item C<void key_mark>
 512
 513 Marks C<key> as live.
 514
 515 =cut
 516
 517 */
 518
 519 PARROT_API
 520 void
 521 key_mark(PARROT_INTERP, ARGIN(PMC *key))
 522 {
 523     const UINTVAL flags = PObj_get_FLAGS(key) & KEY_type_FLAGS;
 524
 525     if (flags == KEY_string_FLAG)
 526         pobject_lives(interp, (PObj *)PMC_str_val(key));
 527
 528     /*
 529      * KEY_hash_iterator_FLAGS denote a hash key iteration, PMC_data() is
 530      * the bucket_index and not the next key component
 531      */
 532     if (flags == KEY_hash_iterator_FLAGS)
 533         return;
 534
 535     /* if iteration hasn't started, above flag isn't set yet */
 536     if (PMC_data(key) && PMC_data(key) != (void *)INITBucketIndex)
 537         pobject_lives(interp, (PObj *)PMC_data(key));
 538
 539 }
 540
 541
 542 /*
 543
 544 =item C<STRING * key_set_to_string>
 545
 546 Translates a series of key values into strings, quoted or bracketed if
 547 appropriate.  Takes an interpreter name and pointer to a key.  Returns a
 548 string value corresponding to the key.
 549
 550 =cut
 551
 552 */
 553
 554 PARROT_API
 555 PARROT_CANNOT_RETURN_NULL
 556 PARROT_WARN_UNUSED_RESULT
 557 STRING *
 558 key_set_to_string(PARROT_INTERP, ARGIN_NULLOK(PMC *key))
 559 {
 560     STRING * const semicolon = string_from_cstring(interp, " ; ", 3);
 561     STRING * const quote     = string_from_cstring(interp, "'", 1);
 562     STRING        *value     = string_from_cstring(interp, "[ ", 2);
 563
 564     for (; key; key = (PMC *)PMC_data(key)) {
 565         switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 566             case KEY_integer_FLAG:
 567                 value = string_append(interp, value,
 568                     string_from_int(interp, PMC_int_val(key)));
 569                 break;
 570             case KEY_string_FLAG:
 571                 value = string_append(interp, value, quote);
 572                 value = string_append(interp, value, PMC_str_val(key));
 573                 value = string_append(interp, value, quote);
 574                 break;
 575             case KEY_pmc_FLAG:
 576                 value = string_append(interp, value,
 577                     VTABLE_get_string(interp, key));
 578                 break;
 579             case KEY_integer_FLAG | KEY_register_FLAG:
 580                 value = string_append(interp, value,
 581                         string_from_int(interp,
 582                             REG_INT(interp, PMC_int_val(key))));
 583                 break;
 584             case KEY_string_FLAG | KEY_register_FLAG:
 585                 value = string_append(interp, value, quote);
 586                 value = string_append(interp, value,
 587                     REG_STR(interp, PMC_int_val(key)));
 588                 value = string_append(interp, value, quote);
 589                 break;
 590             case KEY_pmc_FLAG | KEY_register_FLAG:
 591                 {
 592                 PMC * const reg = REG_PMC(interp, PMC_int_val(key));
 593                 value           = string_append(interp, value,
 594                                     VTABLE_get_string(interp, reg));
 595                 }
 596                 break;
 597             default:
 598                 value = string_append(interp, value, CONST_STRING(interp, "Key type unknown"));
 599                 break;
 600         }
 601
 602         if (PMC_data(key))
 603             value = string_append(interp, value, semicolon);
 604     }
 605
 606     value = string_append(interp, value, string_from_cstring(interp, " ]", 2));
 607     return value;
 608 }
 609
 610 /*
 611
 612 =back
 613
 614 =head1 SEE ALSO
 615
 616 F<include/parrot/key.h>.
 617
 618 =head1 HISTORY
 619
 620 Initial version by Jeff G. on 2001.12.05.
 621
 622 =cut
 623
 624 */
 625
 626
 627 /*
 628  * Local variables:
 629  *   c-file-style: "parrot"
 630  * End:
 631  * vim: expandtab shiftwidth=4:
 632  */