Inheitance of non-Mouse classes now produces wranings
[gitmo/Mouse.git] / xs-src / Mouse.xs
1 #define  NEED_newSVpvn_flags_GLOBAL
2 #include "mouse.h"
3
4 /* keywords for methods/keys */
5 SV* mouse_package;
6 SV* mouse_namespace;
7 SV* mouse_methods;
8 SV* mouse_name;
9 SV* mouse_get_attribute;
10 SV* mouse_get_attribute_list;
11 SV* mouse_coerce;
12
13 #define MOUSE_xc_flags(a)       SvUVX(MOUSE_av_at((a), MOUSE_XC_FLAGS))
14 #define MOUSE_xc_gen(a)         MOUSE_av_at((a), MOUSE_XC_GEN)
15 #define MOUSE_xc_stash(a)       ( (HV*)MOUSE_av_at((a), MOUSE_XC_STASH) )
16 #define MOUSE_xc_attrall(a)     ( (AV*)MOUSE_av_at((a), MOUSE_XC_ATTRALL) )
17 #define MOUSE_xc_buildall(a)    ( (AV*)MOUSE_av_at((a), MOUSE_XC_BUILDALL) )
18 #define MOUSE_xc_demolishall(a) ( (AV*)MOUSE_av_at((a), MOUSE_XC_DEMOLISHALL) )
19
20 enum mouse_xc_flags_t {
21     MOUSEf_XC_IS_IMMUTABLE   = 0x0001,
22     MOUSEf_XC_IS_ANON        = 0x0002,
23     MOUSEf_XC_HAS_BUILDARGS  = 0x0004,
24     MOUSEf_XC_CONSTRUCTOR_IS_STRICT
25                              = 0x0008,
26
27     MOUSEf_XC_mask           = 0xFFFF /* not used */
28 };
29
30 /* Mouse XS Metaclass object */
31 enum mouse_xc_ix_t{
32     MOUSE_XC_FLAGS,
33
34     MOUSE_XC_GEN,          /* class generation */
35     MOUSE_XC_STASH,        /* symbol table hash */
36
37     MOUSE_XC_ATTRALL,      /* all the attributes */
38     MOUSE_XC_BUILDALL,     /* all the BUILD methods */
39     MOUSE_XC_DEMOLISHALL,  /* all the DEMOLISH methods */
40
41     MOUSE_XC_last
42 };
43
44 enum mouse_modifier_t {
45     MOUSE_M_BEFORE,
46     MOUSE_M_AROUND,
47     MOUSE_M_AFTER,
48 };
49
50 static MGVTBL mouse_xc_vtbl; /* for identity */
51
52 static void
53 mouse_class_push_attribute_list(pTHX_ SV* const metaclass, AV* const attrall, HV* const seen){
54     dSP;
55     I32 n;
56
57     /* $meta->get_attribute_list */
58     PUSHMARK(SP);
59     XPUSHs(metaclass);
60     PUTBACK;
61
62     n = call_sv(mouse_get_attribute_list, G_ARRAY | G_METHOD);
63     for(NOOP; n > 0; n--){
64         SV* name;
65
66         SPAGAIN;
67         name = POPs;
68         PUTBACK;
69
70         if(hv_exists_ent(seen, name, 0U)){
71             continue;
72         }
73         (void)hv_store_ent(seen, name, &PL_sv_undef, 0U);
74
75         av_push(attrall, newSVsv( mcall1(metaclass, mouse_get_attribute, name) ));
76     }
77 }
78
79 XS(XS_Mouse__Object_BUILDARGS); /* prototype */
80
81 static int
82 mouse_class_has_custom_buildargs(pTHX_ HV* const stash) {
83     GV* const buildargs = gv_fetchmeth_autoload(stash, "BUILDARGS", sizeof("BUILDARGS")-1, 0);
84
85     return buildargs && CvXSUB(GvCV(buildargs)) != XS_Mouse__Object_BUILDARGS;
86 }
87
88 static void
89 mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stash, AV* const xc) {
90     AV* const linearized_isa = mro_get_linear_isa(stash);
91     I32 const len            = AvFILLp(linearized_isa);
92     I32 i;
93     U32 flags             = 0x00;
94     AV* const attrall     = newAV();
95     AV* const buildall    = newAV();
96     AV* const demolishall = newAV();
97     HV* const seen        = newHV(); /* for attributes */
98
99     ENTER;
100     SAVETMPS;
101
102     sv_2mortal((SV*)seen);
103
104      /* old data will be delete at the end of the perl scope */
105     av_delete(xc, MOUSE_XC_DEMOLISHALL, 0x00);
106     av_delete(xc, MOUSE_XC_BUILDALL,    0x00);
107     av_delete(xc, MOUSE_XC_ATTRALL,     0x00);
108
109     SvREFCNT_inc_simple_void_NN(linearized_isa);
110     sv_2mortal((SV*)linearized_isa);
111
112     /* update */
113
114     if(predicate_calls(metaclass, "is_immutable")){
115         flags |= MOUSEf_XC_IS_IMMUTABLE;
116     }
117
118     if(predicate_calls(metaclass, "is_anon_class")){
119         flags |= MOUSEf_XC_IS_ANON;
120     }
121
122     if(mouse_class_has_custom_buildargs(aTHX_ stash)){
123         flags |= MOUSEf_XC_HAS_BUILDARGS;
124     }
125
126     if(predicate_calls(metaclass, "strict_constructor")){
127         flags |= MOUSEf_XC_CONSTRUCTOR_IS_STRICT;
128     }
129
130     av_store(xc, MOUSE_XC_FLAGS,       newSVuv(flags));
131     av_store(xc, MOUSE_XC_ATTRALL,     (SV*)attrall);
132     av_store(xc, MOUSE_XC_BUILDALL,    (SV*)buildall);
133     av_store(xc, MOUSE_XC_DEMOLISHALL, (SV*)demolishall);
134
135     for(i = 0; i < len; i++){
136         SV* const klass = MOUSE_av_at(linearized_isa, i);
137         HV* const st    = gv_stashsv(klass, TRUE);
138         SV* meta;
139         GV* gv;
140
141         gv = stash_fetchs(st, "BUILD", FALSE);
142         if(gv && GvCVu(gv)){
143             av_unshift(buildall, 1);
144             av_store(buildall, 0, newRV_inc((SV*)GvCV(gv)));
145         }
146
147         gv = stash_fetchs(st, "DEMOLISH", FALSE);
148         if(gv && GvCVu(gv)){
149             av_push(demolishall, newRV_inc((SV*)GvCV(gv)));
150         }
151
152         /* ATTRIBUTES */
153         meta = get_metaclass(klass);
154         if(!SvOK(meta)){
155             continue; /* skip non-Mouse classes */
156         }
157
158         mouse_class_push_attribute_list(aTHX_ meta, attrall, seen);
159     }
160
161     FREETMPS;
162     LEAVE;
163
164     sv_setuv(MOUSE_xc_gen(xc), mro_get_pkg_gen(stash));
165 }
166
167 static AV*
168 mouse_get_xc(pTHX_ SV* const metaclass) {
169     AV* xc;
170     SV* gen;
171     HV* stash;
172     MAGIC* mg;
173
174     if(!IsObject(metaclass)){
175         croak("Not a Mouse metaclass");
176     }
177
178     mg = mouse_mg_find(aTHX_ SvRV(metaclass), &mouse_xc_vtbl, 0x00);
179     if(!mg){
180         SV* const package = get_slot(metaclass, mouse_package);
181         STRLEN len;
182         const char* const pv = SvPV_const(package, len);
183
184         stash = gv_stashpvn(pv, len, TRUE);
185         xc    = newAV();
186
187         mg = sv_magicext(SvRV(metaclass), (SV*)xc, PERL_MAGIC_ext, &mouse_xc_vtbl, pv, len);
188         SvREFCNT_dec(xc); /* refcnt++ in sv_magicext */
189
190         av_extend(xc, MOUSE_XC_last - 1);
191
192         av_store(xc, MOUSE_XC_GEN, newSVuv(0U));
193         av_store(xc, MOUSE_XC_STASH, (SV*)stash);
194
195         SvREFCNT_inc_simple_void_NN(stash);
196     }
197     else{
198         xc    = (AV*)MOUSE_mg_obj(mg);
199
200         assert(xc);
201         assert(SvTYPE(xc) == SVt_PVAV);
202     }
203
204     gen   = MOUSE_xc_gen(xc);
205
206     if(SvUVX(gen) != 0U && MOUSE_xc_flags(xc) & MOUSEf_XC_IS_IMMUTABLE){
207         return xc;
208     }
209
210     stash = MOUSE_xc_stash(xc);
211
212     if(SvUVX(gen) != mro_get_pkg_gen(stash)){
213         mouse_class_update_xc(aTHX_ metaclass, stash, xc);
214     }
215
216     return xc;
217 }
218
219 static HV*
220 mouse_buildargs(pTHX_ SV* metaclass, SV* const klass, I32 ax, I32 items) {
221     HV* args;
222
223     /* shift @_ */
224     ax++;
225     items--;
226
227     if(items == 1){
228         SV* const args_ref = ST(0);
229         if(!IsHashRef(args_ref)){
230             if(!metaclass){ metaclass = get_metaclass(klass); }
231             mouse_throw_error(metaclass, NULL, "Single parameters to new() must be a HASH ref");
232         }
233         args = newHVhv((HV*)SvRV(args_ref));
234         sv_2mortal((SV*)args);
235     }
236     else{
237         I32 i;
238
239         args = newHV_mortal();
240
241         if( (items % 2) != 0 ){
242             if(!metaclass){ metaclass = get_metaclass(klass); }
243             mouse_throw_error(metaclass, NULL, "Odd number of parameters to new()");
244         }
245
246         for(i = 0; i < items; i += 2){
247             (void)hv_store_ent(args, ST(i), newSVsv(ST(i+1)), 0U);
248         }
249
250     }
251     return args;
252 }
253
254 static void
255 mouse_report_unknown_args(pTHX_ SV* const meta, AV* const attrs, HV* const args) {
256     HV* const attr_map = newHV_mortal();
257     SV* const unknown  = newSVpvs_flags("", SVs_TEMP);
258     I32 const len      = AvFILLp(attrs) + 1;
259     I32 i;
260     HE* he;
261
262     for(i = 0; i < len; i++){
263         SV* const attr = MOUSE_av_at(attrs, i);
264         AV* const xa   = mouse_get_xa(aTHX_ attr);
265         SV* const init_arg = MOUSE_xa_init_arg(xa);
266         if(SvOK(init_arg)){
267             (void)hv_store_ent(attr_map, init_arg, &PL_sv_undef, 0U);
268         }
269     }
270
271     hv_iterinit(args);
272     while((he = hv_iternext(args))){
273         SV* const key = hv_iterkeysv(he);
274         if(!hv_exists_ent(attr_map, key, 0U)){
275             sv_catpvf(unknown, "%"SVf", ", key);
276         }
277     }
278
279     if(SvCUR(unknown) > 0){
280         SvCUR(unknown) -= 2; /* chop "," */
281     }
282     else{
283         sv_setpvs(unknown, "(unknown)");
284     }
285
286     mouse_throw_error(meta, NULL,
287         "Unknown attribute passed to the constructor of %"SVf": %"SVf,
288         mcall0(meta, mouse_name), unknown);
289 }
290
291
292
293 static void
294 mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const args, bool const is_cloning) {
295     AV* const xc    = mouse_get_xc(aTHX_ meta);
296     AV* const attrs = MOUSE_xc_attrall(xc);
297     I32 const len   = AvFILLp(attrs) + 1;
298     I32 i;
299     AV* triggers_queue = NULL;
300     U32 used = 0;
301
302     assert(meta || object);
303     assert(args);
304     assert(SvTYPE(args) == SVt_PVHV);
305
306     if(mg_find((SV*)args, PERL_MAGIC_tied)){
307         croak("You cannot use tied HASH reference as initializing arguments");
308     }
309
310     /* for each attribute */
311     for(i = 0; i < len; i++){
312         SV* const attr = MOUSE_av_at(attrs, i);
313         AV* const xa   = mouse_get_xa(aTHX_ attr);
314
315         SV* const slot     = MOUSE_xa_slot(xa);
316         U16 const flags    = (U16)MOUSE_xa_flags(xa);
317         SV* const init_arg = MOUSE_xa_init_arg(xa);
318         HE* he;
319
320         if(SvOK(init_arg) && ( he = hv_fetch_ent(args, init_arg, FALSE, 0U) ) ){
321             SV* value = HeVAL(he);
322             if(flags & MOUSEf_ATTR_HAS_TC){
323                 value = mouse_xa_apply_type_constraint(aTHX_ xa, value, flags);
324             }
325             value = set_slot(object, slot, value);
326             if(SvROK(value) && flags & MOUSEf_ATTR_IS_WEAK_REF){
327                 weaken_slot(object, slot);
328             }
329             if(flags & MOUSEf_ATTR_HAS_TRIGGER){
330                 AV* const pair = newAV();
331                 av_push(pair, newSVsv( mcall0s(attr, "trigger") ));
332                 av_push(pair, newSVsv(value));
333
334                 if(!triggers_queue) {
335                     triggers_queue = newAV_mortal();
336                 }
337                 av_push(triggers_queue, (SV*)pair);
338             }
339             used++;
340         }
341         else { /* no init arg */
342             if(flags & (MOUSEf_ATTR_HAS_DEFAULT | MOUSEf_ATTR_HAS_BUILDER)){
343                 /* skip if the object has the slot (it occurs on cloning/reblessing) */
344                 if(!(flags & MOUSEf_ATTR_IS_LAZY) && !has_slot(object, slot)){
345                     mouse_xa_set_default(aTHX_ xa, object);
346                 }
347             }
348             /* don't check while cloning (or reblesseing) */
349             else if(!is_cloning && flags & MOUSEf_ATTR_IS_REQUIRED) {
350                 mouse_throw_error(attr, NULL, "Attribute (%"SVf") is required", slot);
351             }
352         }
353     } /* for each attribute */
354
355     if(MOUSE_xc_flags(xc) & MOUSEf_XC_CONSTRUCTOR_IS_STRICT && used < HvUSEDKEYS(args)){
356         mouse_report_unknown_args(aTHX_ meta, attrs, args);
357     }
358
359     if(triggers_queue){
360         I32 const len = AvFILLp(triggers_queue) + 1;
361         for(i = 0; i < len; i++){
362             AV* const pair    = (AV*)AvARRAY(triggers_queue)[i];
363             SV* const trigger = AvARRAY(pair)[0];
364             SV* const value   = AvARRAY(pair)[1];
365
366             mcall1(object, trigger, value);
367         }
368     }
369
370     if(MOUSE_xc_flags(xc) & MOUSEf_XC_IS_ANON){
371         (void)set_slot(object, newSVpvs_flags("__METACLASS__", SVs_TEMP), meta);
372     }
373
374 }
375
376 static SV*
377 mouse_initialize_metaclass(pTHX_ SV* const klass) {
378     SV* meta = get_metaclass(klass);
379
380     if(!SvOK(meta)){
381         meta = mcall1s(newSVpvs_flags("Mouse::Meta::Class", SVs_TEMP), "initialize", klass);
382     }
383
384     return meta;
385 }
386
387 static void
388 mouse_buildall(pTHX_ AV* const xc, SV* const object, SV* const args) {
389     AV* const buildall = MOUSE_xc_buildall(xc);
390     I32 const len      = AvFILLp(buildall) + 1;
391     I32 i;
392     for(i = 0; i < len; i++){
393         dSP;
394
395         PUSHMARK(SP);
396         EXTEND(SP, 2);
397         PUSHs(object);
398         PUSHs(args);
399         PUTBACK;
400
401         call_sv_safe(AvARRAY(buildall)[i], G_VOID);
402
403         /* discard a scalar which G_VOID returns */
404         SPAGAIN;
405         (void)POPs;
406         PUTBACK;
407     }
408 }
409
410 static AV*
411 mouse_get_modifier_storage(pTHX_
412         SV* const meta,
413         enum mouse_modifier_t const m, SV* const name) {
414     static const char* const keys[] = {
415         "before",
416         "around",
417         "after",
418     };
419     SV* const key = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_method_modifiers", keys[m]));
420     SV* table;
421     SV* storage_ref;
422
423     must_defined(name, "a method name");
424
425     table = get_slot(meta, key);
426
427     if(!table){
428         /* $meta->{$key} = {} */
429         table = sv_2mortal(newRV_noinc((SV*)newHV()));
430         set_slot(meta, key, table);
431     }
432
433     storage_ref = get_slot(table, name);
434
435     if(!storage_ref){
436         storage_ref = sv_2mortal(newRV_noinc((SV*)newAV()));
437         set_slot(table, name, storage_ref);
438     }
439     else{
440         if(!IsArrayRef(storage_ref)){
441             croak("Modifier strorage for '%s' is not an ARRAY reference", keys[m]);
442         }
443     }
444
445     return (AV*)SvRV(storage_ref);
446 }
447
448 static void
449 XS_Mouse_value_holder(pTHX_ CV* const cv PERL_UNUSED_DECL) {
450     dVAR; dXSARGS;
451     SV* const value = (SV*)XSANY.any_ptr;
452     assert(value);
453     PERL_UNUSED_VAR(items);
454     ST(0) = value;
455     XSRETURN(1);
456 }
457
458 DECL_BOOT(Mouse__Util);
459 DECL_BOOT(Mouse__Util__TypeConstraints);
460 DECL_BOOT(Mouse__Meta__Method__Accessor__XS);
461 DECL_BOOT(Mouse__Meta__Attribute);
462
463 MODULE = Mouse  PACKAGE = Mouse
464
465 PROTOTYPES: DISABLE
466
467 BOOT:
468 {
469     mouse_package   = newSVpvs_share("package");
470     mouse_namespace = newSVpvs_share("namespace");
471     mouse_methods   = newSVpvs_share("methods");
472     mouse_name      = newSVpvs_share("name");
473     mouse_coerce    = newSVpvs_share("coerce");
474
475     mouse_get_attribute      = newSVpvs_share("get_attribute");
476     mouse_get_attribute_list = newSVpvs_share("get_attribute_list");
477
478     CALL_BOOT(Mouse__Util);
479     CALL_BOOT(Mouse__Util__TypeConstraints);
480     CALL_BOOT(Mouse__Meta__Method__Accessor__XS);
481     CALL_BOOT(Mouse__Meta__Attribute);
482 }
483
484 MODULE = Mouse  PACKAGE = Mouse::Meta::Module
485
486 BOOT:
487     INSTALL_SIMPLE_READER_WITH_KEY(Module, name, package);
488     INSTALL_SIMPLE_READER_WITH_KEY(Module, _method_map, methods);
489     INSTALL_SIMPLE_READER_WITH_KEY(Module, _attribute_map, attributes);
490
491 HV*
492 namespace(SV* self)
493 CODE:
494 {
495     SV* const package = get_slot(self, mouse_package);
496     if(!(package && SvOK(package))){
497         croak("No package name defined");
498     }
499     RETVAL = gv_stashsv(package, GV_ADDMULTI);
500 }
501 OUTPUT:
502     RETVAL
503
504 # ignore extra arguments for extensibility
505 void
506 add_method(SV* self, SV* name, SV* code, ...)
507 CODE:
508 {
509     SV* const package = get_slot(self, mouse_package); /* $self->{package} */
510     SV* const methods = get_slot(self, mouse_methods); /* $self->{methods} */
511     GV* gv;
512     SV* code_ref;
513
514     if(!(package && SvOK(package))){
515         croak("No package name defined");
516     }
517
518     must_defined(name, "a method name");
519     must_ref    (code, "a CODE reference", SVt_NULL); /* any reftype is OK */
520
521     code_ref = code;
522     if(SvTYPE(SvRV(code_ref)) != SVt_PVCV){
523         SV*  sv = code_ref;  /* used in tryAMAGICunDEREF */
524         SV** sp = &sv;       /* used in tryAMAGICunDEREF */
525         tryAMAGICunDEREF(to_cv); /* try \&{$code} */
526         must_ref(code, "a CODE reference", SVt_PVCV);
527         code_ref = sv;
528     }
529
530     /*  *{$package . '::' . $name} -> *gv */
531     gv = gv_fetchpv(form("%"SVf"::%"SVf, package, name), GV_ADDMULTI, SVt_PVCV);
532     mouse_install_sub(aTHX_ gv, code_ref);
533     //CvMETHOD_on((CV*)SvRV(code_ref));
534     (void)set_slot(methods, name, code); /* $self->{methods}{$name} = $code */
535 }
536
537 void
538 add_class_accessor(SV* self, SV* name)
539 CODE:
540 {
541     SV* const klass = mouse_call0(self, mouse_name);
542     const char* fq_name = form("%"SVf"::%"SVf, klass, name);
543     STRLEN keylen;
544     const char* const key = SvPV_const(name, keylen);
545     mouse_simple_accessor_generate(aTHX_ fq_name, key, keylen,
546         XS_Mouse_inheritable_class_accessor, NULL, 0);
547 }
548
549 MODULE = Mouse  PACKAGE = Mouse::Meta::Class
550
551 BOOT:
552 {
553     CV* xsub;
554
555     INSTALL_SIMPLE_READER(Class, roles);
556     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id);
557     INSTALL_SIMPLE_READER(Class, is_immutable);
558
559     INSTALL_INHERITABLE_CLASS_ACCESSOR(strict_constructor);
560
561     INSTALL_CLASS_HOLDER(Class, method_metaclass,     "Mouse::Meta::Method");
562     INSTALL_CLASS_HOLDER(Class, attribute_metaclass,  "Mouse::Meta::Attribute");
563     INSTALL_CLASS_HOLDER(Class, constructor_class,    "Mouse::Meta::Method::Constructor::XS");
564     INSTALL_CLASS_HOLDER(Class, destructor_class,     "Mouse::Meta::Method::Destructor::XS");
565
566     xsub = newXS("Mouse::Meta::Method::Constructor::XS::_generate_constructor",
567         XS_Mouse_value_holder, file);
568     CvXSUBANY(xsub).any_ptr
569         = newRV_inc((SV*)get_cvs("Mouse::Object::new", GV_ADD));
570
571     xsub = newXS("Mouse::Meta::Method::Destructor::XS::_generate_destructor",
572         XS_Mouse_value_holder, file);
573     CvXSUBANY(xsub).any_ptr
574         = newRV_inc((SV*)get_cvs("Mouse::Object::DESTROY", GV_ADD));
575 }
576
577
578 void
579 linearized_isa(SV* self)
580 PPCODE:
581 {
582     SV* const stash_ref = mcall0(self, mouse_namespace); /* $self->namespace */
583     AV* linearized_isa;
584     I32 len;
585     I32 i;
586     if(!(SvROK(stash_ref) && SvTYPE(SvRV(stash_ref)) == SVt_PVHV)){
587         croak("namespace() didn't return a HASH reference");
588     }
589     linearized_isa = mro_get_linear_isa((HV*)SvRV(stash_ref));
590     len = AvFILLp(linearized_isa) + 1;
591     EXTEND(SP, len);
592     for(i = 0; i < len; i++){
593         PUSHs(AvARRAY(linearized_isa)[i]);
594     }
595 }
596
597 void
598 get_all_attributes(SV* self)
599 PPCODE:
600 {
601     AV* const xc        = mouse_get_xc(aTHX_ self);
602     AV* const all_attrs = MOUSE_xc_attrall(xc);
603     I32 const len       = AvFILLp(all_attrs) + 1;
604     I32 i;
605
606     EXTEND(SP, len);
607     for(i = 0; i < len; i++){
608         PUSHs( MOUSE_av_at(all_attrs, i) );
609     }
610 }
611
612 void
613 new_object(SV* meta, ...)
614 CODE:
615 {
616     AV* const xc   = mouse_get_xc(aTHX_ meta);
617     HV* const args = mouse_buildargs(aTHX_ meta, NULL, ax, items);
618     SV* object;
619
620     object = mouse_instance_create(aTHX_ MOUSE_xc_stash(xc));
621     mouse_class_initialize_object(aTHX_ meta, object, args, FALSE);
622     mouse_buildall(aTHX_ xc, object, sv_2mortal(newRV_inc((SV*)args))); /* BUILDALL */
623     ST(0) = object; /* because object is mortal, we should return it as is */
624     XSRETURN(1);
625 }
626
627 void
628 clone_object(SV* meta, SV* object, ...)
629 CODE:
630 {
631     AV* const xc   = mouse_get_xc(aTHX_ meta);
632     HV* const args = mouse_buildargs(aTHX_ meta, NULL, ax + 1, items - 1);
633     SV* proto;
634
635     if(!mouse_is_an_instance_of(aTHX_ MOUSE_xc_stash(xc), object)) {
636         mouse_throw_error(meta, object,
637             "You must pass an instance of the metaclass (%"SVf"), not (%"SVf")",
638             mcall0(meta, mouse_name), object);
639     }
640
641     proto = mouse_instance_clone(aTHX_ object);
642     mouse_class_initialize_object(aTHX_ meta, proto, args, TRUE);
643     ST(0) = proto; /* because object is mortal, we should return it as is */
644     XSRETURN(1);
645 }
646
647 void
648 _initialize_object(SV* meta, SV* object, HV* args, bool is_cloning = FALSE)
649 CODE:
650 {
651     mouse_class_initialize_object(aTHX_ meta, object, args, is_cloning);
652 }
653
654 MODULE = Mouse  PACKAGE = Mouse::Meta::Role
655
656 BOOT:
657     INSTALL_SIMPLE_READER_WITH_KEY(Role, get_roles, roles);
658     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Role, is_anon_role, anon_serial_id);
659
660     INSTALL_CLASS_HOLDER(Role, method_metaclass,  "Mouse::Meta::Role::Method");
661
662 void
663 add_before_modifier(SV* self, SV* name, SV* modifier)
664 CODE:
665 {
666     av_push(mouse_get_modifier_storage(aTHX_ self, (enum mouse_modifier_t)ix, name), newSVsv(modifier));
667 }
668 ALIAS:
669     add_before_method_modifier = MOUSE_M_BEFORE
670     add_around_method_modifier = MOUSE_M_AROUND
671     add_after_method_modifier  = MOUSE_M_AFTER
672
673 void
674 get_before_modifiers(SV* self, SV* name)
675 ALIAS:
676     get_before_method_modifiers = MOUSE_M_BEFORE
677     get_around_method_modifiers = MOUSE_M_AROUND
678     get_after_method_modifiers  = MOUSE_M_AFTER
679 PPCODE:
680 {
681     AV* const storage = mouse_get_modifier_storage(aTHX_ self, (enum mouse_modifier_t)ix, name);
682     I32 const len     = av_len(storage) + 1;
683     if(GIMME_V == G_ARRAY) {
684         I32 i;
685         EXTEND(SP, len);
686         for(i = 0; i < len; i++){
687             PUSHs(*av_fetch(storage, i, TRUE));
688         }
689     }
690     else{
691         mPUSHi(len);
692     }
693 }
694
695 MODULE = Mouse  PACKAGE = Mouse::Object
696
697 void
698 new(SV* klass, ...)
699 CODE:
700 {
701     SV* const meta = mouse_initialize_metaclass(aTHX_ klass);
702     AV* const xc   = mouse_get_xc(aTHX_ meta);
703     UV const flags = MOUSE_xc_flags(xc);
704     SV* args;
705     SV* object;
706
707     /* BUILDARGS */
708     if(flags & MOUSEf_XC_HAS_BUILDARGS){
709         I32 i;
710         SPAGAIN;
711
712         PUSHMARK(SP);
713         EXTEND(SP, items);
714         for(i = 0; i < items; i++){
715             PUSHs(ST(i));
716         }
717
718         PUTBACK;
719         call_method_safes("BUILDARGS", G_SCALAR);
720
721         SPAGAIN;
722         args = POPs;
723         PUTBACK;
724
725         if(!IsHashRef(args)){
726             croak("BUILDARGS did not return a HASH reference");
727         }
728     }
729     else{
730         args = newRV_inc((SV*)mouse_buildargs(aTHX_ meta, klass, ax, items));
731         sv_2mortal(args);
732     }
733
734     /* new_object */
735     object = mouse_instance_create(aTHX_ MOUSE_xc_stash(xc));
736     mouse_class_initialize_object(aTHX_ meta, object, (HV*)SvRV(args), FALSE);
737     mouse_buildall(aTHX_ xc, object, args); /* BUILDALL */
738     ST(0) = object; /* because object is mortal, we should return it as is */
739     XSRETURN(1);
740 }
741
742 void
743 DESTROY(SV* object)
744 ALIAS:
745     DESTROY     = 0
746     DEMOLISHALL = 1
747 CODE:
748 {
749     SV* const meta = get_metaclass(object);
750     AV* demolishall;
751     I32 len, i;
752
753     if(!IsObject(object)){
754         croak("You must not call %s as a class method",
755             ix == 0 ? "DESTROY" : "DEMOLISHALL");
756     }
757
758     if(SvOK(meta)){
759         AV* const xc = mouse_get_xc(aTHX_ meta);
760
761         demolishall = MOUSE_xc_demolishall(xc);
762     }
763     else { /* The metaclass is already destroyed */
764         AV* const linearized_isa = mro_get_linear_isa(SvSTASH(SvRV(object)));
765
766         len = AvFILLp(linearized_isa) + 1;
767
768         demolishall = newAV_mortal();
769         for(i = 0; i < len; i++){
770             SV* const klass = MOUSE_av_at(linearized_isa, i);
771             HV* const st    = gv_stashsv(klass, TRUE);
772             GV* const gv    = stash_fetchs(st, "DEMOLISH", FALSE);
773             if(gv && GvCVu(gv)){
774                 av_push(demolishall, newRV_inc((SV*)GvCV(gv)));
775             }
776         }
777     }
778
779     len      = AvFILLp(demolishall) + 1;
780     if(len > 0){
781         SV* const in_global_destruction = boolSV(PL_dirty);
782         SAVEI32(PL_statusvalue); /* local $? */
783         PL_statusvalue = 0;
784
785         SAVESPTR(ERRSV); /* local $@ */
786         ERRSV = sv_newmortal();
787
788         EXTEND(SP, 2);
789
790         for(i = 0; i < len; i++){
791             SPAGAIN;
792
793             PUSHMARK(SP);
794             PUSHs(object);
795             PUSHs(in_global_destruction);
796             PUTBACK;
797
798             call_sv(AvARRAY(demolishall)[i], G_VOID | G_EVAL);
799
800             /* discard a scalar which G_VOID returns */
801             SPAGAIN;
802             (void)POPs;
803             PUTBACK;
804
805             if(sv_true(ERRSV)){
806                 SV* const e = newSVsv(ERRSV);
807
808                 FREETMPS;
809                 LEAVE;
810
811                 sv_setsv(ERRSV, e);
812                 SvREFCNT_dec(e);
813                 croak(NULL); /* rethrow */
814             }
815         }
816     }
817 }
818
819 HV*
820 BUILDARGS(SV* klass, ...)
821 CODE:
822 {
823     RETVAL = mouse_buildargs(aTHX_ NULL, klass, ax, items);
824 }
825 OUTPUT:
826     RETVAL
827
828
829 void
830 BUILDALL(SV* self, SV* args)
831 CODE:
832 {
833     SV* const meta = get_metaclass(self);
834     AV* const xc   = mouse_get_xc(aTHX_ meta);
835
836     must_ref(args, "a HASH reference to BUILDALL", SVt_PVHV);
837     mouse_buildall(aTHX_ xc, self, args);
838 }