xs-src/mouse_accessor.xs

   1 #include "mouse.h"
   2
   3 /* Moose XS Attribute object */
   4 enum mouse_xa_ix_t{
   5     MOUSE_XA_ATTRIBUTE,
   6     MOUSE_XA_TC,
   7     MOUSE_XA_TC_CODE,
   8
   9     MOUSE_XA_last
  10 };
  11
  12 #define MOUSE_xa_attribute(m) MOUSE_av_at(m, MOUSE_XA_ATTRIBUTE)
  13 #define MOUSE_xa_tc(m)        MOUSE_av_at(m, MOUSE_XA_TC)
  14 #define MOUSE_xa_tc_code(m)   MOUSE_av_at(m, MOUSE_XA_TC_CODE)
  15
  16 #define MOUSE_mg_attribute(mg) MOUSE_xa_attribute(MOUSE_mg_xa(mg))
  17
  18 enum mouse_xa_flags_t{
  19     MOUSEf_ATTR_HAS_TC          = 0x0001,
  20     MOUSEf_ATTR_HAS_DEFAULT     = 0x0002,
  21     MOUSEf_ATTR_HAS_BUILDER     = 0x0004,
  22     MOUSEf_ATTR_HAS_INITIALIZER = 0x0008, /* not used in Mouse */
  23     MOUSEf_ATTR_HAS_TRIGGER     = 0x0010,
  24
  25     MOUSEf_ATTR_IS_LAZY         = 0x0020,
  26     MOUSEf_ATTR_IS_WEAK_REF     = 0x0040,
  27     MOUSEf_ATTR_IS_REQUIRED     = 0x0080,
  28
  29     MOUSEf_ATTR_SHOULD_COERCE   = 0x0100,
  30
  31     MOUSEf_ATTR_SHOULD_AUTO_DEREF
  32                                 = 0x0200,
  33     MOUSEf_TC_IS_ARRAYREF       = 0x0400,
  34     MOUSEf_TC_IS_HASHREF        = 0x0800,
  35
  36     MOUSEf_OTHER1               = 0x1000,
  37     MOUSEf_OTHER2               = 0x2000,
  38     MOUSEf_OTHER3               = 0x4000,
  39     MOUSEf_OTHER4               = 0x8000,
  40
  41     MOUSEf_MOUSE_MASK           = 0xFFFF /* not used */
  42 };
  43
  44 static MGVTBL mouse_accessor_vtbl; /* MAGIC identity */
  45
  46 CV*
  47 mouse_instantiate_xs_accessor(pTHX_ SV* const attr, XSUBADDR_t const accessor_impl){
  48     SV* const slot = mcall0s(attr,  "name");
  49     AV* const xa = newAV();
  50     CV* xsub;
  51     MAGIC* mg;
  52     U16 flags = 0;
  53
  54     sv_2mortal((SV*)xa);
  55
  56     xsub = newXS(NULL, accessor_impl, __FILE__);
  57     sv_2mortal((SV*)xsub);
  58
  59     mg = sv_magicext((SV*)xsub, slot, PERL_MAGIC_ext, &mouse_accessor_vtbl, (char*)xa, HEf_SVKEY);
  60
  61     /* NOTE:
  62      * although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx)
  63      */
  64     CvXSUBANY(xsub).any_ptr = (void*)mg;
  65
  66     av_extend(xa, MOUSE_XA_last - 1);
  67
  68     av_store(xa, MOUSE_XA_ATTRIBUTE, newSVsv(attr));
  69
  70     /* prepare attribute status */
  71     /* XXX: making it lazy is a good way? */
  72
  73     if(SvTRUEx(mcall0s(attr, "has_type_constraint"))){
  74         SV* tc;
  75         flags |= MOUSEf_ATTR_HAS_TC;
  76
  77         ENTER;
  78         SAVETMPS;
  79
  80         tc = mcall0s(attr, "type_constraint");
  81         av_store(xa, MOUSE_XA_TC, newSVsv(tc));
  82
  83         if(SvTRUEx(mcall0s(attr, "should_auto_deref"))){
  84             flags |= MOUSEf_ATTR_SHOULD_AUTO_DEREF;
  85             if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("ArrayRef", SVs_TEMP))) ){
  86                 flags |= MOUSEf_TC_IS_ARRAYREF;
  87             }
  88             else if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("HashRef", SVs_TEMP))) ){
  89                 flags |= MOUSEf_TC_IS_HASHREF;
  90             }
  91             else{
  92                 mouse_throw_error(attr, tc,
  93                     "Can not auto de-reference the type constraint '%"SVf"'",
  94                         mcall0s(tc, "name"));
  95             }
  96         }
  97
  98         if(SvTRUEx(mcall0s(attr, "should_coerce"))){
  99             flags |= MOUSEf_ATTR_SHOULD_COERCE;
 100         }
 101
 102         FREETMPS;
 103         LEAVE;
 104     }
 105
 106     if(SvTRUEx(mcall0s(attr, "has_trigger"))){
 107         flags |= MOUSEf_ATTR_HAS_TRIGGER;
 108     }
 109
 110     if(SvTRUEx(mcall0s(attr, "is_lazy"))){
 111         flags |= MOUSEf_ATTR_IS_LAZY;
 112
 113         if(SvTRUEx(mcall0s(attr, "has_builder"))){
 114             flags |= MOUSEf_ATTR_HAS_BUILDER;
 115         }
 116         else if(SvTRUEx(mcall0s(attr, "has_default"))){
 117             flags |= MOUSEf_ATTR_HAS_DEFAULT;
 118         }
 119     }
 120
 121     if(SvTRUEx(mcall0s(attr, "is_weak_ref"))){
 122         flags |= MOUSEf_ATTR_IS_WEAK_REF;
 123     }
 124
 125     if(SvTRUEx(mcall0s(attr, "is_required"))){
 126         flags |= MOUSEf_ATTR_IS_REQUIRED;
 127     }
 128
 129     MOUSE_mg_flags(mg) = flags;
 130
 131     return xsub;
 132 }
 133
 134 static SV*
 135 mouse_apply_type_constraint(pTHX_ AV* const xa, SV* value, U16 const flags){
 136     SV* const tc = MOUSE_xa_tc(xa);
 137     SV* tc_code;
 138
 139     if(flags & MOUSEf_ATTR_SHOULD_COERCE){
 140           value = mcall1s(tc, "coerce", value);
 141     }
 142
 143     if(!SvOK(MOUSE_xa_tc_code(xa))){
 144         XS(XS_Mouse__Util__TypeConstraints_Item); /* prototype defined in Mouse.xs */
 145
 146         tc_code = mcall0s(tc, "_compiled_type_constraint");
 147
 148         if(SvROK(tc_code) && SvTYPE(SvRV(tc_code))
 149             && CvXSUB((CV*)SvRV(tc_code)) == XS_Mouse__Util__TypeConstraints_Item){
 150             /* built-in type constraints */
 151             mouse_tc const id = CvXSUBANY((CV*)SvRV(tc_code)).any_i32;
 152             av_store(xa, MOUSE_XA_TC_CODE, newSViv(id));
 153         }
 154         else{
 155             av_store(xa, MOUSE_XA_TC_CODE, newSVsv(tc_code));
 156         }
 157     }
 158     else{
 159         tc_code = MOUSE_xa_tc_code(xa);
 160     }
 161
 162     if(!mouse_tc_check(aTHX_ tc_code, value)){
 163         mouse_throw_error(MOUSE_xa_attribute(xa), value,
 164             "Attribute (%"SVf") does not pass the type constraint because: %"SVf,
 165                 mcall0s(MOUSE_xa_attribute(xa), "name"),
 166                 mcall1s(tc, "get_message", value));
 167     }
 168
 169     return value;
 170 }
 171
 172
 173 /* pushes return values, does auto-deref if needed */
 174 static void
 175 mouse_push_values(pTHX_ AV* const xa, SV* const value, U16 const flags){
 176     dSP;
 177     PERL_UNUSED_ARG(xa);
 178
 179     if(flags & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY){
 180         if(!(value && SvOK(value))){
 181             return;
 182         }
 183
 184         if(flags & MOUSEf_TC_IS_ARRAYREF){
 185             AV* const av = (AV*)SvRV(value);
 186             I32 len;
 187             I32 i;
 188
 189             if(SvTYPE(av) != SVt_PVAV){
 190                 croak("Mouse-panic: Not an ARRAY reference");
 191             }
 192
 193             len = av_len(av) + 1;
 194             EXTEND(SP, len);
 195             for(i = 0; i < len; i++){
 196                 SV** const svp = av_fetch(av, i, FALSE);
 197                 PUSHs(svp ? *svp : &PL_sv_undef);
 198             }
 199         }
 200         else if(flags & MOUSEf_TC_IS_HASHREF){
 201             HV* const hv = (HV*)SvRV(value);
 202             HE* he;
 203
 204             if(SvTYPE(hv) != SVt_PVHV){
 205                 croak("Mouse-panic: Not a HASH reference");
 206             }
 207
 208             hv_iterinit(hv);
 209             while((he = hv_iternext(hv))){
 210                 EXTEND(SP, 2);
 211                 PUSHs(hv_iterkeysv(he));
 212                 PUSHs(hv_iterval(hv, he));
 213             }
 214         }
 215     }
 216     else{
 217         XPUSHs(value ? value : &PL_sv_undef);
 218     }
 219
 220     PUTBACK;
 221 }
 222
 223 static void
 224 mouse_attr_get(pTHX_ SV* const self, MAGIC* const mg){
 225     AV* const xa    = MOUSE_mg_xa(mg);
 226     U16 const flags = MOUSE_mg_flags(mg);
 227     SV* const slot  = MOUSE_mg_slot(mg);
 228     SV* value;
 229
 230     value = mouse_instance_get_slot(aTHX_ self, slot);
 231
 232     /* check_lazy */
 233     if( !value && flags & MOUSEf_ATTR_IS_LAZY ){
 234         SV* const attr = MOUSE_xa_attribute(xa);
 235         /* get default value by $attr->default or $attr->builder */
 236         if(flags & MOUSEf_ATTR_HAS_DEFAULT){
 237             value = mcall0s(attr, "default");
 238
 239             if(SvROK(value) && SvTYPE(SvRV(value)) == SVt_PVCV){
 240                 value = mcall0(self, value);
 241             }
 242         }
 243         else if(flags & MOUSEf_ATTR_HAS_BUILDER){
 244             SV* const builder = mcall0s(attr, "builder");
 245             value = mcall0(self, builder);
 246         }
 247
 248         if(!value){
 249             value = sv_newmortal();
 250         }
 251
 252         /* apply coerce and type constraint */
 253         if(flags & MOUSEf_ATTR_HAS_TC){
 254             value = mouse_apply_type_constraint(aTHX_ xa, value, flags);
 255         }
 256
 257         /* store value to slot */
 258         value = mouse_instance_set_slot(aTHX_ self, slot, value);
 259     }
 260
 261     mouse_push_values(aTHX_ xa, value, flags);
 262 }
 263
 264 static void
 265 mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){
 266     AV* const xa    = MOUSE_mg_xa(mg);
 267     U16 const flags = MOUSE_mg_flags(mg);
 268     SV* const slot  = MOUSE_mg_slot(mg);
 269
 270     if(flags & MOUSEf_ATTR_HAS_TC){
 271         value = mouse_apply_type_constraint(aTHX_ xa, value, flags);
 272     }
 273
 274     mouse_instance_set_slot(aTHX_ self, slot, value);
 275
 276     if(flags & MOUSEf_ATTR_IS_WEAK_REF){
 277         mouse_instance_weaken_slot(aTHX_ self, slot);
 278     }
 279
 280     if(flags & MOUSEf_ATTR_HAS_TRIGGER){
 281         SV* const trigger = mcall0s(MOUSE_xa_attribute(xa), "trigger");
 282         dSP;
 283
 284         PUSHMARK(SP);
 285         EXTEND(SP, 2);
 286         PUSHs(self);
 287         PUSHs(value);
 288
 289         PUTBACK;
 290         call_sv(trigger, G_VOID | G_DISCARD);
 291         /* need not SPAGAIN */
 292     }
 293
 294     mouse_push_values(aTHX_ xa, value, flags);
 295 }
 296
 297 XS(mouse_xs_accessor)
 298 {
 299     dVAR; dXSARGS;
 300     dMOUSE_self;
 301     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 302
 303     SP -= items; /* PPCODE */
 304     PUTBACK;
 305
 306     if(items == 1){ /* reader */
 307         mouse_attr_get(aTHX_ self, mg);
 308     }
 309     else if (items == 2){ /* writer */
 310         mouse_attr_set(aTHX_ self, mg, ST(1));
 311     }
 312     else{
 313         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 314             "Expected exactly one or two argument for an accessor");
 315     }
 316 }
 317
 318
 319 XS(mouse_xs_reader)
 320 {
 321     dVAR; dXSARGS;
 322     dMOUSE_self;
 323     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 324
 325     if (items != 1) {
 326         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 327             "Cannot assign a value to a read-only accessor");
 328     }
 329
 330     SP -= items; /* PPCODE */
 331     PUTBACK;
 332
 333     mouse_attr_get(aTHX_ self, mg);
 334 }
 335
 336 XS(mouse_xs_writer)
 337 {
 338     dVAR; dXSARGS;
 339     dMOUSE_self;
 340     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 341
 342     if (items != 2) {
 343         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 344             "Too few arguments for a write-only accessor");
 345     }
 346
 347     SP -= items; /* PPCODE */
 348     PUTBACK;
 349
 350     mouse_attr_set(aTHX_ self, mg, ST(1));
 351 }