Mouse::Util::does_role() respects $thing->does() method
[gitmo/Mouse.git] / xs-src / MouseAccessor.xs
1 #include "mouse.h"
2
3 #define CHECK_INSTANCE(instance) STMT_START{                           \
4         assert(instance);                                              \
5         if(UNLIKELY(                                                   \
6                 !(SvROK(instance)                                      \
7                 && SvTYPE(SvRV(instance)) == SVt_PVHV) )){             \
8             croak("Invalid object instance: '%"SVf"'", instance);      \
9         }                                                              \
10     } STMT_END
11
12
13 #define MOUSE_mg_attribute(mg) MOUSE_xa_attribute(MOUSE_mg_xa(mg))
14
15 static MGVTBL mouse_accessor_vtbl; /* MAGIC identity */
16
17 #define dMOUSE_self  SV* const self = mouse_accessor_get_self(aTHX_ ax, items, cv)
18
19 /* simple instance slot accessor (or Mouse::Meta::Instance) */
20
21 SV*
22 mouse_instance_create(pTHX_ HV* const stash) {
23     SV* instance;
24     assert(stash);
25     assert(SvTYPE(stash) == SVt_PVHV);
26     instance = sv_bless( newRV_noinc((SV*)newHV()), stash );
27     return sv_2mortal(instance);
28 }
29
30 SV*
31 mouse_instance_clone(pTHX_ SV* const instance) {
32     SV* proto;
33     CHECK_INSTANCE(instance);
34     assert(SvOBJECT(SvRV(instance)));
35
36     proto = newRV_noinc((SV*)newHVhv((HV*)SvRV(instance)));
37     sv_bless(proto, SvSTASH(SvRV(instance)));
38     return sv_2mortal(proto);
39 }
40
41 bool
42 mouse_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
43     assert(slot);
44     CHECK_INSTANCE(instance);
45     return hv_exists_ent((HV*)SvRV(instance), slot, 0U);
46 }
47
48 SV*
49 mouse_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
50     HE* he;
51     assert(slot);
52     CHECK_INSTANCE(instance);
53     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
54     return he ? HeVAL(he) : NULL;
55 }
56
57 SV*
58 mouse_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value) {
59     HE* he;
60     SV* sv;
61     assert(slot);
62     assert(value);
63     CHECK_INSTANCE(instance);
64     he = hv_fetch_ent((HV*)SvRV(instance), slot, TRUE, 0U);
65     sv = HeVAL(he);
66     sv_setsv(sv, value);
67     SvSETMAGIC(sv);
68     return sv;
69 }
70
71 SV*
72 mouse_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
73     assert(instance);
74     assert(slot);
75     CHECK_INSTANCE(instance);
76     return hv_delete_ent((HV*)SvRV(instance), slot, 0, 0U);
77 }
78
79 void
80 mouse_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
81     HE* he;
82     assert(slot);
83     CHECK_INSTANCE(instance);
84     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
85     if(he){
86         sv_rvweaken(HeVAL(he));
87     }
88 }
89
90 /* utilities */
91
92 STATIC_INLINE SV*
93 mouse_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) {
94     if(UNLIKELY( items < 1 )){
95         croak("Too few arguments for %s", GvNAME(CvGV(cv)));
96     }
97     /* NOTE: If self has GETMAGIC, $self->accessor will invoke GETMAGIC
98      *       before calling methods, so SvGETMAGIC(self) is not required here.
99      */
100     return ST(0);
101 }
102
103
104 CV*
105 mouse_accessor_generate(pTHX_ SV* const attr, XSUBADDR_t const accessor_impl){
106     AV* const xa = mouse_get_xa(aTHX_ attr);
107     CV* xsub;
108     MAGIC* mg;
109
110     xsub = newXS(NULL, accessor_impl, __FILE__);
111     sv_2mortal((SV*)xsub);
112
113     mg = sv_magicext((SV*)xsub, MOUSE_xa_slot(xa),
114         PERL_MAGIC_ext, &mouse_accessor_vtbl, (char*)xa, HEf_SVKEY);
115
116     MOUSE_mg_flags(mg) = (U16)MOUSE_xa_flags(xa);
117
118     /* NOTE:
119      * although we use MAGIC for gc, we also store mg to
120      * CvXSUBANY for efficiency (gfx)
121      */
122     CvXSUBANY(xsub).any_ptr = (void*)mg;
123
124     return xsub;
125 }
126
127
128 /* pushes return values, does auto-deref if needed */
129 static void
130 mouse_push_values(pTHX_ SV* const value, U16 const flags){
131     dSP;
132
133     assert( flags & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY );
134
135     if(!(value && SvOK(value))){
136         return;
137     }
138
139     if(flags & MOUSEf_TC_IS_ARRAYREF){
140         AV* av;
141         I32 len;
142         I32 i;
143
144         if(!IsArrayRef(value)){
145             croak("Mouse-panic: Not an ARRAY reference");
146         }
147
148         av  = (AV*)SvRV(value);
149         len = av_len(av) + 1;
150         EXTEND(SP, len);
151         for(i = 0; i < len; i++){
152             SV** const svp = av_fetch(av, i, FALSE);
153             PUSHs(svp ? *svp : &PL_sv_undef);
154         }
155     }
156     else{
157         HV* hv;
158         HE* he;
159
160         assert(flags & MOUSEf_TC_IS_HASHREF);
161
162         if(!IsHashRef(value)){
163             croak("Mouse-panic: Not a HASH reference");
164         }
165
166         hv = (HV*)SvRV(value);
167         hv_iterinit(hv);
168         while((he = hv_iternext(hv))){
169             EXTEND(SP, 2);
170             PUSHs(hv_iterkeysv(he));
171             PUSHs(hv_iterval(hv, he));
172         }
173     }
174
175     PUTBACK;
176 }
177
178 STATIC_INLINE void
179 mouse_push_value(pTHX_ SV* const value, U16 const flags) {
180     if(flags & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY){
181         mouse_push_values(aTHX_ value, flags);
182     }
183     else{
184         dSP;
185         XPUSHs(value ? value : &PL_sv_undef);
186         PUTBACK;
187     }
188 }
189
190 STATIC_INLINE void
191 mouse_attr_get(pTHX_ SV* const self, MAGIC* const mg){
192     U16 const flags = MOUSE_mg_flags(mg);
193     SV* value;
194
195     value = get_slot(self, MOUSE_mg_slot(mg));
196
197     /* check_lazy */
198     if( !value && flags & MOUSEf_ATTR_IS_LAZY ){
199         value = mouse_xa_set_default(aTHX_ MOUSE_mg_xa(mg), self);
200     }
201
202     mouse_push_value(aTHX_ value, flags);
203 }
204
205 static void
206 mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){
207     U16 const flags = MOUSE_mg_flags(mg);
208     SV* const slot  = MOUSE_mg_slot(mg);
209
210     if(flags & MOUSEf_ATTR_HAS_TC){
211         value = mouse_xa_apply_type_constraint(aTHX_ MOUSE_mg_xa(mg), value, flags);
212     }
213
214     value = set_slot(self, slot, value);
215
216     if(flags & MOUSEf_ATTR_IS_WEAK_REF){
217         weaken_slot(self, slot);
218     }
219
220     if(flags & MOUSEf_ATTR_HAS_TRIGGER){
221         SV* const trigger = mcall0s(MOUSE_mg_attribute(mg), "trigger");
222         dSP;
223
224         /* NOTE: triggers can remove value, so
225                  value must be copied here,
226                  revealed by Net::Google::DataAPI (DANJOU).
227          */
228         value = sv_mortalcopy(value);
229
230         PUSHMARK(SP);
231         EXTEND(SP, 2);
232         PUSHs(self);
233         PUSHs(value);
234
235         PUTBACK;
236         call_sv_safe(trigger, G_VOID | G_DISCARD);
237         /* need not SPAGAIN */
238
239         assert(SvTYPE(value) != SVTYPEMASK);
240     }
241
242     mouse_push_value(aTHX_ value, flags);
243 }
244
245 XS(XS_Mouse_accessor)
246 {
247     dVAR; dXSARGS;
248     dMOUSE_self;
249     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
250
251     SP -= items; /* PPCODE */
252     PUTBACK;
253
254     if(items == 1){ /* reader */
255         mouse_attr_get(aTHX_ self, mg);
256     }
257     else if (items == 2){ /* writer */
258         mouse_attr_set(aTHX_ self, mg, ST(1));
259     }
260     else{
261         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
262             "Expected exactly one or two argument for an accessor of %"SVf,
263             MOUSE_mg_slot(mg));
264     }
265 }
266
267
268 XS(XS_Mouse_reader)
269 {
270     dVAR; dXSARGS;
271     dMOUSE_self;
272     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
273
274     if (items != 1) {
275         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
276             "Cannot assign a value to a read-only accessor of %"SVf,
277             MOUSE_mg_slot(mg));
278     }
279
280     SP -= items; /* PPCODE */
281     PUTBACK;
282
283     mouse_attr_get(aTHX_ self, mg);
284 }
285
286 XS(XS_Mouse_writer)
287 {
288     dVAR; dXSARGS;
289     dMOUSE_self;
290     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
291
292     if (items != 2) {
293         mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
294             "Too few arguments for a write-only accessor of %"SVf,
295             MOUSE_mg_slot(mg));
296     }
297
298     SP -= items; /* PPCODE */
299     PUTBACK;
300
301     mouse_attr_set(aTHX_ self, mg, ST(1));
302 }
303
304 /* simple accessors */
305
306 /*
307 static MAGIC*
308 mouse_accessor_get_mg(pTHX_ CV* const xsub){
309     return moose_mg_find(aTHX_ (SV*)xsub, &mouse_simple_accessor_vtbl, MOOSEf_DIE_ON_FAIL);
310 }
311 */
312
313 CV*
314 mouse_simple_accessor_generate(pTHX_
315     const char* const fq_name, const char* const key, I32 const keylen,
316     XSUBADDR_t const accessor_impl, void* const dptr, I32 const dlen) {
317     CV* const xsub = newXS((char*)fq_name, accessor_impl, __FILE__);
318     SV* const slot = newSVpvn_share(key, keylen, 0U);
319     MAGIC* mg;
320
321     if(!fq_name){
322         /* anonymous xsubs need sv_2mortal() */
323         sv_2mortal((SV*)xsub);
324     }
325
326     mg = sv_magicext((SV*)xsub, slot,
327         PERL_MAGIC_ext, &mouse_accessor_vtbl, (char*)dptr, dlen);
328
329     SvREFCNT_dec(slot); /* sv_magicext() increases refcnt in mg_obj */
330     if(dlen == HEf_SVKEY){
331         SvREFCNT_dec(dptr);
332     }
333
334     /* NOTE:
335      * although we use MAGIC for gc, we also store mg to CvXSUBANY
336      * for efficiency (gfx)
337      */
338     CvXSUBANY(xsub).any_ptr = (void*)mg;
339
340     return xsub;
341 }
342
343 XS(XS_Mouse_simple_reader)
344 {
345     dVAR; dXSARGS;
346     dMOUSE_self;
347     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
348     SV* value;
349
350     if (items != 1) {
351         croak("Expected exactly one argument for a reader of %"SVf,
352             MOUSE_mg_slot(mg));
353     }
354
355     value = get_slot(self, MOUSE_mg_slot(mg));
356     if(!value) {
357         if(MOUSE_mg_ptr(mg)){
358             /* the default value must be a SV */
359             assert(MOUSE_mg_len(mg) == HEf_SVKEY);
360             value = (SV*)MOUSE_mg_ptr(mg);
361         }
362         else{
363             value = &PL_sv_undef;
364         }
365     }
366
367     ST(0) = value;
368     XSRETURN(1);
369 }
370
371
372 XS(XS_Mouse_simple_writer)
373 {
374     dVAR; dXSARGS;
375     dMOUSE_self;
376     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
377
378     if (items != 2) {
379         croak("Expected exactly two argument for a writer of %"SVf,
380             slot);
381     }
382
383     ST(0) = set_slot(self, slot, ST(1));
384     XSRETURN(1);
385 }
386
387 XS(XS_Mouse_simple_clearer)
388 {
389     dVAR; dXSARGS;
390     dMOUSE_self;
391     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
392     SV* value;
393
394     if (items != 1) {
395         croak("Expected exactly one argument for a clearer of %"SVf,
396             slot);
397     }
398
399     value = delete_slot(self, slot);
400     ST(0) = value ? value : &PL_sv_undef;
401     XSRETURN(1);
402 }
403
404 XS(XS_Mouse_simple_predicate)
405 {
406     dVAR; dXSARGS;
407     dMOUSE_self;
408     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
409
410     if (items != 1) {
411         croak("Expected exactly one argument for a predicate of %"SVf, slot);
412     }
413
414     ST(0) = boolSV( has_slot(self, slot) );
415     XSRETURN(1);
416 }
417
418 /* Class::Data::Inheritable-like class accessor */
419 XS(XS_Mouse_inheritable_class_accessor) {
420     dVAR; dXSARGS;
421     dMOUSE_self;
422     SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
423     SV* value;
424     HV* stash;
425
426     if(items == 1){ /* reader */
427         value = NULL;
428     }
429     else if (items == 2){ /* writer */
430         value = ST(1);
431     }
432     else{
433         croak("Expected exactly one or two argument for a class data accessor"
434             "of %"SVf, slot);
435         value = NULL; /* -Wuninitialized */
436     }
437
438     stash = mouse_get_namespace(aTHX_ self);
439
440     if(!value) { /* reader */
441         value = get_slot(self, slot);
442         if(!value) {
443             AV* const isa   = mro_get_linear_isa(stash);
444             I32 const len   = av_len(isa) + 1;
445             I32 i;
446             for(i = 1; i < len; i++) {
447                 SV* const klass = MOUSE_av_at(isa, i);
448                 SV* const meta  = get_metaclass(klass);
449                 if(!SvOK(meta)){
450                     continue; /* skip non-Mouse classes */
451                 }
452                 value = get_slot(meta, slot);
453                 if(value) {
454                     break;
455                 }
456             }
457             if(!value) {
458                 value = &PL_sv_undef;
459             }
460         }
461     }
462     else { /* writer */
463         set_slot(self, slot, value);
464         mro_method_changed_in(stash);
465     }
466
467     ST(0) = value;
468     XSRETURN(1);
469 }
470
471
472 MODULE = Mouse::Meta::Method::Accessor::XS  PACKAGE = Mouse::Meta::Method::Accessor::XS
473
474 PROTOTYPES:   DISABLE
475 VERSIONCHECK: DISABLE
476
477 CV*
478 _generate_accessor(klass, SV* attr, metaclass)
479 CODE:
480 {
481     RETVAL = mouse_accessor_generate(aTHX_ attr, XS_Mouse_accessor);
482 }
483 OUTPUT:
484     RETVAL
485
486 CV*
487 _generate_reader(klass, SV* attr, metaclass)
488 CODE:
489 {
490     RETVAL = mouse_accessor_generate(aTHX_ attr, XS_Mouse_reader);
491 }
492 OUTPUT:
493     RETVAL
494
495 CV*
496 _generate_writer(klass, SV* attr, metaclass)
497 CODE:
498 {
499     RETVAL = mouse_accessor_generate(aTHX_ attr, XS_Mouse_writer);
500 }
501 OUTPUT:
502     RETVAL
503
504 CV*
505 _generate_clearer(klass, SV* attr, metaclass)
506 CODE:
507 {
508     SV* const slot = mcall0(attr, mouse_name);
509     STRLEN len;
510     const char* const pv = SvPV_const(slot, len);
511     RETVAL = mouse_simple_accessor_generate(aTHX_ NULL, pv, len, XS_Mouse_simple_clearer, NULL, 0);
512 }
513 OUTPUT:
514     RETVAL
515
516 CV*
517 _generate_predicate(klass, SV* attr, metaclass)
518 CODE:
519 {
520     SV* const slot = mcall0(attr, mouse_name);
521     STRLEN len;
522     const char* const pv = SvPV_const(slot, len);
523     RETVAL = mouse_simple_accessor_generate(aTHX_ NULL, pv, len, XS_Mouse_simple_predicate, NULL, 0);
524 }
525 OUTPUT:
526     RETVAL
527