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