xs-src/MouseAccessor.xs

   1 #include "mouse.h"
   2
   3 #define CHECK_INSTANCE(instance) STMT_START{                          \
   4         if(!(SvROK(instance) && SvTYPE(SvRV(instance)) == SVt_PVHV)){ \
   5             croak("Invalid object instance");                         \
   6         }                                                             \
   7     } STMT_END
   8
   9 /* Mouse XS Attribute object */
  10 enum mouse_xa_ix_t{
  11     MOUSE_XA_SLOT,      /* for constructors, sync to mg_obj */
  12     MOUSE_XA_FLAGS,     /* for constructors, sync to mg_private */
  13     MOUSE_XA_ATTRIBUTE,
  14     MOUSE_XA_TC,
  15     MOUSE_XA_TC_CODE,
  16
  17     MOUSE_XA_last
  18 };
  19
  20 #define MOUSE_xa_attribute(m) MOUSE_av_at(m, MOUSE_XA_ATTRIBUTE)
  21 #define MOUSE_xa_tc(m)        MOUSE_av_at(m, MOUSE_XA_TC)
  22 #define MOUSE_xa_tc_code(m)   MOUSE_av_at(m, MOUSE_XA_TC_CODE)
  23
  24 #define MOUSE_mg_attribute(mg) MOUSE_xa_attribute(MOUSE_mg_xa(mg))
  25
  26 enum mouse_xa_flags_t{
  27     MOUSEf_ATTR_HAS_TC          = 0x0001,
  28     MOUSEf_ATTR_HAS_DEFAULT     = 0x0002,
  29     MOUSEf_ATTR_HAS_BUILDER     = 0x0004,
  30     MOUSEf_ATTR_HAS_INITIALIZER = 0x0008,
  31     MOUSEf_ATTR_HAS_TRIGGER     = 0x0010,
  32
  33     MOUSEf_ATTR_IS_LAZY         = 0x0020,
  34     MOUSEf_ATTR_IS_WEAK_REF     = 0x0040,
  35     MOUSEf_ATTR_IS_REQUIRED     = 0x0080,
  36
  37     MOUSEf_ATTR_SHOULD_COERCE   = 0x0100,
  38
  39     MOUSEf_ATTR_SHOULD_AUTO_DEREF
  40                                 = 0x0200,
  41     MOUSEf_TC_IS_ARRAYREF       = 0x0400,
  42     MOUSEf_TC_IS_HASHREF        = 0x0800,
  43
  44     MOUSEf_OTHER1               = 0x1000,
  45     MOUSEf_OTHER2               = 0x2000,
  46     MOUSEf_OTHER3               = 0x4000,
  47     MOUSEf_OTHER4               = 0x8000,
  48
  49     MOUSEf_MOUSE_MASK           = 0xFFFF /* not used */
  50 };
  51
  52 static MGVTBL mouse_accessor_vtbl; /* MAGIC identity */
  53
  54
  55 SV*
  56 mouse_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) {
  57     if(items < 1){
  58         croak("Too few arguments for %s", GvNAME(CvGV(cv)));
  59     }
  60
  61     /* NOTE: If self has GETMAGIC, $self->accessor will invoke GETMAGIC
  62      *       before calling methods, so SvGETMAGIC(self) is not necessarily needed here.
  63      */
  64
  65     return ST(0);
  66 }
  67
  68
  69 CV*
  70 mouse_instantiate_xs_accessor(pTHX_ SV* const attr, XSUBADDR_t const accessor_impl){
  71     SV* const slot = mcall0(attr,  mouse_name);
  72     AV* const xa = newAV();
  73     CV* xsub;
  74     MAGIC* mg;
  75     U16 flags = 0;
  76
  77     sv_2mortal((SV*)xa);
  78
  79     xsub = newXS(NULL, accessor_impl, __FILE__);
  80     sv_2mortal((SV*)xsub);
  81
  82     mg = sv_magicext((SV*)xsub, slot, PERL_MAGIC_ext, &mouse_accessor_vtbl, (char*)xa, HEf_SVKEY);
  83
  84     /* NOTE:
  85      * although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx)
  86      */
  87     CvXSUBANY(xsub).any_ptr = (void*)mg;
  88
  89     av_extend(xa, MOUSE_XA_last - 1);
  90
  91     av_store(xa, MOUSE_XA_ATTRIBUTE, newSVsv(attr));
  92
  93     /* prepare attribute status */
  94     /* XXX: making it lazy is a good way? */
  95
  96     if(SvTRUEx(mcall0s(attr, "has_type_constraint"))){
  97         SV* tc;
  98         flags |= MOUSEf_ATTR_HAS_TC;
  99
 100         ENTER;
 101         SAVETMPS;
 102
 103         tc = mcall0s(attr, "type_constraint");
 104         av_store(xa, MOUSE_XA_TC, newSVsv(tc));
 105
 106         if(SvTRUEx(mcall0s(attr, "should_auto_deref"))){
 107             flags |= MOUSEf_ATTR_SHOULD_AUTO_DEREF;
 108             if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("ArrayRef", SVs_TEMP))) ){
 109                 flags |= MOUSEf_TC_IS_ARRAYREF;
 110             }
 111             else if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("HashRef", SVs_TEMP))) ){
 112                 flags |= MOUSEf_TC_IS_HASHREF;
 113             }
 114             else{
 115                 mouse_throw_error(attr, tc,
 116                     "Can not auto de-reference the type constraint '%"SVf"'",
 117                         mcall0(tc, mouse_name));
 118             }
 119         }
 120
 121         if(SvTRUEx(mcall0s(attr, "should_coerce"))){
 122             flags |= MOUSEf_ATTR_SHOULD_COERCE;
 123         }
 124
 125         FREETMPS;
 126         LEAVE;
 127     }
 128
 129     if(SvTRUEx(mcall0s(attr, "has_trigger"))){
 130         flags |= MOUSEf_ATTR_HAS_TRIGGER;
 131     }
 132
 133     if(SvTRUEx(mcall0s(attr, "is_lazy"))){
 134         flags |= MOUSEf_ATTR_IS_LAZY;
 135
 136         if(SvTRUEx(mcall0s(attr, "has_builder"))){
 137             flags |= MOUSEf_ATTR_HAS_BUILDER;
 138         }
 139         else if(SvTRUEx(mcall0s(attr, "has_default"))){
 140             flags |= MOUSEf_ATTR_HAS_DEFAULT;
 141         }
 142     }
 143
 144     if(SvTRUEx(mcall0s(attr, "is_weak_ref"))){
 145         flags |= MOUSEf_ATTR_IS_WEAK_REF;
 146     }
 147
 148     if(SvTRUEx(mcall0s(attr, "is_required"))){
 149         flags |= MOUSEf_ATTR_IS_REQUIRED;
 150     }
 151
 152     MOUSE_mg_flags(mg) = flags;
 153
 154     return xsub;
 155 }
 156
 157 static SV*
 158 mouse_apply_type_constraint(pTHX_ AV* const xa, SV* value, U16 const flags){
 159     SV* const tc = MOUSE_xa_tc(xa);
 160     SV* tc_code;
 161
 162     if(flags & MOUSEf_ATTR_SHOULD_COERCE){
 163           value = mcall1s(tc, "coerce", value);
 164     }
 165
 166     if(!SvOK(MOUSE_xa_tc_code(xa))){
 167         tc_code = mcall0s(tc, "_compiled_type_constraint");
 168         av_store(xa, MOUSE_XA_TC_CODE, newSVsv(tc_code));
 169
 170         if(!IsCodeRef(tc_code)){
 171             mouse_throw_error(MOUSE_xa_attribute(xa), tc, "Not a CODE reference");
 172         }
 173     }
 174     else{
 175         tc_code = MOUSE_xa_tc_code(xa);
 176     }
 177
 178     if(!mouse_tc_check(aTHX_ tc_code, value)){
 179         mouse_throw_error(MOUSE_xa_attribute(xa), value,
 180             "Attribute (%"SVf") does not pass the type constraint because: %"SVf,
 181                 mcall0(MOUSE_xa_attribute(xa), mouse_name),
 182                 mcall1s(tc, "get_message", value));
 183     }
 184
 185     return value;
 186 }
 187
 188 #define PUSH_VALUE(value, flags) STMT_START { \
 189         if((flags) & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY){ \
 190             mouse_push_values(aTHX_ value, (flags));                       \
 191         }                                                                  \
 192         else{                                                              \
 193             dSP;                                                           \
 194             XPUSHs(value ? value : &PL_sv_undef);                          \
 195             PUTBACK;                                                       \
 196         }                                                                  \
 197     } STMT_END                                                             \
 198
 199 /* pushes return values, does auto-deref if needed */
 200 static void
 201 mouse_push_values(pTHX_ SV* const value, U16 const flags){
 202     dSP;
 203
 204     assert( flags & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY );
 205
 206     if(!(value && SvOK(value))){
 207         return;
 208     }
 209
 210     if(flags & MOUSEf_TC_IS_ARRAYREF){
 211         AV* av;
 212         I32 len;
 213         I32 i;
 214
 215         if(!IsArrayRef(value)){
 216             croak("Mouse-panic: Not an ARRAY reference");
 217         }
 218
 219         av  = (AV*)SvRV(value);
 220         len = av_len(av) + 1;
 221         EXTEND(SP, len);
 222         for(i = 0; i < len; i++){
 223             SV** const svp = av_fetch(av, i, FALSE);
 224             PUSHs(svp ? *svp : &PL_sv_undef);
 225         }
 226     }
 227     else if(flags & MOUSEf_TC_IS_HASHREF){
 228         HV* hv;
 229         HE* he;
 230
 231         if(!IsHashRef(value)){
 232             croak("Mouse-panic: Not a HASH reference");
 233         }
 234
 235         hv = (HV*)SvRV(value);
 236         hv_iterinit(hv);
 237         while((he = hv_iternext(hv))){
 238             EXTEND(SP, 2);
 239             PUSHs(hv_iterkeysv(he));
 240             PUSHs(hv_iterval(hv, he));
 241         }
 242     }
 243
 244     PUTBACK;
 245 }
 246
 247 static void
 248 mouse_attr_get(pTHX_ SV* const self, MAGIC* const mg){
 249     U16 const flags = MOUSE_mg_flags(mg);
 250     SV* const slot  = MOUSE_mg_slot(mg);
 251     SV* value;
 252
 253     value = get_slot(self, slot);
 254
 255     /* check_lazy */
 256     if( !value && flags & MOUSEf_ATTR_IS_LAZY ){
 257         AV* const xa   = MOUSE_mg_xa(mg);
 258         SV* const attr = MOUSE_xa_attribute(xa);
 259
 260         /* get default value by $attr->builder or $attr->default */
 261         if(flags & MOUSEf_ATTR_HAS_BUILDER){
 262             SV* const builder = mcall0s(attr, "builder");
 263             value = mcall0(self, builder);
 264         }
 265         else {
 266             value = mcall0s(attr, "default");
 267
 268             if(IsCodeRef(value)){
 269                 value = mcall0(self, value);
 270             }
 271         }
 272
 273         /* apply coerce and type constraint */
 274         if(flags & MOUSEf_ATTR_HAS_TC){
 275             value = mouse_apply_type_constraint(aTHX_ xa, value, flags);
 276         }
 277
 278         /* store value to slot */
 279         value = set_slot(self, slot, value);
 280     }
 281
 282     PUSH_VALUE(value, flags);
 283 }
 284
 285 static void
 286 mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){
 287     U16 const flags = MOUSE_mg_flags(mg);
 288     SV* const slot  = MOUSE_mg_slot(mg);
 289
 290     if(flags & MOUSEf_ATTR_HAS_TC){
 291         value = mouse_apply_type_constraint(aTHX_ MOUSE_mg_xa(mg), value, flags);
 292     }
 293
 294     set_slot(self, slot, value);
 295
 296     if(flags & MOUSEf_ATTR_IS_WEAK_REF){
 297         weaken_slot(self, slot);
 298     }
 299
 300     if(flags & MOUSEf_ATTR_HAS_TRIGGER){
 301         SV* const trigger = mcall0s(MOUSE_mg_attribute(mg), "trigger");
 302         dSP;
 303
 304         PUSHMARK(SP);
 305         EXTEND(SP, 2);
 306         PUSHs(self);
 307         PUSHs(value);
 308
 309         PUTBACK;
 310         call_sv(trigger, G_VOID | G_DISCARD);
 311         /* need not SPAGAIN */
 312     }
 313
 314     PUSH_VALUE(value, flags);
 315 }
 316
 317 XS(XS_Mouse_accessor)
 318 {
 319     dVAR; dXSARGS;
 320     dMOUSE_self;
 321     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 322
 323     SP -= items; /* PPCODE */
 324     PUTBACK;
 325
 326     if(items == 1){ /* reader */
 327         mouse_attr_get(aTHX_ self, mg);
 328     }
 329     else if (items == 2){ /* writer */
 330         mouse_attr_set(aTHX_ self, mg, ST(1));
 331     }
 332     else{
 333         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 334             "Expected exactly one or two argument for an accessor");
 335     }
 336 }
 337
 338
 339 XS(XS_Mouse_reader)
 340 {
 341     dVAR; dXSARGS;
 342     dMOUSE_self;
 343     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 344
 345     if (items != 1) {
 346         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 347             "Cannot assign a value to a read-only accessor");
 348     }
 349
 350     SP -= items; /* PPCODE */
 351     PUTBACK;
 352
 353     mouse_attr_get(aTHX_ self, mg);
 354 }
 355
 356 XS(XS_Mouse_writer)
 357 {
 358     dVAR; dXSARGS;
 359     dMOUSE_self;
 360     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 361
 362     if (items != 2) {
 363         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 364             "Too few arguments for a write-only accessor");
 365     }
 366
 367     SP -= items; /* PPCODE */
 368     PUTBACK;
 369
 370     mouse_attr_set(aTHX_ self, mg, ST(1));
 371 }
 372
 373 /* simple accessors */
 374
 375 /*
 376 static MAGIC*
 377 mouse_accessor_get_mg(pTHX_ CV* const xsub){
 378     return moose_mg_find(aTHX_ (SV*)xsub, &mouse_simple_accessor_vtbl, MOOSEf_DIE_ON_FAIL);
 379 }
 380 */
 381
 382 CV*
 383 mouse_install_simple_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl){
 384     CV* const xsub = newXS((char*)fq_name, accessor_impl, __FILE__);
 385     SV* const slot = newSVpvn_share(key, keylen, 0U);
 386     MAGIC* mg;
 387
 388     if(!fq_name){
 389         /* anonymous xsubs need sv_2mortal */
 390         sv_2mortal((SV*)xsub);
 391     }
 392
 393     mg = sv_magicext((SV*)xsub, slot, PERL_MAGIC_ext, &mouse_accessor_vtbl, NULL, 0);
 394     SvREFCNT_dec(slot); /* sv_magicext() increases refcnt in mg_obj */
 395
 396     /* NOTE:
 397      * although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx)
 398      */
 399     CvXSUBANY(xsub).any_ptr = (void*)mg;
 400
 401     return xsub;
 402 }
 403
 404 XS(XS_Mouse_simple_reader)
 405 {
 406     dVAR; dXSARGS;
 407     dMOUSE_self;
 408     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
 409     SV* value;
 410
 411     if (items != 1) {
 412         croak("Expected exactly one argument for a reader for '%"SVf"'", slot);
 413     }
 414
 415     value = get_slot(self, slot);
 416     ST(0) = value ? value : &PL_sv_undef;
 417     XSRETURN(1);
 418 }
 419
 420
 421 XS(XS_Mouse_simple_writer)
 422 {
 423     dVAR; dXSARGS;
 424     dMOUSE_self;
 425     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
 426
 427     if (items != 2) {
 428         croak("Expected exactly two argument for a writer for '%"SVf"'", slot);
 429     }
 430
 431     ST(0) = set_slot(self, slot, ST(1));
 432     XSRETURN(1);
 433 }
 434
 435 XS(XS_Mouse_simple_clearer)
 436 {
 437     dVAR; dXSARGS;
 438     dMOUSE_self;
 439     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
 440     SV* value;
 441
 442     if (items != 1) {
 443         croak("Expected exactly one argument for a clearer for '%"SVf"'", slot);
 444     }
 445
 446     value = delete_slot(self, slot);
 447     ST(0) = value ? value : &PL_sv_undef;
 448     XSRETURN(1);
 449 }
 450
 451 XS(XS_Mouse_simple_predicate)
 452 {
 453     dVAR; dXSARGS;
 454     dMOUSE_self;
 455     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
 456
 457     if (items != 1) {
 458         croak("Expected exactly one argument for a predicate for '%"SVf"'", slot);
 459     }
 460
 461     ST(0) = boolSV( has_slot(self, slot) );
 462     XSRETURN(1);
 463 }
 464
 465 /* simple instance slot accessor (or Mouse::Meta::Instance) */
 466
 467 SV*
 468 mouse_instance_create(pTHX_ HV* const stash) {
 469     assert(stash);
 470     return sv_bless( newRV_noinc((SV*)newHV()), stash );
 471 }
 472
 473 SV*
 474 mouse_instance_clone(pTHX_ SV* const instance) {
 475     HV* proto;
 476     assert(instance);
 477
 478     CHECK_INSTANCE(instance);
 479     proto = newHVhv((HV*)SvRV(instance));
 480     return sv_bless( newRV_noinc((SV*)proto), SvSTASH(SvRV(instance)) );
 481 }
 482
 483 bool
 484 mouse_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
 485     assert(instance);
 486     assert(slot);
 487     CHECK_INSTANCE(instance);
 488     return hv_exists_ent((HV*)SvRV(instance), slot, 0U);
 489 }
 490
 491 SV*
 492 mouse_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
 493     HE* he;
 494     assert(instance);
 495     assert(slot);
 496     CHECK_INSTANCE(instance);
 497     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
 498     return he ? HeVAL(he) : NULL;
 499 }
 500
 501 SV*
 502 mouse_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value) {
 503     HE* he;
 504     SV* sv;
 505     assert(instance);
 506     assert(slot);
 507     assert(value);
 508     CHECK_INSTANCE(instance);
 509     he = hv_fetch_ent((HV*)SvRV(instance), slot, TRUE, 0U);
 510     sv = HeVAL(he);
 511     sv_setsv_mg(sv, value);
 512     return sv;
 513 }
 514
 515 SV*
 516 mouse_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
 517     assert(instance);
 518     assert(slot);
 519     CHECK_INSTANCE(instance);
 520     return hv_delete_ent((HV*)SvRV(instance), slot, 0, 0U);
 521 }
 522
 523 void
 524 mouse_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
 525     HE* he;
 526     assert(instance);
 527     assert(slot);
 528     CHECK_INSTANCE(instance);
 529     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
 530     if(he){
 531         sv_rvweaken(HeVAL(he));
 532     }
 533 }
 534 \r
 535 MODULE = Mouse::Meta::Method::Accessor::XS  PACKAGE = Mouse::Meta::Method::Accessor::XS
 536
 537 PROTOTYPES:   DISABLE
 538 VERSIONCHECK: DISABLE
 539
 540 CV*
 541 _generate_accessor(klass, SV* attr, metaclass)
 542 CODE:
 543 {
 544     RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, XS_Mouse_accessor);
 545 }
 546 OUTPUT:
 547     RETVAL
 548
 549 CV*
 550 _generate_reader(klass, SV* attr, metaclass)
 551 CODE:
 552 {
 553     RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, XS_Mouse_reader);
 554 }
 555 OUTPUT:
 556     RETVAL
 557
 558 CV*
 559 _generate_writer(klass, SV* attr, metaclass)
 560 CODE:
 561 {
 562     RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, XS_Mouse_writer);
 563 }
 564 OUTPUT:
 565     RETVAL
 566
 567 CV*
 568 _generate_clearer(klass, SV* attr, metaclass)
 569 CODE:
 570 {
 571     SV* const slot = mcall0s(attr, "name");
 572     STRLEN len;
 573     const char* const pv = SvPV_const(slot, len);
 574     RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, XS_Mouse_simple_clearer);
 575 }
 576 OUTPUT:
 577     RETVAL
 578
 579 CV*
 580 _generate_predicate(klass, SV* attr, metaclass)
 581 CODE:
 582 {
 583     SV* const slot = mcall0s(attr, "name");
 584     STRLEN len;
 585     const char* const pv = SvPV_const(slot, len);
 586     RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, XS_Mouse_simple_predicate);
 587 }
 588 OUTPUT:
 589     RETVAL
 590