xs/MethodConstructor.xs

   1 #include "mop.h"
   2
   3
   4 static MGVTBL mop_attr_vtbl;
   5
   6 #define MOP_attr_slot(meta)          MOP_av_at(meta, MOP_ATTR_SLOT)
   7 #define MOP_attr_init_arg(meta)      MOP_av_at(meta, MOP_ATTR_INIT_ARG)
   8 #define MOP_attr_default(meta)       MOP_av_at(meta, MOP_ATTR_DEFAULT)
   9 #define MOP_attr_builder(meta)       MOP_av_at(meta, MOP_ATTR_BUILDER)
  10
  11 enum mop_attr_ix_t{
  12     MOP_ATTR_SLOT,
  13
  14     MOP_ATTR_INIT_ARG,
  15     MOP_ATTR_DEFAULT,
  16     MOP_ATTR_BUILDER,
  17
  18     MOP_ATTR_last,
  19 };
  20
  21 enum mop_attr_flags_t{ /* must be 16 bits */
  22     MOP_ATTRf_HAS_INIT_ARG         = 0x0001,
  23     MOP_ATTRf_HAS_DEFAULT          = 0x0002,
  24     MOP_ATTRf_IS_DEFAULT_A_CODEREF = 0x0004,
  25     MOP_ATTRf_HAS_BUILDER          = 0x0008,
  26     MOP_ATTRf_HAS_INITIALIZER      = 0x0010,
  27
  28
  29     MOP_ATTRf_DEBUG                = 0x8000
  30 };
  31
  32 static MAGIC*
  33 mop_attr_mg(pTHX_ SV* const attr, SV* const instance){
  34     MAGIC* mg;
  35
  36     if(!IsObject(attr)) {
  37         croak("Invalid Attribute object");
  38     }
  39
  40     /* attribute mg:
  41         mg_obj: meta information (AV*)
  42         mg_ptr: meta instance virtual table (mop_instance_vtbl*)
  43     */
  44
  45     if(!(SvMAGICAL(SvRV(attr)) && (mg = mop_mg_find(aTHX_ SvRV(attr), &mop_attr_vtbl, 0))) ) {
  46         U16 flags = 0;
  47         AV* const meta = newAV();
  48         SV* name;
  49         SV* sv;
  50
  51         mg = sv_magicext(SvRV(attr), (SV*)meta, PERL_MAGIC_ext, &mop_attr_vtbl, NULL, 0);
  52         SvREFCNT_dec(meta);
  53         av_extend(meta, MOP_ATTR_last - 1);
  54
  55         ENTER;
  56         SAVETMPS;
  57
  58         name = mop_call0(aTHX_ attr, mop_name);
  59         av_store(meta, MOP_ATTR_SLOT, newSVsv_share(name));
  60
  61         if(SvOK( sv = mop_call0_pvs(attr, "init_arg") )) {
  62             flags |= MOP_ATTRf_HAS_INIT_ARG;
  63
  64             av_store(meta, MOP_ATTR_INIT_ARG, newSVsv_share(sv));
  65         }
  66
  67         /* NOTE: Setting both default and builder is not allowed */
  68         if(SvOK( sv = mop_call0_pvs(attr, "builder") )) {
  69             SV* const builder = sv;
  70             flags |= MOP_ATTRf_HAS_BUILDER;
  71
  72             if(SvOK( sv = mop_call1(aTHX_ instance, mop_can, builder) )){
  73                 av_store(meta, MOP_ATTR_BUILDER, newSVsv(sv));
  74             }
  75             else{
  76                 croak("%s does not support builder method '%"SVf"' for attribute '%"SVf"'",
  77                     sv_reftype(SvRV(instance), TRUE), builder, name);
  78             }
  79         }
  80         else if(SvOK( sv = mop_call0_pvs(attr, "default") )) {
  81             if(SvTRUEx( mop_call0_pvs(attr, "is_default_a_coderef") )){
  82                 flags |= MOP_ATTRf_HAS_BUILDER;
  83                 av_store(meta, MOP_ATTR_BUILDER, newSVsv(sv));
  84             }
  85             else {
  86                 flags |= MOP_ATTRf_HAS_DEFAULT;
  87                 av_store(meta, MOP_ATTR_DEFAULT, newSVsv(sv));
  88             }
  89         }
  90
  91         MOP_mg_flags(mg) = flags;
  92
  93         if(flags & MOP_ATTRf_DEBUG) {
  94             warn("%s: setup attr_mg for '%"SVf"'\n", sv_reftype(SvRV(instance), TRUE), name);
  95         }
  96
  97         FREETMPS;
  98         LEAVE;
  99     }
 100
 101     return mg;
 102 }
 103
 104 static MGVTBL mop_constructor_vtbl;
 105
 106 static HV*
 107 mop_build_args(pTHX_ CV* const cv, I32 const ax, I32 const items){
 108     HV* args;
 109     if(items == 1){
 110         SV* const sv = ST(0);
 111         SvGETMAGIC(sv);
 112         if(!(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV)){
 113             croak("Single arguments to %s() must be a HASH ref", GvNAME(CvGV(cv)));
 114         }
 115         args = (HV*)SvRV(sv);
 116     }
 117     else{
 118         I32 i;
 119
 120         if( items % 2 ){
 121             croak("Odd number of arguments for %s()", GvNAME(CvGV(cv)));
 122         }
 123
 124         args = newHV();
 125         sv_2mortal((SV*)args);
 126
 127         for(i = 0; i < items; i += 2){
 128             SV* const key   = ST(i);
 129             SV* const value = ST(i+1);
 130             (void)hv_store_ent(args, key, value, 0U);
 131             SvREFCNT_inc_simple_void_NN(value);
 132         }
 133     }
 134     return args;
 135 }
 136
 137 static void
 138 mop_attr_initialize_instance_slot(pTHX_ SV* const attr, const mop_instance_vtbl* const vtbl, SV* const instance, HV* const args){
 139     MAGIC* const mg  = mop_attr_mg(aTHX_ attr, instance);
 140     AV* const meta   = (AV*)MOP_mg_obj(mg);
 141     U16 const flags  = MOP_mg_flags(mg);
 142     HE* arg;
 143     SV* value;
 144
 145     if(flags & MOP_ATTRf_DEBUG){
 146         warn("%s: initialize_instance_slot '%"SVf"' (0x%04x)\n", sv_reftype(SvRV(instance), TRUE), MOP_attr_slot(meta), (unsigned)flags);
 147     }
 148
 149     if( flags & MOP_ATTRf_HAS_INIT_ARG && (arg = hv_fetch_ent(args, MOP_attr_init_arg(meta), FALSE, 0U)) ){
 150         value = hv_iterval(args, arg);
 151     }
 152     else if(flags & MOP_ATTRf_HAS_DEFAULT) {
 153         value = MOP_attr_default(meta); /* it's always a non-ref value */
 154     }
 155     else if(flags & MOP_ATTRf_HAS_BUILDER) {
 156         SV* const builder = MOP_attr_builder(meta); /* code-ref default value or builder */
 157         dSP;
 158
 159         ENTER;
 160         SAVETMPS;
 161
 162         PUSHMARK(SP);
 163         XPUSHs(instance);
 164         PUTBACK;
 165
 166         call_sv(builder, G_SCALAR);
 167
 168         SPAGAIN;
 169         value = POPs;
 170         SvREFCNT_inc_simple_void_NN(value);
 171         PUTBACK;
 172
 173         FREETMPS;
 174         LEAVE;
 175
 176         sv_2mortal(value);
 177     }
 178     else{
 179         value = NULL;
 180     }
 181
 182     if(value){
 183         if(flags & MOP_ATTRf_HAS_INITIALIZER){
 184             /* $attr->set_initial_value($meta_instance, $instance, $value) */
 185             dSP;
 186
 187             PUSHMARK(SP);
 188             EXTEND(SP, 4);
 189             PUSHs(attr);
 190             PUSHs(instance);
 191             mPUSHs(value);
 192             PUTBACK;
 193
 194             call_method("set_initial_value", G_VOID | G_DISCARD);
 195         }
 196         else{
 197             vtbl->set_slot(aTHX_ instance, MOP_attr_slot(meta), value);
 198         }
 199     }
 200 }
 201
 202 static AV*
 203 mop_class_get_all_attributes(pTHX_ SV* const metaclass){
 204     AV* const attrs = newAV();
 205     dSP;
 206     I32 n;
 207
 208     PUSHMARK(SP);
 209     XPUSHs(metaclass);
 210     PUTBACK;
 211
 212     n = call_method("get_all_attributes", G_ARRAY);
 213     SPAGAIN;
 214
 215     if(n){
 216         av_extend(attrs, n - 1);
 217         while(n){
 218             (void)av_store(attrs, --n, newSVsv(POPs));
 219         }
 220     }
 221
 222     PUTBACK;
 223
 224     return attrs;
 225 }
 226
 227 XS(mop_xs_constructor);
 228 XS(mop_xs_constructor)
 229 {
 230     dVAR; dXSARGS;
 231     dMOP_mg(cv);
 232     AV* const attrs = (AV*)MOP_mg_obj(mg);
 233     SV* klass;
 234     HV* stash;
 235     SV* instance;
 236     I32 i;
 237     I32 len;
 238     HV* args;
 239
 240     assert(SvTYPE(attrs) == SVt_PVAV);
 241
 242     if(items < 0){
 243         croak("Not enough arguments for %s()", GvNAME(CvGV(cv)));
 244     }
 245
 246     klass = ST(0);
 247
 248     if(SvROK(klass)){
 249         croak("The constructor must be called as a class method");
 250     }
 251
 252     stash = gv_stashsv(klass, TRUE);
 253
 254     args = mop_build_args(aTHX_ cv, ax+1, items-1);
 255
 256     if( stash != GvSTASH(CvGV(cv)) ){
 257         SV* const metaclass = mop_class_of(aTHX_ klass);
 258         dSP;
 259
 260         PUSHMARK(SP);
 261         EXTEND(SP, 2);
 262         PUSHs(metaclass);
 263         mPUSHs(newRV_inc((SV*)args));
 264         PUTBACK;
 265
 266         call_method("new_object", GIMME_V);
 267         return;
 268     }
 269
 270     instance = sv_2mortal( MOP_mg_create_instance(mg, stash) );
 271     if(!IsObject(instance)){
 272         croak("create_instance() did not return an object instance");
 273     }
 274
 275     len = AvFILLp(attrs) + 1;
 276     for(i = 0; i < len; i++){
 277         mop_attr_initialize_instance_slot(aTHX_ AvARRAY(attrs)[i], MOP_mg_vtbl(mg), instance, args);
 278     }
 279
 280     ST(0) = instance;
 281     XSRETURN(1);
 282 }
 283
 284
 285 static CV*
 286 mop_generate_constructor_method_xs(pTHX_ SV* const constructor, mop_instance_vtbl* const vtbl){
 287     SV* const metaclass = mop_call0(aTHX_ constructor, mop_associated_metaclass);
 288
 289     CV* const xsub  = newXS(NULL, mop_xs_constructor, __FILE__);
 290     MAGIC* mg;
 291     AV* attrs;
 292
 293     sv_2mortal((SV*)xsub);
 294
 295     attrs = mop_class_get_all_attributes(aTHX_ metaclass);
 296     mg = sv_magicext((SV*)xsub, (SV*)attrs, PERL_MAGIC_ext, &mop_constructor_vtbl, (char*)vtbl, 0);
 297     SvREFCNT_dec(attrs);
 298     CvXSUBANY(xsub).any_ptr = (void*)mg;
 299
 300     return xsub;
 301 }
 302
 303
 304 MODULE = Class::MOP::Method::Constructor   PACKAGE = Class::MOP::Method::Constructor
 305
 306 PROTOTYPES: DISABLE
 307
 308 VERSIONCHECK: DISABLE
 309
 310 BOOT:
 311     INSTALL_SIMPLE_READER(Method::Constructor, options);
 312     INSTALL_SIMPLE_READER(Method::Constructor, associated_metaclass);
 313
 314 CV*
 315 _generate_constructor_method_xs(SV* self, void* instance_vtbl)
 316 CODE:
 317     RETVAL = mop_generate_constructor_method_xs(aTHX_ self, instance_vtbl);
 318 OUTPUT:
 319     RETVAL
 320