languages/lua/src/pmc/luaany.pmc

   1 /*
   2 Copyright (C) 2006-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 pmc/luaany.pmc - Lua abstract base class
   8
   9 =head1 DESCRIPTION
  10
  11 C<LuaAny> provides an abstract base class for some Lua types.
  12
  13 =head2 PMC Inheritance Summary
  14
  15  Class                  Parents
  16  -----------------------------------------------
  17  LuaBoolean             LuaAny, Default
  18  LuaClosure             Closure, LuaAny, Default
  19  LuaFunction            Sub, LuaAny, Default
  20  LuaNil                 LuaAny, Default
  21  LuaNumber              LuaAny, Default
  22  LuaString              LuaAny, Default
  23  LuaTable               LuaAny, Default
  24  LuaThread              LuaAny, Default
  25  LuaUserdata            LuaAny, Default
  26
  27 =head2 PMC "Attribute" Summary
  28
  29  Class                  Metatable       Environment     Userdata
  30      accessor           get_metatable   getfenv         get_attr_str (getattribute)
  31      mutator            set_metatable   setfenv         set_attr_str (setattribute)
  32      default value      nil             nil             NULL
  33  ------------------------------------------------------------------
  34  LuaBoolean             nil             -               -
  35  LuaClosure             nil             yes             -
  36  LuaFunction            nil             yes             -
  37  LuaNil                 nil             -               -
  38  LuaNumber              nil             -               -
  39  LuaString              yes (common)    -               -
  40  LuaTable               yes             -               -
  41  LuaThread              nil             yes             -
  42  LuaUserdata            yes             yes             yes
  43
  44 The metatable supports the OO mecanism.
  45
  46 =head2 Methods
  47
  48 =over 4
  49
  50 =cut
  51
  52 */
  53
  54 #include "lua_private.h"
  55
  56
  57 PMC *
  58 find_meth(PARROT_INTERP, PMC *obj, const char *name) {
  59     PMC   *meta = NULL;
  60     INTVAL type = PMC_type(obj);
  61
  62     if (dynpmc_LuaString == type) {
  63         meta = Parrot_find_global_s(interp,
  64                                     const_string(interp, "Lua::string"),
  65                                     const_string(interp, "mt_string"));
  66     }
  67
  68     if (dynpmc_LuaClosure != type && dynpmc_LuaFunction != type) {
  69         if (obj->pmc_ext)
  70             meta = PMC_metadata(obj);
  71
  72         if (meta && dynpmc_LuaTable != PMC_type(meta))
  73             return meta;
  74     }
  75
  76     if (meta) {
  77         PMC *method;
  78         PMC *key = pmc_new(interp, dynpmc_LuaString);
  79         VTABLE_set_string_native(interp, key, const_string(interp, name));
  80
  81         method = VTABLE_get_pmc_keyed(interp, meta, key);
  82
  83         if (dynpmc_LuaNil != PMC_type(method))
  84             return method;
  85     }
  86
  87     return NULL;
  88 }
  89
  90
  91 pmclass LuaAny
  92     abstract
  93     dynpmc
  94     group lua_group
  95     hll Lua {
  96 /*
  97
  98 =item C<void morph(INTVAL type)>
  99
 100 Changes the PMC to a PMC of a new type
 101
 102 =cut
 103
 104 */
 105     void morph(INTVAL type) {
 106         if (PMC_type(SELF) == type)
 107             return;
 108         pmc_reuse(INTERP, SELF, type, 0);
 109     }
 110
 111 /*
 112
 113 =item C<INTVAL get_bool()>
 114
 115 Returns C<true>.
 116
 117 =cut
 118
 119 */
 120     INTVAL get_bool() {
 121         return (INTVAL)1;
 122     }
 123
 124 /*
 125
 126 =item C<void *get_pointer()>
 127
 128 Returns the address of the PMC.
 129
 130 =cut
 131
 132 */
 133     void* get_pointer() {
 134         return SELF;
 135     }
 136
 137 /*
 138
 139 =item C<void assign_pmc(PMC *value)>
 140
 141 =cut
 142
 143 */
 144     void assign_pmc(PMC *value) {
 145         VTABLE_morph(INTERP, SELF, PMC_type(value));
 146         if (PMC_type(value) != dynpmc_LuaNil)
 147             SELF.set_pmc(value);
 148     }
 149
 150 /*
 151
 152 =item C<PMC* get_pmc_keyed(PMC *key)>
 153
 154 Throws an exception.
 155
 156 =cut
 157
 158 */
 159     PMC* get_pmc_keyed(PMC *key) {
 160         PMC *meth = find_meth(INTERP, SELF, "__index");
 161
 162         if (meth) {
 163             if (dynpmc_LuaClosure  == PMC_type(meth)
 164             ||  dynpmc_LuaFunction == PMC_type(meth)) {
 165                 PMC *retval = Parrot_runops_fromc_args(INTERP, meth, "PPP",
 166                                                        SELF, key);
 167                 if (retval)
 168                     return retval;
 169
 170                 return pmc_new(INTERP, dynpmc_LuaNil);
 171             }
 172             else
 173                 return VTABLE_get_pmc_keyed(INTERP, meth, key);
 174         }
 175         real_exception(INTERP, NULL, ILL_INHERIT,
 176                 "attempt to index a %Ss value", SELF.name());
 177     }
 178
 179 /*
 180
 181 =item C<void set_pmc_keyed(PMC* key, PMC* value)>
 182
 183 Throws an exception.
 184
 185 =cut
 186
 187 */
 188     void set_pmc_keyed(PMC *key, PMC *value) {
 189         PMC *meth = find_meth(INTERP, SELF, "__newindex");
 190
 191         if (!meth)
 192             real_exception(INTERP, NULL, ILL_INHERIT,
 193                 "attempt to index a %Ss value", SELF.name());
 194
 195         if (dynpmc_LuaClosure  == PMC_type(meth)
 196         ||  dynpmc_LuaFunction == PMC_type(meth)) {
 197             Parrot_runops_fromc_args(INTERP, meth, "vPPP",
 198                                      SELF, key, value);
 199         }
 200         else
 201             VTABLE_set_pmc_keyed(INTERP, meth, key, value);
 202     }
 203
 204 /*
 205
 206 =item C<PMC* neg(PMC *dest)>
 207
 208 =item C<void i_neg()>
 209
 210 Throws an exception.
 211
 212 =cut
 213
 214 */
 215     PMC* neg(PMC *dest) {
 216         PMC *meth = find_meth(INTERP, SELF, "__unm");
 217
 218         if (!meth)
 219             real_exception(INTERP, NULL, ILL_INHERIT,
 220                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 221
 222         dest = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);
 223
 224         if (PMC_IS_NULL(dest))
 225             return pmc_new(INTERP, dynpmc_LuaNil);
 226
 227         return dest;
 228     }
 229
 230     void i_neg() {
 231         PMC *meth = find_meth(INTERP, SELF, "__unm");
 232
 233         if (!meth)
 234             real_exception(INTERP, NULL, ILL_INHERIT,
 235                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 236
 237         SELF = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);
 238
 239         if (PMC_IS_NULL(SELF))
 240                 SELF = pmc_new(INTERP, dynpmc_LuaNil);
 241     }
 242
 243 /*
 244
 245 =item C<PMC* logical_not(PMC *dest)>
 246
 247 Common implementation
 248
 249 =cut
 250
 251 */
 252     PMC* logical_not(PMC *dest) {
 253         dest = pmc_new(INTERP, dynpmc_LuaBoolean);
 254         VTABLE_set_bool(INTERP, dest, ! SELF.get_bool());
 255         return dest;
 256     }
 257
 258 /*
 259
 260 =item C<INTVAL defined()>
 261
 262 Always returns true.
 263
 264 =cut
 265
 266 */
 267     INTVAL defined() {
 268         return (INTVAL)1;
 269     }
 270
 271 /*
 272
 273 =item C<void* invoke(void* next)>
 274
 275 Throws an exception.
 276
 277 =cut
 278
 279 */
 280     opcode_t* invoke(void *next) {
 281         PMC *meth = find_meth(INTERP, SELF, "__call");
 282         PMC *retval;
 283
 284         if (!meth)
 285             real_exception(INTERP, NULL, ILL_INHERIT,
 286                 "attempt to call a %Ss value", SELF.name());
 287
 288             /* fix me */
 289 #if 1
 290             retval = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);
 291             if (!retval)
 292                 retval = pmc_new(INTERP, dynpmc_LuaNil);
 293 #else
 294             next = VTABLE_invoke(INTERP, meth, next);
 295 #endif
 296             return (opcode_t *)next;
 297     }
 298
 299 /*
 300
 301 =back
 302
 303 =head2 non-Vtable Methods
 304
 305 =over 4
 306
 307 =item C<void add(PMC *value, PMC *dest)>
 308
 309 =item C<void i_add(PMC *value)>
 310
 311 =item C<void subtract(PMC *value, PMC *dest)>
 312
 313 =item C<void i_substract (PMC *value)>
 314
 315 =item C<void multiply(PMC *value, PMC *dest)>
 316
 317 =item C<void i_multiply(PMC *value)>
 318
 319 =item C<void divide(PMC *value, PMC *dest)>
 320
 321 =item C<void i_divide(PMC *value)>
 322
 323 =item C<PMC* modulus(PMC *value, PMC *dest)>
 324
 325 =item C<void i_modulus(PMC *value)>
 326
 327 =item C<PMC* pow(PMC *value, PMC *dest)>
 328
 329 =item C<void i_pow(PMC *value)>
 330
 331 =item C<PMC* concatenate(PMC *value, PMC *dest)>
 332
 333 =item C<void i_concatenate(PMC *value)>
 334
 335 Throws an exception.
 336
 337 =cut
 338
 339 */
 340     PMC* add(PMC *value, PMC *dest) {
 341         PMC *meth = find_meth(INTERP, SELF, "__add");
 342         if (!meth)
 343             real_exception(INTERP, NULL, ILL_INHERIT,
 344                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 345
 346         dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 347
 348         if (PMC_IS_NULL(dest))
 349             return pmc_new(INTERP, dynpmc_LuaNil);
 350
 351         return dest;
 352     }
 353
 354     void i_add(PMC *value) {
 355         PMC *meth = find_meth(INTERP, SELF, "__add");
 356
 357         if (!meth)
 358             real_exception(INTERP, NULL, ILL_INHERIT,
 359                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 360
 361         SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 362         if (PMC_IS_NULL(SELF))
 363             SELF = pmc_new(INTERP, dynpmc_LuaNil);
 364     }
 365
 366     PMC* subtract(PMC *value, PMC *dest) {
 367         PMC *meth = find_meth(INTERP, SELF, "__sub");
 368         if (!meth)
 369             real_exception(INTERP, NULL, ILL_INHERIT,
 370                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 371
 372         dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 373
 374         if (PMC_IS_NULL(dest))
 375             return pmc_new(INTERP, dynpmc_LuaNil);
 376
 377         return dest;
 378     }
 379
 380     void i_subtract(PMC *value) {
 381         PMC *meth = find_meth(INTERP, SELF, "__sub");
 382         if (!meth)
 383             real_exception(INTERP, NULL, ILL_INHERIT,
 384                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 385
 386         SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 387
 388         if (PMC_IS_NULL(SELF))
 389             SELF = pmc_new(INTERP, dynpmc_LuaNil);
 390     }
 391
 392     PMC* multiply(PMC *value, PMC *dest) {
 393         PMC *meth = find_meth(INTERP, SELF, "__mul");
 394
 395         if (!meth)
 396             real_exception(INTERP, NULL, ILL_INHERIT,
 397                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 398
 399         dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 400
 401         if (PMC_IS_NULL(dest))
 402             return pmc_new(INTERP, dynpmc_LuaNil);
 403
 404         return dest;
 405     }
 406
 407     void i_multiply(PMC *value) {
 408         PMC *meth = find_meth(INTERP, SELF, "__mul");
 409
 410         if (!meth)
 411             real_exception(INTERP, NULL, ILL_INHERIT,
 412                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 413
 414         SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 415
 416         if (PMC_IS_NULL(SELF))
 417             SELF = pmc_new(INTERP, dynpmc_LuaNil);
 418     }
 419
 420     PMC* divide(PMC *value, PMC *dest) {
 421         PMC *meth = find_meth(INTERP, SELF, "__div");
 422
 423         if (!meth)
 424             real_exception(INTERP, NULL, ILL_INHERIT,
 425                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 426
 427         dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 428
 429         if (PMC_IS_NULL(dest))
 430             return pmc_new(INTERP, dynpmc_LuaNil);
 431
 432         return dest;
 433     }
 434
 435     void i_divide(PMC *value) {
 436         PMC *meth = find_meth(INTERP, SELF, "__div");
 437
 438         if (!meth)
 439             real_exception(INTERP, NULL, ILL_INHERIT,
 440                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 441
 442         SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 443
 444         if (PMC_IS_NULL(SELF))
 445             SELF = pmc_new(INTERP, dynpmc_LuaNil);
 446     }
 447
 448     PMC* modulus(PMC *value, PMC *dest) {
 449         PMC *meth = find_meth(INTERP, SELF, "__mod");
 450
 451         if (!meth)
 452             real_exception(INTERP, NULL, ILL_INHERIT,
 453                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 454
 455         dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 456
 457         if (PMC_IS_NULL(dest))
 458             return pmc_new(INTERP, dynpmc_LuaNil);
 459
 460         return dest;
 461     }
 462
 463     void i_modulus(PMC *value) {
 464         PMC *meth = find_meth(INTERP, SELF, "__mod");
 465
 466         if (!meth)
 467             real_exception(INTERP, NULL, ILL_INHERIT,
 468                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 469
 470         SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 471
 472         if (PMC_IS_NULL(SELF))
 473             SELF = pmc_new(INTERP, dynpmc_LuaNil);
 474     }
 475
 476     PMC* pow(PMC *value, PMC *dest) {
 477         PMC *meth = find_meth(INTERP, SELF, "__pow");
 478
 479         if (!meth)
 480             real_exception(INTERP, NULL, ILL_INHERIT,
 481                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 482
 483         dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 484
 485         if (PMC_IS_NULL(dest))
 486             return pmc_new(INTERP, dynpmc_LuaNil);
 487
 488         return dest;
 489     }
 490
 491     void i_pow(PMC *value) {
 492         PMC *meth = find_meth(INTERP, SELF, "__pow");
 493
 494         if (!meth)
 495             real_exception(INTERP, NULL, ILL_INHERIT,
 496                 "attempt to perform arithmetic on a %Ss value", SELF.name());
 497
 498         SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 499
 500         if (PMC_IS_NULL(SELF))
 501             SELF = pmc_new(INTERP, dynpmc_LuaNil);
 502     }
 503
 504     PMC* concatenate(PMC *value, PMC *dest) {
 505         PMC *meth = find_meth(INTERP, SELF, "__concat");
 506
 507         if (!meth)
 508             real_exception(INTERP, NULL, ILL_INHERIT,
 509                 "attempt to concatenate a %Ss value", SELF.name());
 510
 511         dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 512
 513         if (PMC_IS_NULL(dest))
 514             return pmc_new(INTERP, dynpmc_LuaNil);
 515
 516         return dest;
 517     }
 518
 519     void i_concatenate(PMC *value) {
 520         PMC *meth = find_meth(INTERP, SELF, "__concat");
 521         if (!meth)
 522             real_exception(INTERP, NULL, ILL_INHERIT,
 523                 "attempt to concatenate a %Ss value", SELF.name());
 524
 525         SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
 526
 527         if (PMC_IS_NULL(SELF))
 528             SELF = pmc_new(INTERP, dynpmc_LuaNil);
 529     }
 530
 531 /*
 532
 533 =item C<INTVAL is_equal(PMC *value)>
 534
 535 =cut
 536
 537 */
 538     INTVAL is_equal(PMC *value) {
 539         return (INTVAL)0;
 540     }
 541
 542 /*
 543
 544 =item C<INTVAL cmp(PMC *value)>
 545
 546 =cut
 547
 548 */
 549     INTVAL cmp(PMC *value) {
 550         STRING *self_name = SELF.name();
 551         STRING *val_name  = VTABLE_name(INTERP, value);
 552
 553         if (string_compare(INTERP, self_name, val_name) != 0)
 554             real_exception(INTERP, NULL, ILL_INHERIT,
 555                     "attempt to compare %Ss with %Ss", self_name, val_name);
 556         else
 557             real_exception(INTERP, NULL, ILL_INHERIT,
 558                     "attempt to compare two %Ss values", self_name);
 559     }
 560
 561 /*
 562
 563 =back
 564
 565 =head2 Specific Methods
 566
 567 =over 4
 568
 569 =item C<PMC *get_metatable()>
 570
 571 =cut
 572
 573 */
 574     METHOD PMC* get_metatable() {
 575         PMC *nil = pmc_new(INTERP, dynpmc_LuaNil);
 576         RETURN(PMC *nil);
 577     }
 578
 579 /*
 580
 581 =item C<PMC* len()>
 582
 583
 584 =cut
 585
 586 */
 587     METHOD PMC* len() {
 588         PMC *meth = find_meth(INTERP, SELF, "__len");
 589         PMC *retval;
 590
 591         if (!meth)
 592             real_exception(INTERP, NULL, ILL_INHERIT,
 593                 "attempt to get length of a %Ss value", SELF.name());
 594
 595         retval = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);
 596
 597         if (PMC_IS_NULL(retval))
 598             retval = pmc_new(INTERP, dynpmc_LuaNil);
 599
 600         RETURN(PMC *retval);
 601     }
 602
 603 /*
 604
 605 =item C<PMC* tonumber()>
 606
 607 Returns C<nil>.
 608
 609 =cut
 610
 611 */
 612     METHOD PMC* tonumber() {
 613         PMC *nil = pmc_new(INTERP, dynpmc_LuaNil);
 614         RETURN(PMC *nil);
 615     }
 616
 617 /*
 618
 619 =item C<PMC* tostring()>
 620
 621 Return a Lua C<string>.
 622
 623 Common implementation (use C<__tostring> or C<get_string>).
 624
 625 =cut
 626
 627 */
 628     METHOD PMC* tostring() {
 629         PMC *meth = find_meth(INTERP, SELF, "__tostring");
 630         PMC *retval;
 631
 632         if (meth) {
 633             retval = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);
 634
 635             if (PMC_IS_NULL(retval))
 636                 retval = pmc_new(INTERP, dynpmc_LuaNil);
 637         }
 638         else {
 639             retval = pmc_new(INTERP, dynpmc_LuaString);
 640             VTABLE_set_string_native(INTERP, retval, SELF.get_string());
 641         }
 642
 643         RETURN(PMC *retval);
 644     }
 645 }
 646
 647 /*
 648
 649 =back
 650
 651 =head1 AUTHORS
 652
 653 Francois Perrad.
 654
 655 =cut
 656
 657 */
 658
 659
 660 /*
 661  * Local variables:
 662  *   c-file-style: "parrot"
 663  * End:
 664  * vim: expandtab shiftwidth=4:
 665  */