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     int ok;
 139
 140     if(flags & MOUSEf_ATTR_SHOULD_COERCE){
 141           value = mcall1s(tc, "coerce", value);
 142     }
 143
 144     if(!SvOK(MOUSE_xa_tc_code(xa))){
 145         XS(XS_Mouse__Util__TypeConstraints_Item); /* prototype defined in Mouse.xs */
 146
 147         tc_code = mcall0s(tc, "_compiled_type_constraint");
 148
 149         if(SvROK(tc_code) && SvTYPE(SvRV(tc_code))
 150             && CvXSUB((CV*)SvRV(tc_code)) == XS_Mouse__Util__TypeConstraints_Item){
 151             /* built-in type constraints */
 152             mouse_tc const id = CvXSUBANY((CV*)SvRV(tc_code)).any_i32;
 153             av_store(xa, MOUSE_XA_TC_CODE, newSViv(id));
 154         }
 155         else{
 156             av_store(xa, MOUSE_XA_TC_CODE, newSVsv(tc_code));
 157         }
 158     }
 159     else{
 160         tc_code = MOUSE_xa_tc_code(xa);
 161     }
 162
 163     if(SvIOK(tc_code)){ /* built-in type constraints */
 164         ok = mouse_tc_check(aTHX_ SvIVX(tc_code), value);
 165     }
 166     else {
 167         dSP;
 168
 169         ENTER;
 170         SAVETMPS;
 171
 172         PUSHMARK(SP);
 173         XPUSHs(value);
 174         PUTBACK;
 175
 176         call_sv(tc_code, G_SCALAR);
 177
 178         SPAGAIN;
 179         ok = SvTRUEx(POPs);
 180         PUTBACK;
 181
 182         FREETMPS;
 183         LEAVE;
 184     }
 185
 186     if(!ok){
 187         mouse_throw_error(MOUSE_xa_attribute(xa), value,
 188             "Attribute (%"SVf") does not pass the type constraint because: %"SVf,
 189                 mcall0s(MOUSE_xa_attribute(xa), "name"),
 190                 mcall1s(tc, "get_message", value));
 191     }
 192
 193     return value;
 194 }
 195
 196
 197 /* pushes return values, does auto-deref if needed */
 198 static void
 199 mouse_push_values(pTHX_ AV* const xa, SV* const value, U16 const flags){
 200     dSP;
 201     PERL_UNUSED_ARG(xa);
 202
 203     if(flags & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY){
 204         if(!(value && SvOK(value))){
 205             return;
 206         }
 207
 208         if(flags & MOUSEf_TC_IS_ARRAYREF){
 209             AV* const av = (AV*)SvRV(value);
 210             I32 len;
 211             I32 i;
 212
 213             if(SvTYPE(av) != SVt_PVAV){
 214                 croak("Mouse-panic: Not an ARRAY reference");
 215             }
 216
 217             len = av_len(av) + 1;
 218             EXTEND(SP, len);
 219             for(i = 0; i < len; i++){
 220                 SV** const svp = av_fetch(av, i, FALSE);
 221                 PUSHs(svp ? *svp : &PL_sv_undef);
 222             }
 223         }
 224         else if(flags & MOUSEf_TC_IS_HASHREF){
 225             HV* const hv = (HV*)SvRV(value);
 226             HE* he;
 227
 228             if(SvTYPE(hv) != SVt_PVHV){
 229                 croak("Mouse-panic: Not a HASH reference");
 230             }
 231
 232             hv_iterinit(hv);
 233             while((he = hv_iternext(hv))){
 234                 EXTEND(SP, 2);
 235                 PUSHs(hv_iterkeysv(he));
 236                 PUSHs(hv_iterval(hv, he));
 237             }
 238         }
 239     }
 240     else{
 241         XPUSHs(value ? value : &PL_sv_undef);
 242     }
 243
 244     PUTBACK;
 245 }
 246
 247 static void
 248 mouse_attr_get(pTHX_ SV* const self, MAGIC* const mg){
 249     AV* const xa    = MOUSE_mg_xa(mg);
 250     U16 const flags = MOUSE_mg_flags(mg);
 251     SV* const slot  = MOUSE_mg_slot(mg);
 252     SV* value;
 253
 254     value = mouse_instance_get_slot(aTHX_ self, slot);
 255
 256     /* check_lazy */
 257     if( !value && flags & MOUSEf_ATTR_IS_LAZY ){
 258         SV* const attr = MOUSE_xa_attribute(xa);
 259         /* get default value by $attr->default or $attr->builder */
 260         if(flags & MOUSEf_ATTR_HAS_DEFAULT){
 261             value = mcall0s(attr, "default");
 262
 263             if(SvROK(value) && SvTYPE(SvRV(value)) == SVt_PVCV){
 264                 value = mcall0(self, value);
 265             }
 266         }
 267         else if(flags & MOUSEf_ATTR_HAS_BUILDER){
 268             SV* const builder = mcall0s(attr, "builder");
 269             value = mcall0(self, builder);
 270         }
 271
 272         if(!value){
 273             value = sv_newmortal();
 274         }
 275
 276         /* apply coerce and type constraint */
 277         if(flags & MOUSEf_ATTR_HAS_TC){
 278             value = mouse_apply_type_constraint(aTHX_ xa, value, flags);
 279         }
 280
 281         /* store value to slot */
 282         value = mouse_instance_set_slot(aTHX_ self, slot, value);
 283     }
 284
 285     mouse_push_values(aTHX_ xa, value, flags);
 286 }
 287
 288 static void
 289 mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){
 290     AV* const xa    = MOUSE_mg_xa(mg);
 291     U16 const flags = MOUSE_mg_flags(mg);
 292     SV* const slot  = MOUSE_mg_slot(mg);
 293
 294     if(flags & MOUSEf_ATTR_HAS_TC){
 295         value = mouse_apply_type_constraint(aTHX_ xa, value, flags);
 296     }
 297
 298     mouse_instance_set_slot(aTHX_ self, slot, value);
 299
 300     if(flags & MOUSEf_ATTR_IS_WEAK_REF){
 301         mouse_instance_weaken_slot(aTHX_ self, slot);
 302     }
 303
 304     if(flags & MOUSEf_ATTR_HAS_TRIGGER){
 305         SV* const trigger = mcall0s(MOUSE_xa_attribute(xa), "trigger");
 306         dSP;
 307
 308         PUSHMARK(SP);
 309         EXTEND(SP, 2);
 310         PUSHs(self);
 311         PUSHs(value);
 312
 313         PUTBACK;
 314         call_sv(trigger, G_VOID | G_DISCARD);
 315         /* need not SPAGAIN */
 316     }
 317
 318     mouse_push_values(aTHX_ xa, value, flags);
 319 }
 320
 321 XS(mouse_xs_accessor)
 322 {
 323     dVAR; dXSARGS;
 324     dMOUSE_self;
 325     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 326
 327     SP -= items; /* PPCODE */
 328     PUTBACK;
 329
 330     if(items == 1){ /* reader */
 331         mouse_attr_get(aTHX_ self, mg);
 332     }
 333     else if (items == 2){ /* writer */
 334         mouse_attr_set(aTHX_ self, mg, ST(1));
 335     }
 336     else{
 337         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 338             "Expected exactly one or two argument for an accessor");
 339     }
 340 }
 341
 342
 343 XS(mouse_xs_reader)
 344 {
 345     dVAR; dXSARGS;
 346     dMOUSE_self;
 347     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 348
 349     if (items != 1) {
 350         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 351             "Cannot assign a value to a read-only accessor");
 352     }
 353
 354     SP -= items; /* PPCODE */
 355     PUTBACK;
 356
 357     mouse_attr_get(aTHX_ self, mg);
 358 }
 359
 360 XS(mouse_xs_writer)
 361 {
 362     dVAR; dXSARGS;
 363     dMOUSE_self;
 364     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 365
 366     if (items != 2) {
 367         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
 368             "Too few arguments for a write-only accessor");
 369     }
 370
 371     SP -= items; /* PPCODE */
 372     PUTBACK;
 373
 374     mouse_attr_set(aTHX_ self, mg, ST(1));
 375 }