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