xs-src/Mouse.xs

   1 #define  NEED_newSVpvn_flags_GLOBAL
   2 #include "mouse.h"
   3
   4 SV* mouse_package;
   5 SV* mouse_namespace;
   6 SV* mouse_methods;
   7 SV* mouse_name;
   8 SV* mouse_get_attribute;
   9 SV* mouse_get_attribute_list;
  10
  11
  12 #define MOUSE_xc_gen(a)         MOUSE_av_at((a), MOUSE_XC_GEN)
  13 #define MOUSE_xc_attrall(a)     ( (AV*)MOUSE_av_at((a), MOUSE_XC_ATTRALL) )
  14 #define MOUSE_xc_buildall(a)    ( (AV*)MOUSE_av_at((a), MOUSE_XC_BUILDALL) )
  15 #define MOUSE_xc_demolishall(a) ( (AV*)MOUSE_av_at((a), MOUSE_XC_DEOLISHALL) )
  16
  17 /* Mouse XS Metaclass object */
  18 enum mouse_xc_ix_t{
  19     MOUSE_XC_GEN,          /* class generation */
  20     MOUSE_XC_ATTRALL,      /* all the attributes */
  21     MOUSE_XC_BUILDALL,     /* all the BUILD methods */
  22     MOUSE_XC_DEMOLISHALL,  /* all the DEMOLISH methods */
  23
  24     MOUSE_XC_last
  25 };
  26
  27 static MGVTBL mouse_xc_vtbl; /* for identity */
  28
  29 static void
  30 mouse_class_push_attribute_list(pTHX_ SV* const metaclass, AV* const attrall, HV* const seen){
  31     dSP;
  32     I32 n;
  33
  34     /* $meta->get_attribute_list */
  35     PUSHMARK(SP);
  36     XPUSHs(metaclass);
  37     PUTBACK;
  38
  39     n = call_sv(mouse_get_attribute_list, G_ARRAY | G_METHOD);
  40     for(NOOP; n > 0; n--){
  41         SV* name;
  42
  43         SPAGAIN;
  44         name = POPs;
  45         PUTBACK;
  46
  47         if(hv_exists_ent(seen, name, 0U)){
  48             continue;
  49         }
  50         (void)hv_store_ent(seen, name, &PL_sv_undef, 0U);
  51
  52         av_push(attrall, newSVsv( mcall1(metaclass, mouse_get_attribute, name) ));
  53     }
  54 }
  55
  56 static void
  57 mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stash, AV* const xc) {
  58     AV* const linearized_isa = mro_get_linear_isa(stash);
  59     I32 const len            = AvFILLp(linearized_isa);
  60     I32 i;
  61     AV* const attrall     = newAV();
  62     AV* const buildall    = newAV();
  63     AV* const demolishall = newAV();
  64     HV* const seen        = newHV(); /* for attributes */
  65
  66     ENTER;
  67     SAVETMPS;
  68
  69     sv_2mortal((SV*)seen);
  70
  71      /* old data will be delete at the end of the perl scope */
  72     av_delete(xc, MOUSE_XC_DEMOLISHALL, 0x00);
  73     av_delete(xc, MOUSE_XC_BUILDALL,    0x00);
  74     av_delete(xc, MOUSE_XC_ATTRALL,     0x00);
  75
  76     SvREFCNT_inc_simple_void_NN(linearized_isa);
  77     sv_2mortal((SV*)linearized_isa);
  78
  79     /* update */
  80
  81     av_store(xc, MOUSE_XC_ATTRALL,     (SV*)attrall);
  82     av_store(xc, MOUSE_XC_BUILDALL,    (SV*)buildall);
  83     av_store(xc, MOUSE_XC_DEMOLISHALL, (SV*)demolishall);
  84
  85     for(i = 0; i < len; i++){
  86         SV* const klass = MOUSE_av_at(linearized_isa, i);
  87         SV* meta;
  88         GV* gv;
  89
  90         gv = stash_fetchs(stash, "BUILD", FALSE);
  91         if(gv && GvCVu(gv)){
  92             av_push(buildall, newRV_inc((SV*)GvCV(gv)));
  93         }
  94
  95         gv = stash_fetchs(stash, "DEMOLISH", FALSE);
  96         if(gv && GvCVu(gv)){
  97             av_push(demolishall, newRV_inc((SV*)GvCV(gv)));
  98         }
  99
 100         /* ATTRIBUTES */
 101         meta = get_metaclass_by_name(klass);
 102         if(!SvOK(meta)){
 103             continue; /* skip non-Mouse classes */
 104         }
 105
 106         mouse_class_push_attribute_list(aTHX_ meta, attrall, seen);
 107     }
 108
 109     FREETMPS;
 110     LEAVE;
 111
 112     sv_setuv(MOUSE_xc_gen(xc), mro_get_pkg_gen(stash));
 113 }
 114
 115 AV*
 116 mouse_get_xc(pTHX_ SV* const metaclass) {
 117     AV* xc;
 118     SV* gen;
 119     HV* stash;
 120     MAGIC* mg;
 121
 122     if(!IsObject(metaclass)){
 123         croak("Not a Mouse metaclass");
 124     }
 125
 126     mg = mouse_mg_find(aTHX_ SvRV(metaclass), &mouse_xc_vtbl, 0x00);
 127     if(!mg){
 128         SV* const package = get_slot(metaclass, mouse_package);
 129
 130         stash = gv_stashsv(package, TRUE);
 131         xc    = newAV();
 132
 133         mg = sv_magicext(SvRV(metaclass), (SV*)xc, PERL_MAGIC_ext, &mouse_xc_vtbl, (char*)stash, HEf_SVKEY);
 134         SvREFCNT_dec(xc); /* refcnt++ in sv_magicext */
 135
 136         av_extend(xc, MOUSE_XC_last - 1);
 137         av_store(xc, MOUSE_XC_GEN, newSViv(0));
 138     }
 139     else{
 140         stash = (HV*)MOUSE_mg_ptr(mg);
 141         xc    = (AV*)MOUSE_mg_obj(mg);
 142
 143         assert(stash);
 144         assert(SvTYPE(stash) == SVt_PVAV);
 145
 146         assert(xc);
 147         assert(SvTYPE(xc) == SVt_PVAV);
 148     }
 149
 150     gen = MOUSE_xc_gen(xc);
 151     if(SvUV(gen) != mro_get_pkg_gen(stash)){
 152         mouse_class_update_xc(aTHX_ metaclass, stash, xc);
 153     }
 154
 155     return xc;
 156 }
 157
 158 AV*
 159 mouse_get_all_attributes(pTHX_ SV* const metaclass) {
 160     AV* const xc = mouse_get_xc(aTHX_ metaclass);
 161     return MOUSE_xc_attrall(xc);
 162 }
 163
 164 MODULE = Mouse  PACKAGE = Mouse
 165
 166 PROTOTYPES: DISABLE
 167
 168 BOOT:
 169     mouse_package   = newSVpvs_share("package");
 170     mouse_namespace = newSVpvs_share("namespace");
 171     mouse_methods   = newSVpvs_share("methods");
 172     mouse_name      = newSVpvs_share("name");
 173
 174     mouse_get_attribute      = newSVpvs_share("get_attribute");
 175     mouse_get_attribute_list = newSVpvs_share("get_attribute_list");
 176
 177     MOUSE_CALL_BOOT(Mouse__Util);
 178     MOUSE_CALL_BOOT(Mouse__Util__TypeConstraints);
 179     MOUSE_CALL_BOOT(Mouse__Meta__Method__Accessor__XS);
 180
 181
 182 MODULE = Mouse  PACKAGE = Mouse::Meta::Module
 183
 184 BOOT:
 185     INSTALL_SIMPLE_READER_WITH_KEY(Module, name, package);
 186     INSTALL_SIMPLE_READER_WITH_KEY(Module, _method_map, methods);
 187     INSTALL_SIMPLE_READER_WITH_KEY(Module, _attribute_map, attributes);
 188
 189 HV*
 190 namespace(SV* self)
 191 CODE:
 192 {
 193     SV* const package = get_slot(self, mouse_package);
 194     if(!(package && SvOK(package))){
 195         croak("No package name defined");
 196     }
 197     RETVAL = gv_stashsv(package, GV_ADDMULTI);
 198 }
 199 OUTPUT:
 200     RETVAL
 201
 202 # ignore extra arguments for extensibility
 203 void
 204 add_method(SV* self, SV* name, SV* code, ...)
 205 CODE:
 206 {
 207     SV* const package = get_slot(self, mouse_package); /* $self->{package} */
 208     SV* const methods = get_slot(self, mouse_methods); /* $self->{methods} */
 209     GV* gv;
 210     SV* code_ref;
 211
 212     if(!(package && SvOK(package))){
 213         croak("No package name defined");
 214     }
 215
 216     SvGETMAGIC(name);
 217     SvGETMAGIC(code);
 218
 219     if(!SvOK(name)){
 220         mouse_throw_error(self, NULL, "You must define a method name");
 221     }
 222     if(!SvROK(code)){
 223         mouse_throw_error(self, NULL, "You must define a CODE reference");
 224     }
 225
 226     code_ref = code;
 227     if(SvTYPE(SvRV(code_ref)) != SVt_PVCV){
 228         SV*  sv = code_ref;  /* used in tryAMAGICunDEREF */
 229         SV** sp = &sv;       /* used in tryAMAGICunDEREF */
 230         tryAMAGICunDEREF(to_cv); /* try \&{$code} */
 231         if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV){
 232             mouse_throw_error(self, NULL, "Not a CODE reference");
 233         }
 234         code_ref = sv;
 235     }
 236
 237     /*  *{$package . '::' . $name} -> *gv */
 238     gv = gv_fetchpv(form("%"SVf"::%"SVf, package, name), GV_ADDMULTI, SVt_PVCV);
 239     if(GvCVu(gv)){ /* delete *slot{gv} to work around "redefine" warning */
 240         SvREFCNT_dec(GvCV(gv));
 241         GvCV(gv) = NULL;
 242     }
 243     sv_setsv_mg((SV*)gv, code_ref); /* *gv = $code_ref */
 244
 245     set_slot(methods, name, code); /* $self->{methods}{$name} = $code */
 246
 247     /* TODO: name the CODE ref if it's anonymous */
 248     //code_entity = (CV*)SvRV(code_ref);
 249     //if(CvANON(code_entity)
 250     //    && CvGV(code_entity) /* a cv under construction has no gv */ ){
 251
 252     //    CvGV(code_entity) = gv;
 253     //    CvANON_off(code_entity);
 254     //}
 255 }
 256
 257 MODULE = Mouse  PACKAGE = Mouse::Meta::Class
 258
 259 BOOT:
 260     INSTALL_SIMPLE_READER(Class, roles);
 261     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id);
 262
 263 void
 264 linearized_isa(SV* self)
 265 PPCODE:
 266 {
 267     SV* const stash_ref = mcall0(self, mouse_namespace); /* $self->namespace */
 268     AV* linearized_isa;
 269     I32 len;
 270     I32 i;
 271     if(!(SvROK(stash_ref) && SvTYPE(SvRV(stash_ref)) == SVt_PVHV)){
 272         croak("namespace() didn't return a HASH reference");
 273     }
 274     linearized_isa = mro_get_linear_isa((HV*)SvRV(stash_ref));
 275     len = AvFILLp(linearized_isa) + 1;
 276     EXTEND(SP, len);
 277     for(i = 0; i < len; i++){
 278         PUSHs(AvARRAY(linearized_isa)[i]);
 279     }
 280 }
 281
 282 void
 283 get_all_attributes(SV* self)
 284 PPCODE:
 285 {
 286     AV* const all_attrs = mouse_get_all_attributes(aTHX_ self);
 287     I32 const len       = AvFILLp(all_attrs) + 1;
 288     I32 i;
 289
 290     EXTEND(SP, len);
 291     for(i = 0; i < len; i++){
 292         PUSHs( MOUSE_av_at(all_attrs, i) );
 293     }
 294 }
 295
 296 MODULE = Mouse  PACKAGE = Mouse::Meta::Role
 297
 298 BOOT:
 299     INSTALL_SIMPLE_READER_WITH_KEY(Role, get_roles, roles);
 300     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Role, is_anon_role, anon_serial_id);
 301
 302 MODULE = Mouse  PACKAGE = Mouse::Meta::Attribute
 303
 304 BOOT:
 305     /* readers */
 306     INSTALL_SIMPLE_READER(Attribute, name);
 307     INSTALL_SIMPLE_READER(Attribute, associated_class);
 308     INSTALL_SIMPLE_READER(Attribute, accessor);
 309     INSTALL_SIMPLE_READER(Attribute, reader);
 310     INSTALL_SIMPLE_READER(Attribute, writer);
 311     INSTALL_SIMPLE_READER(Attribute, predicate);
 312     INSTALL_SIMPLE_READER(Attribute, clearer);
 313     INSTALL_SIMPLE_READER(Attribute, handles);
 314
 315     INSTALL_SIMPLE_READER_WITH_KEY(Attribute, _is_metadata, is);
 316     INSTALL_SIMPLE_READER_WITH_KEY(Attribute, is_required, required);
 317     INSTALL_SIMPLE_READER(Attribute, default);
 318     INSTALL_SIMPLE_READER_WITH_KEY(Attribute, is_lazy, lazy);
 319     INSTALL_SIMPLE_READER_WITH_KEY(Attribute, is_lazy_build, lazy_build);
 320     INSTALL_SIMPLE_READER_WITH_KEY(Attribute, is_weak_ref, weak_ref);
 321     INSTALL_SIMPLE_READER(Attribute, init_arg);
 322     INSTALL_SIMPLE_READER(Attribute, type_constraint);
 323     INSTALL_SIMPLE_READER(Attribute, trigger);
 324     INSTALL_SIMPLE_READER(Attribute, builder);
 325     INSTALL_SIMPLE_READER_WITH_KEY(Attribute, should_auto_deref, auto_deref);
 326     INSTALL_SIMPLE_READER_WITH_KEY(Attribute, should_coerce, coerce);
 327     INSTALL_SIMPLE_READER(Attribute, documentation);
 328
 329     /* predicates */
 330     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_accessor, accessor);
 331     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_reader, reader);
 332     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_writer, writer);
 333     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_predicate, predicate);
 334     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_clearer, clearer);
 335     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_handles, handles);
 336
 337     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_default, default);
 338     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_type_constraint, type_constraint);
 339     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_trigger, trigger);
 340     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_builder, builder);
 341     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_documentation, documentation);
 342
 343     newCONSTSUB(gv_stashpvs("Mouse::Meta::Attribute", TRUE), "accessor_metaclass",
 344         newSVpvs("Mouse::Meta::Method::Accessor::XS"));
 345