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