Add utility macros: newAV_mortal() and newHV_mortal()
[gitmo/Mouse.git] / xs-src / Mouse.xs
CommitLineData
1b812057 1#define NEED_newSVpvn_flags_GLOBAL
df6dd016 2#include "mouse.h"
3
cccb83de 4SV* mouse_package;
5SV* mouse_namespace;
3e44140b 6SV* mouse_methods;
a5df48e5 7SV* mouse_name;
047d7af0 8SV* mouse_get_attribute;
9SV* mouse_get_attribute_list;
cccb83de 10
da4432f3 11
a39e9541 12#define MOUSE_xc_gen(a) MOUSE_av_at((a), MOUSE_XC_GEN)
aa2d2e2c 13#define MOUSE_xc_stash(a) ( (HV*)MOUSE_av_at((a), MOUSE_XC_STASH) )
a39e9541 14#define MOUSE_xc_attrall(a) ( (AV*)MOUSE_av_at((a), MOUSE_XC_ATTRALL) )
15#define MOUSE_xc_buildall(a) ( (AV*)MOUSE_av_at((a), MOUSE_XC_BUILDALL) )
16#define MOUSE_xc_demolishall(a) ( (AV*)MOUSE_av_at((a), MOUSE_XC_DEOLISHALL) )
17
aa2d2e2c 18enum mouse_xc_flags_t {
19 MOUSEf_XC_IS_IMMUTABLE = 0x0001,
20 MOUSEf_XC_IS_ANON = 0x0002,
21 MOUSEf_XC_HAS_BUILDARGS = 0x0004,
22
23 MOUSEf_XC_mask = 0xFFFF /* not used */
24};
25
a39e9541 26/* Mouse XS Metaclass object */
27enum mouse_xc_ix_t{
28 MOUSE_XC_GEN, /* class generation */
aa2d2e2c 29 MOUSE_XC_STASH, /* symbol table hash */
30 MOUSE_XC_FLAGS,
31
32 MOUSE_XC_BUILDARGS, /* Custom BUILDARGS */
33
a39e9541 34 MOUSE_XC_ATTRALL, /* all the attributes */
35 MOUSE_XC_BUILDALL, /* all the BUILD methods */
36 MOUSE_XC_DEMOLISHALL, /* all the DEMOLISH methods */
37
38 MOUSE_XC_last
39};
40
41static MGVTBL mouse_xc_vtbl; /* for identity */
42
43static void
44mouse_class_push_attribute_list(pTHX_ SV* const metaclass, AV* const attrall, HV* const seen){
45 dSP;
46 I32 n;
47
48 /* $meta->get_attribute_list */
49 PUSHMARK(SP);
50 XPUSHs(metaclass);
51 PUTBACK;
52
047d7af0 53 n = call_sv(mouse_get_attribute_list, G_ARRAY | G_METHOD);
a39e9541 54 for(NOOP; n > 0; n--){
55 SV* name;
56
57 SPAGAIN;
58 name = POPs;
59 PUTBACK;
60
61 if(hv_exists_ent(seen, name, 0U)){
62 continue;
63 }
64 (void)hv_store_ent(seen, name, &PL_sv_undef, 0U);
da4432f3 65
047d7af0 66 av_push(attrall, newSVsv( mcall1(metaclass, mouse_get_attribute, name) ));
a39e9541 67 }
68}
743ca82e 69
aa2d2e2c 70static int
71mouse_class_has_custom_buildargs(pTHX_ HV* const stash) {
72 XS(XS_Mouse__Object_BUILDARGS); /* prototype */
73
74 GV* const buildargs = gv_fetchmeth_autoload(stash, "BUILDARGS", sizeof("BUILDARGS")-1, 0);
75 CV* const cv = GvCV(buildargs);
76
77 assert(cv);
78 return CvXSUB(cv) == XS_Mouse__Object_BUILDARGS;
79}
80
a39e9541 81static void
82mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stash, AV* const xc) {
83 AV* const linearized_isa = mro_get_linear_isa(stash);
84 I32 const len = AvFILLp(linearized_isa);
85 I32 i;
aa2d2e2c 86 U32 flags = 0x00;
a39e9541 87 AV* const attrall = newAV();
88 AV* const buildall = newAV();
89 AV* const demolishall = newAV();
90 HV* const seen = newHV(); /* for attributes */
da4432f3 91
a39e9541 92 ENTER;
93 SAVETMPS;
da4432f3 94
a39e9541 95 sv_2mortal((SV*)seen);
da4432f3 96
a39e9541 97 /* old data will be delete at the end of the perl scope */
98 av_delete(xc, MOUSE_XC_DEMOLISHALL, 0x00);
99 av_delete(xc, MOUSE_XC_BUILDALL, 0x00);
100 av_delete(xc, MOUSE_XC_ATTRALL, 0x00);
743ca82e 101
a39e9541 102 SvREFCNT_inc_simple_void_NN(linearized_isa);
103 sv_2mortal((SV*)linearized_isa);
da4432f3 104
a39e9541 105 /* update */
da4432f3 106
aa2d2e2c 107 if(SvTRUEx( mcall0s(metaclass, "is_immutable") )){
108 flags |= MOUSEf_XC_IS_IMMUTABLE;
109 }
110
111 if(mouse_class_has_custom_buildargs(aTHX_ stash)){
112 flags |= MOUSEf_XC_HAS_BUILDARGS;
113 }
114
a39e9541 115 av_store(xc, MOUSE_XC_ATTRALL, (SV*)attrall);
116 av_store(xc, MOUSE_XC_BUILDALL, (SV*)buildall);
117 av_store(xc, MOUSE_XC_DEMOLISHALL, (SV*)demolishall);
da4432f3 118
a39e9541 119 for(i = 0; i < len; i++){
047d7af0 120 SV* const klass = MOUSE_av_at(linearized_isa, i);
a39e9541 121 SV* meta;
122 GV* gv;
da4432f3 123
a39e9541 124 gv = stash_fetchs(stash, "BUILD", FALSE);
125 if(gv && GvCVu(gv)){
126 av_push(buildall, newRV_inc((SV*)GvCV(gv)));
127 }
da4432f3 128
a39e9541 129 gv = stash_fetchs(stash, "DEMOLISH", FALSE);
130 if(gv && GvCVu(gv)){
131 av_push(demolishall, newRV_inc((SV*)GvCV(gv)));
132 }
da4432f3 133
a39e9541 134 /* ATTRIBUTES */
aa2d2e2c 135 meta = get_metaclass(klass);
a39e9541 136 if(!SvOK(meta)){
137 continue; /* skip non-Mouse classes */
138 }
da4432f3 139
a39e9541 140 mouse_class_push_attribute_list(aTHX_ meta, attrall, seen);
141 }
da4432f3 142
a39e9541 143 FREETMPS;
144 LEAVE;
da4432f3 145
a39e9541 146 sv_setuv(MOUSE_xc_gen(xc), mro_get_pkg_gen(stash));
147}
da4432f3 148
a39e9541 149AV*
150mouse_get_xc(pTHX_ SV* const metaclass) {
151 AV* xc;
152 SV* gen;
153 HV* stash;
154 MAGIC* mg;
155
156 if(!IsObject(metaclass)){
157 croak("Not a Mouse metaclass");
158 }
da4432f3 159
a39e9541 160 mg = mouse_mg_find(aTHX_ SvRV(metaclass), &mouse_xc_vtbl, 0x00);
161 if(!mg){
162 SV* const package = get_slot(metaclass, mouse_package);
aa2d2e2c 163 STRLEN len;
164 const char* const pv = SvPV_const(package, len);
da4432f3 165
aa2d2e2c 166 stash = gv_stashpvn(pv, len, TRUE);
a39e9541 167 xc = newAV();
da4432f3 168
aa2d2e2c 169 mg = sv_magicext(SvRV(metaclass), (SV*)xc, PERL_MAGIC_ext, &mouse_xc_vtbl, pv, len);
a39e9541 170 SvREFCNT_dec(xc); /* refcnt++ in sv_magicext */
da4432f3 171
a39e9541 172 av_extend(xc, MOUSE_XC_last - 1);
aa2d2e2c 173
a39e9541 174 av_store(xc, MOUSE_XC_GEN, newSViv(0));
aa2d2e2c 175 av_store(xc, MOUSE_XC_STASH, (SV*)stash);
176 SvREFCNT_inc_simple_void_NN(stash);
da4432f3 177 }
a39e9541 178 else{
a39e9541 179 xc = (AV*)MOUSE_mg_obj(mg);
da4432f3 180
a39e9541 181 assert(xc);
182 assert(SvTYPE(xc) == SVt_PVAV);
183 }
da4432f3 184
aa2d2e2c 185 gen = MOUSE_xc_gen(xc);
186 stash = MOUSE_xc_stash(xc);
187
a39e9541 188 if(SvUV(gen) != mro_get_pkg_gen(stash)){
189 mouse_class_update_xc(aTHX_ metaclass, stash, xc);
da4432f3 190 }
a39e9541 191
192 return xc;
193}
194
195AV*
196mouse_get_all_attributes(pTHX_ SV* const metaclass) {
197 AV* const xc = mouse_get_xc(aTHX_ metaclass);
198 return MOUSE_xc_attrall(xc);
da4432f3 199}
200
aa2d2e2c 201HV*
202mouse_build_args(aTHX_ SV* metaclass, SV* const klass, I32 const start, I32 const items, I32 const ax) {
203 HV* args;
204 if((items - start) == 1){
205 SV* const args_ref = ST(start);
206 if(!IsHashRef(args_ref)){
207 if(!metaclass){ metaclass = get_metaclass(klass); }
208 mouse_throw_error(metaclass, NULL, "Single parameters to new() must be a HASH ref");
209 }
210 args = newHVhv((HV*)SvRV(args_ref));
211 sv_2mortal((SV*)args);
212 }
213 else{
214 I32 i;
215
216 args = newHV();
217 sv_2mortal((SV*)args);
218
219 if( ((items - start) % 2) != 0 ){
220 if(!metaclass){ metaclass = get_metaclass(klass); }
221 mouse_throw_error(metaclass, NULL, "Odd number of parameters to new()");
222 }
223
224 for(i = start; i < items; i += 2){
225 (void)hv_store_ent(args, ST(i), newSVsv(ST(i+1)), 0U);
226 }
227
228 }
229 return args;
230}
231
232void
233mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const args, bool const invoke_triggers) {
234 AV* const xc = mouse_get_xc(aTHX_ meta);
235
236 // TODO
237}
238
646c0371 239MODULE = Mouse PACKAGE = Mouse
df6dd016 240
241PROTOTYPES: DISABLE
242
cccb83de 243BOOT:
244 mouse_package = newSVpvs_share("package");
245 mouse_namespace = newSVpvs_share("namespace");
3e44140b 246 mouse_methods = newSVpvs_share("methods");
a5df48e5 247 mouse_name = newSVpvs_share("name");
3e44140b 248
047d7af0 249 mouse_get_attribute = newSVpvs_share("get_attribute");
250 mouse_get_attribute_list = newSVpvs_share("get_attribute_list");
da4432f3 251
646c0371 252 MOUSE_CALL_BOOT(Mouse__Util);
1d5ecd5f 253 MOUSE_CALL_BOOT(Mouse__Util__TypeConstraints);
646c0371 254 MOUSE_CALL_BOOT(Mouse__Meta__Method__Accessor__XS);
aa2d2e2c 255 MOUSE_CALL_BOOT(Mouse__Meta__Attribute);
f48920c1 256
cccb83de 257
7d96ae4d 258MODULE = Mouse PACKAGE = Mouse::Meta::Module
259
260BOOT:
261 INSTALL_SIMPLE_READER_WITH_KEY(Module, name, package);
262 INSTALL_SIMPLE_READER_WITH_KEY(Module, _method_map, methods);
263 INSTALL_SIMPLE_READER_WITH_KEY(Module, _attribute_map, attributes);
264
265HV*
266namespace(SV* self)
267CODE:
268{
6a97bbda 269 SV* const package = get_slot(self, mouse_package);
7d96ae4d 270 if(!(package && SvOK(package))){
3e44140b 271 croak("No package name defined");
7d96ae4d 272 }
273 RETVAL = gv_stashsv(package, GV_ADDMULTI);
274}
275OUTPUT:
276 RETVAL
277
3e44140b 278# ignore extra arguments for extensibility
279void
280add_method(SV* self, SV* name, SV* code, ...)
281CODE:
282{
6a97bbda 283 SV* const package = get_slot(self, mouse_package); /* $self->{package} */
284 SV* const methods = get_slot(self, mouse_methods); /* $self->{methods} */
3e44140b 285 GV* gv;
286 SV* code_ref;
287
288 if(!(package && SvOK(package))){
289 croak("No package name defined");
290 }
291
292 SvGETMAGIC(name);
293 SvGETMAGIC(code);
294
295 if(!SvOK(name)){
296 mouse_throw_error(self, NULL, "You must define a method name");
297 }
298 if(!SvROK(code)){
299 mouse_throw_error(self, NULL, "You must define a CODE reference");
300 }
301
302 code_ref = code;
303 if(SvTYPE(SvRV(code_ref)) != SVt_PVCV){
304 SV* sv = code_ref; /* used in tryAMAGICunDEREF */
305 SV** sp = &sv; /* used in tryAMAGICunDEREF */
306 tryAMAGICunDEREF(to_cv); /* try \&{$code} */
307 if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV){
308 mouse_throw_error(self, NULL, "Not a CODE reference");
309 }
310 code_ref = sv;
311 }
312
313 /* *{$package . '::' . $name} -> *gv */
314 gv = gv_fetchpv(form("%"SVf"::%"SVf, package, name), GV_ADDMULTI, SVt_PVCV);
315 if(GvCVu(gv)){ /* delete *slot{gv} to work around "redefine" warning */
316 SvREFCNT_dec(GvCV(gv));
317 GvCV(gv) = NULL;
318 }
319 sv_setsv_mg((SV*)gv, code_ref); /* *gv = $code_ref */
320
6fe2272b 321 set_slot(methods, name, code); /* $self->{methods}{$name} = $code */
3e44140b 322
323 /* TODO: name the CODE ref if it's anonymous */
324 //code_entity = (CV*)SvRV(code_ref);
325 //if(CvANON(code_entity)
326 // && CvGV(code_entity) /* a cv under construction has no gv */ ){
327
328 // CvGV(code_entity) = gv;
329 // CvANON_off(code_entity);
330 //}
331}
332
43165725 333MODULE = Mouse PACKAGE = Mouse::Meta::Class
334
335BOOT:
336 INSTALL_SIMPLE_READER(Class, roles);
337 INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id);
338
cccb83de 339void
340linearized_isa(SV* self)
341PPCODE:
342{
343 SV* const stash_ref = mcall0(self, mouse_namespace); /* $self->namespace */
344 AV* linearized_isa;
345 I32 len;
346 I32 i;
347 if(!(SvROK(stash_ref) && SvTYPE(SvRV(stash_ref)) == SVt_PVHV)){
348 croak("namespace() didn't return a HASH reference");
349 }
350 linearized_isa = mro_get_linear_isa((HV*)SvRV(stash_ref));
351 len = AvFILLp(linearized_isa) + 1;
352 EXTEND(SP, len);
353 for(i = 0; i < len; i++){
354 PUSHs(AvARRAY(linearized_isa)[i]);
355 }
356}
357
da4432f3 358void
359get_all_attributes(SV* self)
360PPCODE:
361{
362 AV* const all_attrs = mouse_get_all_attributes(aTHX_ self);
363 I32 const len = AvFILLp(all_attrs) + 1;
364 I32 i;
365
366 EXTEND(SP, len);
367 for(i = 0; i < len; i++){
368 PUSHs( MOUSE_av_at(all_attrs, i) );
369 }
370}
441964ce 371
aa2d2e2c 372SV*
373new_object_(SV* meta, ...)
374CODE:
375{
376 HV* const args = mouse_build_args(aTHX_ meta, NULL, 1, items, ax);
377 AV* const xc = mouse_get_xc(aTHX_ meta);
378 RETVAL = mouse_instance_create(aTHX_ MOUSE_xc_stash(xc));
379 mouse_class_initialize_object(aTHX_ meta, RETVAL, args, TRUE);
380}
381
382
383void
384_initialize_object_(SV* meta, SV* object, HV* args, bool invoke_triggers = TRUE)
385CODE:
386{
387 mouse_class_initialize_object(aTHX_ meta, object, args, invoke_triggers);
388}
389
43165725 390MODULE = Mouse PACKAGE = Mouse::Meta::Role
391
392BOOT:
393 INSTALL_SIMPLE_READER_WITH_KEY(Role, get_roles, roles);
394 INSTALL_SIMPLE_PREDICATE_WITH_KEY(Role, is_anon_role, anon_serial_id);
395
aa2d2e2c 396MODULE = Mouse PACKAGE = Mouse::Object
43165725 397
aa2d2e2c 398HV*
399BUILDARGS(SV* klass, ...)
400CODE:
401{
402 RETVAL = mouse_build_args(aTHX_ NULL, klass, 1, items, ax);
403}
404OUTPUT:
405 RETVAL
93540011 406