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 /* 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     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         XS(XS_Mouse__Util__TypeConstraints_Item); /* prototype defined in Mouse.xs */
 168
 169         tc_code = mcall0s(tc, "_compiled_type_constraint");
 170
 171         if(SvROK(tc_code) && SvTYPE(SvRV(tc_code))
 172             && CvXSUB((CV*)SvRV(tc_code)) == XS_Mouse__Util__TypeConstraints_Item){
 173             /* built-in type constraints */
 174             mouse_tc const id = CvXSUBANY((CV*)SvRV(tc_code)).any_i32;
 175             av_store(xa, MOUSE_XA_TC_CODE, newSViv(id));
 176         }
 177         else{
 178             av_store(xa, MOUSE_XA_TC_CODE, newSVsv(tc_code));
 179         }
 180     }
 181     else{
 182         tc_code = MOUSE_xa_tc_code(xa);
 183     }
 184
 185     if(!mouse_tc_check(aTHX_ tc_code, value)){
 186         mouse_throw_error(MOUSE_xa_attribute(xa), value,
 187             "Attribute (%"SVf") does not pass the type constraint because: %"SVf,
 188                 mcall0(MOUSE_xa_attribute(xa), mouse_name),
 189                 mcall1s(tc, "get_message", value));
 190     }
 191
 192     return value;
 193 }
 194
 195 #define PUSH_VALUE(value, flags) STMT_START { \
 196         if((flags) & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY){ \
 197             mouse_push_values(aTHX_ value, (flags));                       \
 198         }                                                                  \
 199         else{                                                              \
 200             dSP;                                                           \
 201             XPUSHs(value ? value : &PL_sv_undef);                          \
 202             PUTBACK;                                                       \
 203         }                                                                  \
 204     } STMT_END                                                             \
 205
 206 /* pushes return values, does auto-deref if needed */
 207 static void
 208 mouse_push_values(pTHX_ SV* const value, U16 const flags){
 209     dSP;
 210
 211     assert( flags & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY );
 212
 213     if(!(value && SvOK(value))){
 214         return;
 215     }
 216
 217     if(flags & MOUSEf_TC_IS_ARRAYREF){
 218         AV* const av = (AV*)SvRV(value);
 219         I32 len;
 220         I32 i;
 221
 222         if(SvTYPE(av) != SVt_PVAV){
 223             croak("Mouse-panic: Not an ARRAY reference");
 224         }
 225
 226         len = av_len(av) + 1;
 227         EXTEND(SP, len);
 228         for(i = 0; i < len; i++){
 229             SV** const svp = av_fetch(av, i, FALSE);
 230             PUSHs(svp ? *svp : &PL_sv_undef);
 231         }
 232     }
 233     else if(flags & MOUSEf_TC_IS_HASHREF){
 234         HV* const hv = (HV*)SvRV(value);
 235         HE* he;
 236
 237         if(SvTYPE(hv) != SVt_PVHV){
 238             croak("Mouse-panic: Not a HASH reference");
 239         }
 240
 241         hv_iterinit(hv);
 242         while((he = hv_iternext(hv))){
 243             EXTEND(SP, 2);
 244             PUSHs(hv_iterkeysv(he));
 245             PUSHs(hv_iterval(hv, he));
 246         }
 247     }
 248
 249     PUTBACK;
 250 }
 251
 252 static void
 253 mouse_attr_get(pTHX_ SV* const self, MAGIC* const mg){
 254     U16 const flags = MOUSE_mg_flags(mg);
 255     SV* const slot  = MOUSE_mg_slot(mg);
 256     SV* value;
 257
 258     value = mouse_instance_get_slot(aTHX_ self, slot);
 259
 260     /* check_lazy */
 261     if( !value && flags & MOUSEf_ATTR_IS_LAZY ){
 262         AV* const xa    = MOUSE_mg_xa(mg);
 263         SV* const attr = MOUSE_xa_attribute(xa);
 264
 265         /* get default value by $attr->default or $attr->builder */
 266         if(flags & MOUSEf_ATTR_HAS_DEFAULT){
 267             value = mcall0s(attr, "default");
 268
 269             if(SvROK(value) && SvTYPE(SvRV(value)) == SVt_PVCV){
 270                 value = mcall0(self, value);
 271             }
 272         }
 273         else if(flags & MOUSEf_ATTR_HAS_BUILDER){
 274             SV* const builder = mcall0s(attr, "builder");
 275             value = mcall0(self, builder);
 276         }
 277
 278         if(!value){
 279             value = sv_newmortal();
 280         }
 281
 282         /* apply coerce and type constraint */
 283         if(flags & MOUSEf_ATTR_HAS_TC){
 284             value = mouse_apply_type_constraint(aTHX_ xa, value, flags);
 285         }
 286
 287         /* store value to slot */
 288         value = mouse_instance_set_slot(aTHX_ self, slot, value);
 289     }
 290
 291     PUSH_VALUE(value, flags);
 292 }
 293
 294 static void
 295 mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){
 296     U16 const flags = MOUSE_mg_flags(mg);
 297     SV* const slot  = MOUSE_mg_slot(mg);
 298
 299     if(flags & MOUSEf_ATTR_HAS_TC){
 300         value = mouse_apply_type_constraint(aTHX_ MOUSE_mg_xa(mg), value, flags);
 301     }
 302
 303     mouse_instance_set_slot(aTHX_ self, slot, value);
 304
 305     if(flags & MOUSEf_ATTR_IS_WEAK_REF){
 306         mouse_instance_weaken_slot(aTHX_ self, slot);
 307     }
 308
 309     if(flags & MOUSEf_ATTR_HAS_TRIGGER){
 310         SV* const trigger = mcall0s(MOUSE_mg_attribute(mg), "trigger");
 311         dSP;
 312
 313         PUSHMARK(SP);
 314         EXTEND(SP, 2);
 315         PUSHs(self);
 316         PUSHs(value);
 317
 318         PUTBACK;
 319         call_sv(trigger, G_VOID | G_DISCARD);
 320         /* need not SPAGAIN */
 321     }
 322
 323     PUSH_VALUE(value, flags);
 324 }
 325
 326 XS(mouse_xs_accessor)
 327 {
 328     dVAR; dXSARGS;
 329     dMOUSE_self;
 330     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 331
 332     SP -= items; /* PPCODE */
 333     PUTBACK;
 334
 335     if(items == 1){ /* reader */
 336         mouse_attr_get(aTHX_ self, mg);
 337     }
 338     else if (items == 2){ /* writer */
 339         mouse_attr_set(aTHX_ self, mg, ST(1));
 340     }
 341     else{
 342         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 343             "Expected exactly one or two argument for an accessor");
 344     }
 345 }
 346
 347
 348 XS(mouse_xs_reader)
 349 {
 350     dVAR; dXSARGS;
 351     dMOUSE_self;
 352     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 353
 354     if (items != 1) {
 355         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 356             "Cannot assign a value to a read-only accessor");
 357     }
 358
 359     SP -= items; /* PPCODE */
 360     PUTBACK;
 361
 362     mouse_attr_get(aTHX_ self, mg);
 363 }
 364
 365 XS(mouse_xs_writer)
 366 {
 367     dVAR; dXSARGS;
 368     dMOUSE_self;
 369     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 370
 371     if (items != 2) {
 372         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 373             "Too few arguments for a write-only accessor");
 374     }
 375
 376     SP -= items; /* PPCODE */
 377     PUTBACK;
 378
 379     mouse_attr_set(aTHX_ self, mg, ST(1));
 380 }
 381
 382 /* simple accessors */
 383
 384 /*
 385 static MAGIC*
 386 mouse_accessor_get_mg(pTHX_ CV* const xsub){
 387     return moose_mg_find(aTHX_ (SV*)xsub, &mouse_simple_accessor_vtbl, MOOSEf_DIE_ON_FAIL);
 388 }
 389 */
 390
 391 CV*
 392 mouse_install_simple_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl){
 393     CV* const xsub = newXS((char*)fq_name, accessor_impl, __FILE__);
 394     SV* const slot = newSVpvn_share(key, keylen, 0U);
 395     MAGIC* mg;
 396
 397     if(!fq_name){
 398         /* anonymous xsubs need sv_2mortal */
 399         sv_2mortal((SV*)xsub);
 400     }
 401
 402     mg = sv_magicext((SV*)xsub, slot, PERL_MAGIC_ext, &mouse_accessor_vtbl, NULL, 0);
 403     SvREFCNT_dec(slot); /* sv_magicext() increases refcnt in mg_obj */
 404
 405     /* NOTE:
 406      * although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx)
 407      */
 408     CvXSUBANY(xsub).any_ptr = (void*)mg;
 409
 410     return xsub;
 411 }
 412
 413 XS(mouse_xs_simple_reader)
 414 {
 415     dVAR; dXSARGS;
 416     dMOUSE_self;
 417     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
 418     SV* value;
 419
 420     if (items != 1) {
 421         croak("Expected exactly one argument for a reader for '%"SVf"'", slot);
 422     }
 423
 424     value = mouse_instance_get_slot(aTHX_ self, slot);
 425     ST(0) = value ? value : &PL_sv_undef;
 426     XSRETURN(1);
 427 }
 428
 429
 430 XS(mouse_xs_simple_writer)
 431 {
 432     dVAR; dXSARGS;
 433     dMOUSE_self;
 434     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
 435
 436     if (items != 2) {
 437         croak("Expected exactly two argument for a writer for '%"SVf"'", slot);
 438     }
 439
 440     ST(0) = mouse_instance_set_slot(aTHX_ self, slot, ST(1));
 441     XSRETURN(1);
 442 }
 443
 444 XS(mouse_xs_simple_clearer)
 445 {
 446     dVAR; dXSARGS;
 447     dMOUSE_self;
 448     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
 449     SV* value;
 450
 451     if (items != 1) {
 452         croak("Expected exactly one argument for a clearer for '%"SVf"'", slot);
 453     }
 454
 455     value = mouse_instance_delete_slot(aTHX_ self, slot);
 456     ST(0) = value ? value : &PL_sv_undef;
 457     XSRETURN(1);
 458 }
 459
 460 XS(mouse_xs_simple_predicate)
 461 {
 462     dVAR; dXSARGS;
 463     dMOUSE_self;
 464     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
 465
 466     if (items != 1) {
 467         croak("Expected exactly one argument for a predicate for '%"SVf"'", slot);
 468     }
 469
 470     ST(0) = boolSV( mouse_instance_has_slot(aTHX_ self, slot) );
 471     XSRETURN(1);
 472 }
 473
 474 /* simple instance slot accessor (or Mouse::Meta::Instance) */
 475
 476 SV*
 477 mouse_instance_create(pTHX_ HV* const stash) {
 478     assert(stash);
 479     return sv_bless( newRV_noinc((SV*)newHV()), stash );
 480 }
 481
 482 SV*
 483 mouse_instance_clone(pTHX_ SV* const instance) {
 484     HV* proto;
 485     assert(instance);
 486
 487     CHECK_INSTANCE(instance);
 488     proto = newHVhv((HV*)SvRV(instance));
 489     return sv_bless( newRV_noinc((SV*)proto), SvSTASH(SvRV(instance)) );
 490 }
 491
 492 bool
 493 mouse_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
 494     assert(instance);
 495     assert(slot);
 496     CHECK_INSTANCE(instance);
 497     return hv_exists_ent((HV*)SvRV(instance), slot, 0U);
 498 }
 499
 500 SV*
 501 mouse_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
 502     HE* he;
 503     assert(instance);
 504     assert(slot);
 505     CHECK_INSTANCE(instance);
 506     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
 507     return he ? HeVAL(he) : NULL;
 508 }
 509
 510 SV*
 511 mouse_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value) {
 512     HE* he;
 513     SV* sv;
 514     assert(instance);
 515     assert(slot);
 516     assert(value);
 517     CHECK_INSTANCE(instance);
 518     he = hv_fetch_ent((HV*)SvRV(instance), slot, TRUE, 0U);
 519     sv = HeVAL(he);
 520     sv_setsv_mg(sv, value);
 521     return sv;
 522 }
 523
 524 SV*
 525 mouse_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
 526     assert(instance);
 527     assert(slot);
 528     CHECK_INSTANCE(instance);
 529     return hv_delete_ent((HV*)SvRV(instance), slot, 0, 0U);
 530 }
 531
 532 void
 533 mouse_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
 534     HE* he;
 535     assert(instance);
 536     assert(slot);
 537     CHECK_INSTANCE(instance);
 538     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
 539     if(he){
 540         sv_rvweaken(HeVAL(he));
 541     }
 542 }
 543 \r
 544 MODULE = Mouse::Meta::Method::Accessor::XS  PACKAGE = Mouse::Meta::Method::Accessor::XS
 545
 546 PROTOTYPES:   DISABLE
 547 VERSIONCHECK: DISABLE
 548
 549 CV*
 550 _generate_accessor(klass, SV* attr, metaclass)
 551 CODE:
 552 {
 553     RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_accessor);
 554 }
 555 OUTPUT:
 556     RETVAL
 557
 558 CV*
 559 _generate_reader(klass, SV* attr, metaclass)
 560 CODE:
 561 {
 562     RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_reader);
 563 }
 564 OUTPUT:
 565     RETVAL
 566
 567 CV*
 568 _generate_writer(klass, SV* attr, metaclass)
 569 CODE:
 570 {
 571     RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_writer);
 572 }
 573 OUTPUT:
 574     RETVAL
 575
 576 CV*
 577 _generate_clearer(klass, SV* attr, metaclass)
 578 CODE:
 579 {
 580     SV* const slot = mcall0s(attr, "name");
 581     STRLEN len;
 582     const char* const pv = SvPV_const(slot, len);
 583     RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, mouse_xs_simple_clearer);
 584 }
 585 OUTPUT:
 586     RETVAL
 587
 588 CV*
 589 _generate_predicate(klass, SV* attr, metaclass)
 590 CODE:
 591 {
 592     SV* const slot = mcall0s(attr, "name");
 593     STRLEN len;
 594     const char* const pv = SvPV_const(slot, len);
 595     RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, mouse_xs_simple_predicate);
 596 }
 597 OUTPUT:
 598     RETVAL
 599