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