Commit | Line | Data |
1ea12c91 |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
4 | |
035fd0c4 |
5 | #define NEED_newRV_noinc |
6 | #define NEED_newSVpvn_share |
7 | #define NEED_sv_2pv_flags |
8 | #include "ppport.h" |
9 | |
10 | #ifndef XSPROTO |
11 | #define XSPROTO(name) void name(pTHX_ CV* cv) |
12 | #endif |
13 | |
14 | #ifndef gv_stashpvs |
15 | #define gv_stashpvs(x, y) gv_stashpvn(STR_WITH_LEN(x), y) |
16 | #endif |
17 | |
1ea12c91 |
18 | /* FIXME |
19 | * needs to be made into Moose::XS::Meta::Instance and Meta::Slot for the |
20 | * metadata, with a proper destructor. XSANY still points to this struct, but |
21 | * it is shared by all functions of the same type. |
22 | * |
de2f2e97 |
23 | * Instance contains SvSTASH, and ATTR slots[] |
1ea12c91 |
24 | * |
de2f2e97 |
25 | * On recreation of the meta instance we refresh the ATTR value of all the CVs |
1ea12c91 |
26 | * we installed |
27 | * |
28 | * need a good way to handle time between invalidate and regeneration (just |
29 | * check XSANY and call get_meta_instance if null?) |
30 | */ |
31 | |
1ea12c91 |
32 | /* FIXME |
33 | * type constraints are already implemented by konobi |
34 | * should be trivial to do coercions for the core types, too |
35 | * |
36 | * TypeConstraint::Class can compare SvSTASH by ptr, and if it's neq *then* |
37 | * call ->isa (should handle vast majority of cases) |
38 | * |
39 | * base parametrized types are also trivial |
40 | * |
41 | * ClassName is get_stathpvn |
42 | */ |
43 | |
44 | /* FIXME |
de2f2e97 |
45 | * for a constructor we have ATTR *attrs, and iterate that, removing init_arg |
1ea12c91 |
46 | * we can preallocate the structure to the right size (maybe even with the |
47 | * right HEs?), and do various other prehashing hacks to gain speed |
48 | * */ |
49 | |
50 | /* FIXME |
51 | * delegations and attribute helpers: |
52 | * |
53 | * typedef struct { |
de2f2e97 |
54 | * ATTR *attr; |
1ea12c91 |
55 | * pv *method; |
56 | * } delegation; |
57 | * |
58 | * typedef struct { |
de2f2e97 |
59 | * ATTR *attr; |
1ea12c91 |
60 | * I32 *type; // hash, array, whatever + vtable for operation |
61 | * } attributehelper; |
62 | */ |
63 | |
de2f2e97 |
64 | |
65 | STATIC MGVTBL null_mg_vtbl = { |
66 | NULL, /* get */ |
67 | NULL, /* set */ |
68 | NULL, /* len */ |
69 | NULL, /* clear */ |
70 | NULL, /* free */ |
71 | #if MGf_COPY |
72 | NULL, /* copy */ |
73 | #endif /* MGf_COPY */ |
74 | #if MGf_DUP |
75 | NULL, /* dup */ |
76 | #endif /* MGf_DUP */ |
77 | #if MGf_LOCAL |
78 | NULL, /* local */ |
79 | #endif /* MGf_LOCAL */ |
80 | }; |
81 | |
f253044f |
82 | STATIC MAGIC *stash_in_mg (pTHX_ SV *sv, SV *obj) { |
83 | MAGIC *mg = sv_magicext(sv, obj, PERL_MAGIC_ext, &null_mg_vtbl, NULL, 0 ); |
84 | mg->mg_flags |= MGf_REFCOUNTED; |
85 | |
86 | return mg; |
87 | } |
88 | |
89 | STATIC SV *get_stashed_in_mg(pTHX_ SV *sv) { |
90 | MAGIC *mg, *moremagic; |
91 | |
92 | if (SvTYPE(sv) >= SVt_PVMG) { |
93 | for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { |
94 | if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_virtual == &null_mg_vtbl)) |
95 | break; |
96 | } |
97 | if (mg) |
98 | return mg->mg_obj; |
99 | } |
100 | |
101 | return NULL; |
102 | } |
de2f2e97 |
103 | |
104 | |
105 | typedef enum { |
106 | Any = 0, |
107 | Item, |
108 | Bool, |
109 | Maybe, /* [`a] */ |
110 | Undef, |
111 | Defined, |
112 | Value, |
113 | Num, |
114 | Int, |
115 | Str, |
116 | ClassName, |
117 | Ref, |
118 | ScalarRef, |
119 | ArrayRef, /* [`a] */ |
120 | HashRef, /* [`a] */ |
121 | CodeRef, |
122 | RegexpRef, |
123 | GlobRef, |
124 | FileHandle, |
125 | Object, |
126 | Role, |
127 | |
128 | /* XS only types */ |
129 | Class, |
130 | |
131 | max_TC |
132 | } TC; |
133 | |
134 | typedef union { |
135 | TC type; |
136 | CV *cv; |
137 | HV *stash; |
138 | OP *op; |
139 | } TC_CHECK; |
140 | |
141 | typedef enum { |
142 | tc_none = 0, |
143 | tc_type, |
144 | tc_cv, |
145 | tc_stash, |
146 | tc_op, |
147 | } tc_kind; |
148 | |
149 | typedef union { |
150 | char *builder; |
151 | SV *value; |
152 | CV *sub; |
153 | OP *op; |
154 | U32 type; |
155 | } DEFAULT; |
156 | |
157 | typedef enum { |
158 | default_none = 0, |
159 | default_type, |
160 | default_builder, |
161 | default_value, |
162 | default_sub, |
163 | default_op, |
164 | } default_kind; |
165 | |
1ea12c91 |
166 | typedef struct { |
de2f2e97 |
167 | /* the meta instance struct */ |
168 | struct mi *mi; |
169 | |
170 | U32 flags; /* slot type, TC behavior, coerce, weaken, (no default | default, builder + lazy), auto_deref */ |
171 | |
172 | /* slot access fields */ |
173 | SV *slot_sv; /* value of the slot (slot name presumably) */ |
174 | U32 slot_u32; /* for optimized access (precomputed hash or otherr) */ |
175 | |
176 | DEFAULT def; /* cv, value or other, depending on flags */ |
177 | |
178 | TC_CHECK tc_check; /* cv, value or other, dependidng on flags */ |
179 | SV *type_constraint; /* meta attr */ |
180 | |
181 | CV *initializer; |
182 | CV *trigger; |
183 | |
f253044f |
184 | SV *meta_attr; /* the meta attr object */ |
de2f2e97 |
185 | AV *cvs; /* CVs which use this attr */ |
186 | } ATTR; |
187 | |
188 | /* slot flags: |
189 | * instance reading writing |
190 | * 00000000 00000000 00000000 00000000 |
191 | * ^ trigger |
192 | * ^ weak |
193 | * ^^^ tc_kind |
194 | * ^ coerce |
195 | * ^^^ default_kind |
196 | * ^ lazy |
197 | * ^ required |
198 | * ^^^^^^^ if 0 then nothing special (just hash)? FIXME TBD |
199 | */ |
200 | |
201 | #define ATTR_INSTANCE_MASK 0xff000000 |
202 | #define ATTR_READING_MASK 0x0000ff00 |
203 | #define ATTR_WRITING_MASK 0x000000ff |
204 | |
205 | #define ATTR_MASK_TYPE 0x7 |
206 | |
207 | #define ATTR_MASK_DEFAULT 0x700 |
208 | #define ATTR_SHIFT_DEAFULT 8 |
209 | |
210 | #define ATTR_LAZY 0x800 |
211 | |
212 | #define ATTR_COERCE 0x08 |
213 | #define ATTR_WEAK 0x10 |
214 | #define ATTR_TRIGGER 0x10 |
215 | |
216 | #define ATTR_ISWEAK(attr) ( attr->flags & ATTR_WEAK ) |
217 | #define ATTR_ISLAZY(attr) ( attr->flags & ATTR_LAZY ) |
218 | #define ATTR_ISCOERCE(attr) ( attr->flags & ATTR_COERCE ) |
1ea12c91 |
219 | |
de2f2e97 |
220 | #define ATTR_TYPE(f) ( attr->flags & 0x7 ) |
221 | #define ATTR_DEFAULT(f) ( ( attr->flags & ATTR_MASK_DEFAULT ) >> ATTR_SHIFT_DEFAULT ) |
1ea12c91 |
222 | |
de2f2e97 |
223 | #define ATTR_DUMB_READER(attr) !ATTR_IS_LAZY(attr) |
224 | #define ATTR_DUMB_WRITER(attr) ( ( attr->flags & ATTR_WRITING_MASK ) == 0 ) |
225 | #define ATTR_DUMB_INSTANCE(attr) ( ( attr->flags & ATTR_INSTANCE_MASK ) == 0 ) |
1ea12c91 |
226 | |
f253044f |
227 | #define dATTR ATTR *attr = (XSANY.any_i32 ? INT2PTR(ATTR *, (XSANY.any_i32)) : define_attr(aTHX_ cv)) |
de2f2e97 |
228 | |
229 | |
230 | /* FIXME define a vtable that does call_sv */ |
231 | typedef struct { |
232 | SV * (*get)(pTHX_ SV *self, ATTR *attr); |
233 | void (*set)(pTHX_ SV *self, ATTR *attr, SV *value); |
234 | bool * (*has)(pTHX_ SV *self, ATTR *attr); |
235 | SV * (*delete)(pTHX_ SV *self, ATTR *attr); |
236 | } instance_vtbl; |
237 | |
238 | |
239 | typedef enum { |
240 | hash = 0, |
241 | |
242 | /* these are not yet implemented */ |
243 | array, |
244 | fptr, |
245 | cv, |
246 | judy, |
247 | } instance_types; |
248 | |
249 | typedef struct mi { |
de2f2e97 |
250 | HV *stash; |
251 | |
252 | /* slot access method */ |
253 | instance_types type; |
254 | instance_vtbl *vtbl; |
255 | |
256 | /* attr descriptors */ |
257 | I32 num_attrs; |
258 | ATTR *attrs; |
259 | } MI; |
260 | |
261 | |
262 | STATIC void init_attr (MI *mi, ATTR *attr, HV *desc) { |
1ea12c91 |
263 | U32 hash; |
264 | STRLEN len; |
de2f2e97 |
265 | SV **key = hv_fetchs(desc, "key", 0); |
266 | SV **meta_attr = hv_fetchs(desc, "meta", 0); |
267 | char *pv; |
268 | |
269 | if ( !meta_attr ) croak("'meta' is required"); |
270 | |
035fd0c4 |
271 | attr->meta_attr = newSVsv(*meta_attr); |
de2f2e97 |
272 | |
273 | attr->mi = mi; |
274 | |
275 | attr->flags = 0; |
276 | |
277 | |
278 | /* if type == hash */ |
279 | /* prehash the key */ |
280 | if ( !key ) croak("'key' is required"); |
281 | |
282 | pv = SvPV(*key, len); |
1ea12c91 |
283 | |
284 | PERL_HASH(hash, pv, len); |
1ea12c91 |
285 | |
de2f2e97 |
286 | attr->slot_sv = newSVpvn_share(pv, len, hash); |
287 | attr->slot_u32 = hash; |
288 | |
289 | attr->def.type = 0; |
290 | |
291 | attr->tc_check.type = 0; |
292 | attr->type_constraint = NULL; |
293 | |
294 | |
295 | attr->initializer = NULL; |
296 | attr->trigger = NULL; |
297 | |
298 | /* cross refs to CVs which use this struct */ |
299 | attr->cvs = newAV(); |
300 | } |
301 | |
f253044f |
302 | STATIC MI *new_mi (pTHX_ HV *stash, AV *attrs) { |
de2f2e97 |
303 | MI *mi; |
304 | I32 ix; |
305 | const I32 num = av_len(attrs) + 1; |
306 | |
307 | Newx(mi, 1, MI); |
308 | |
309 | SvREFCNT_inc_simple(stash); |
310 | mi->stash = stash; |
311 | |
de2f2e97 |
312 | mi->type = 0; /* nothing else implemented yet */ |
313 | |
314 | /* initialize attributes */ |
315 | mi->num_attrs = num; |
316 | Newx(mi->attrs, num, ATTR); |
f253044f |
317 | for ( ix = 0; ix < num; ix++ ) { |
de2f2e97 |
318 | SV **desc = av_fetch(attrs, ix, 0); |
319 | |
f253044f |
320 | if ( !desc || !*desc || !SvROK(*desc) || !(SvTYPE(SvRV(*desc)) == SVt_PVHV) ) { |
de2f2e97 |
321 | croak("Attribute descriptor has to be a hash reference"); |
f253044f |
322 | } |
de2f2e97 |
323 | |
324 | init_attr(mi, &mi->attrs[ix], (HV *)SvRV(*desc)); |
325 | } |
326 | |
327 | return mi; |
328 | } |
329 | |
f253044f |
330 | STATIC SV *new_mi_obj (pTHX_ MI *mi) { |
035fd0c4 |
331 | HV *stash = gv_stashpvs("Moose::XS::Meta::Instance",0); |
332 | SV *obj = newRV_noinc(newSViv(PTR2IV(mi))); |
333 | sv_bless( obj, stash ); |
334 | return obj; |
f253044f |
335 | } |
de2f2e97 |
336 | |
f253044f |
337 | STATIC SV *attr_to_meta_instance(pTHX_ SV *meta_attr) { |
338 | dSP; |
339 | I32 count; |
340 | SV *mi; |
341 | |
342 | if ( !meta_attr ) |
343 | croak("No attr found in magic!"); |
344 | |
345 | ENTER; |
346 | SAVETMPS; |
347 | PUSHMARK(SP); |
348 | XPUSHs(meta_attr); |
349 | PUTBACK; |
350 | count = call_pv("Moose::XS::attr_to_meta_instance", G_SCALAR); |
351 | |
352 | if ( count != 1 ) |
353 | croak("attr_to_meta_instance borked (%d args returned, expecting 1)", count); |
354 | |
355 | SPAGAIN; |
356 | mi = POPs; |
357 | |
358 | SvREFCNT_inc(mi); |
359 | |
360 | PUTBACK; |
361 | FREETMPS; |
362 | LEAVE; |
363 | |
364 | return mi; |
365 | } |
366 | |
367 | STATIC SV *perl_mi_to_c_mi(pTHX_ SV *perl_mi) { |
368 | dSP; |
369 | I32 count; |
370 | MI *mi = NULL; |
371 | SV *class; |
372 | SV *attrs; |
373 | HV *stash; |
374 | |
375 | ENTER; |
376 | SAVETMPS; |
377 | PUSHMARK(SP); |
378 | XPUSHs(perl_mi); |
379 | PUTBACK; |
380 | count = call_pv("Moose::XS::meta_instance_to_attr_descs", G_ARRAY); |
381 | |
382 | if ( count != 2 ) |
383 | croak("meta_instance_to_attr_descs borked (%d args returned, expecting 2)", count); |
384 | |
385 | SPAGAIN; |
386 | attrs = POPs; |
387 | class = POPs; |
388 | |
389 | PUTBACK; |
390 | |
391 | stash = gv_stashsv(class, 0); |
392 | |
393 | mi = new_mi(aTHX_ stash, (AV *)SvRV(attrs)); |
394 | |
395 | FREETMPS; |
396 | LEAVE; |
397 | |
398 | return new_mi_obj(aTHX_ mi); |
399 | } |
400 | |
401 | STATIC ATTR *mi_find_attr(MI *mi, SV *meta_attr) { |
402 | I32 ix; |
403 | |
035fd0c4 |
404 | for ( ix = 0; ix < mi->num_attrs; ix++ ) { |
f253044f |
405 | if ( SvRV(mi->attrs[ix].meta_attr) == SvRV(meta_attr) ) { |
406 | return &mi->attrs[ix]; |
de2f2e97 |
407 | } |
de2f2e97 |
408 | } |
409 | |
f253044f |
410 | sv_dump(meta_attr); |
411 | croak("Attr not found"); |
de2f2e97 |
412 | return NULL; |
413 | } |
414 | |
415 | STATIC ATTR *get_attr(pTHX_ CV *cv) { |
f253044f |
416 | SV *meta_attr = get_stashed_in_mg(aTHX_ (SV *)cv); |
417 | SV *perl_mi = attr_to_meta_instance(aTHX_ meta_attr); |
418 | SV *c_mi = get_stashed_in_mg(aTHX_ SvRV(perl_mi)); |
419 | MI *mi; |
de2f2e97 |
420 | |
f253044f |
421 | if (!c_mi) { |
422 | c_mi = perl_mi_to_c_mi(aTHX_ perl_mi); |
423 | stash_in_mg(aTHX_ perl_mi, c_mi); |
424 | } |
425 | |
426 | sv_2mortal(perl_mi); |
427 | |
428 | mi = INT2PTR(MI *, SvIV(SvRV(c_mi))); |
429 | |
430 | return mi_find_attr(mi, meta_attr); |
1ea12c91 |
431 | } |
432 | |
de2f2e97 |
433 | STATIC ATTR *define_attr (pTHX_ CV *cv) { |
434 | ATTR *attr = get_attr(aTHX_ cv); |
435 | assert(attr); |
436 | |
437 | XSANY.any_i32 = PTR2IV(attr); |
f253044f |
438 | |
439 | av_push( attr->cvs, (SV *)cv ); |
de2f2e97 |
440 | |
441 | return attr; |
442 | } |
443 | |
444 | STATIC void weaken(pTHX_ SV *sv) { |
1ea12c91 |
445 | #ifdef SvWEAKREF |
de2f2e97 |
446 | sv_rvweaken(sv); /* FIXME i think this might warn when weakening an already weak ref */ |
1ea12c91 |
447 | #else |
448 | croak("weak references are not implemented in this release of perl"); |
449 | #endif |
450 | } |
451 | |
452 | |
453 | /* meta instance protocol */ |
454 | |
de2f2e97 |
455 | STATIC SV *get_slot_value(pTHX_ SV *self, ATTR *attr) { |
1ea12c91 |
456 | HE *he; |
457 | |
458 | assert(self); |
459 | assert(SvROK(self)); |
460 | assert(SvTYPE(SvRV(self)) == SVt_PVHV); |
461 | |
de2f2e97 |
462 | assert( ATTR_DUMB_INSTANCE(attr) ); |
463 | |
464 | if ((he = hv_fetch_ent((HV *)SvRV(self), attr->slot_sv, 0, attr->slot_u32))) |
1ea12c91 |
465 | return HeVAL(he); |
466 | else |
467 | return NULL; |
468 | } |
469 | |
de2f2e97 |
470 | STATIC void set_slot_value(pTHX_ SV *self, ATTR *attr, SV *value) { |
1ea12c91 |
471 | HE *he; |
472 | |
473 | assert(self); |
474 | assert(SvROK(self)); |
475 | assert(SvTYPE(SvRV(self)) == SVt_PVHV); |
476 | |
de2f2e97 |
477 | assert( ATTR_DUMB_INSTANCE(attr) ); |
478 | |
1ea12c91 |
479 | SvREFCNT_inc(value); |
480 | |
de2f2e97 |
481 | he = hv_store_ent((HV*)SvRV(self), attr->slot_sv, value, attr->slot_u32); |
1ea12c91 |
482 | if (he != NULL) { |
de2f2e97 |
483 | if ( ATTR_ISWEAK(attr) ) |
484 | weaken(aTHX_ HeVAL(he)); /* actually only needed once at HE creation time */ |
1ea12c91 |
485 | } else { |
486 | croak("Hash store failed."); |
487 | } |
488 | } |
489 | |
de2f2e97 |
490 | STATIC bool has_slot_value(pTHX_ SV *self, ATTR *attr) { |
1ea12c91 |
491 | assert(self); |
492 | assert(SvROK(self)); |
493 | assert(SvTYPE(SvRV(self)) == SVt_PVHV); |
494 | |
de2f2e97 |
495 | assert( ATTR_DUMB_INSTANCE(attr) ); |
496 | |
497 | return hv_exists_ent((HV *)SvRV(self), attr->slot_sv, attr->slot_u32); |
498 | } |
499 | |
500 | STATIC SV *deinitialize_slot(pTHX_ SV *self, ATTR *attr) { |
501 | assert(self); |
502 | assert(SvROK(self)); |
503 | assert(SvTYPE(SvRV(self)) == SVt_PVHV); |
504 | |
505 | assert( ATTR_DUMB_INSTANCE(attr) ); |
506 | |
507 | return hv_delete_ent((HV *)SvRV(self), attr->slot_sv, 0, attr->slot_u32); |
1ea12c91 |
508 | } |
509 | |
510 | |
511 | /* simple high level api */ |
512 | |
de2f2e97 |
513 | STATIC XS(getter); |
514 | STATIC XS(getter) |
1ea12c91 |
515 | { |
516 | #ifdef dVAR |
517 | dVAR; |
518 | #endif |
519 | dXSARGS; |
de2f2e97 |
520 | dATTR; |
1ea12c91 |
521 | SV *value; |
522 | |
523 | if (items != 1) |
524 | Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "self"); |
525 | |
526 | SP -= items; |
527 | |
de2f2e97 |
528 | assert( ATTR_DUMB_READER(attr) ); |
529 | |
530 | value = get_slot_value(aTHX_ ST(0), attr); |
1ea12c91 |
531 | |
532 | if (value) { |
533 | ST(0) = sv_mortalcopy(value); /* mortalcopy because $_ .= "blah" for $foo->bar */ |
534 | XSRETURN(1); |
535 | } else { |
536 | XSRETURN_UNDEF; |
537 | } |
538 | } |
539 | |
de2f2e97 |
540 | STATIC XS(setter); |
541 | STATIC XS(setter) |
1ea12c91 |
542 | { |
543 | #ifdef dVAR |
544 | dVAR; |
545 | #endif |
546 | dXSARGS; |
de2f2e97 |
547 | dATTR; |
1ea12c91 |
548 | |
549 | if (items != 2) |
550 | Perl_croak(aTHX_ "Usage: %s(%s, %s)", GvNAME(CvGV(cv)), "self", "value"); |
551 | |
552 | SP -= items; |
553 | |
de2f2e97 |
554 | assert( ATTR_DUMB_WRITER(attr) ); |
555 | |
556 | set_slot_value(aTHX_ ST(0), attr, ST(1)); |
1ea12c91 |
557 | |
558 | ST(0) = ST(1); /* return value */ |
559 | XSRETURN(1); |
560 | } |
561 | |
de2f2e97 |
562 | STATIC XS(accessor); |
563 | STATIC XS(accessor) |
1ea12c91 |
564 | { |
565 | #ifdef dVAR |
566 | dVAR; |
567 | #endif |
568 | dXSARGS; |
de2f2e97 |
569 | dATTR; |
1ea12c91 |
570 | |
571 | if (items < 1) |
572 | Perl_croak(aTHX_ "Usage: %s(%s, [ %s ])", GvNAME(CvGV(cv)), "self", "value"); |
573 | |
574 | SP -= items; |
575 | |
576 | if (items > 1) { |
de2f2e97 |
577 | assert( ATTR_DUMB_READER(attr) ); |
578 | set_slot_value(aTHX_ ST(0), attr, ST(1)); |
1ea12c91 |
579 | ST(0) = ST(1); /* return value */ |
580 | } else { |
035fd0c4 |
581 | SV *value; |
de2f2e97 |
582 | assert( ATTR_DUMB_WRITER(attr) ); |
035fd0c4 |
583 | value = get_slot_value(aTHX_ ST(0), attr); |
1ea12c91 |
584 | if ( value ) { |
585 | ST(0) = value; |
586 | } else { |
587 | XSRETURN_UNDEF; |
588 | } |
589 | } |
590 | |
591 | XSRETURN(1); |
592 | } |
593 | |
594 | STATIC XS(predicate); |
595 | STATIC XS(predicate) |
596 | { |
597 | #ifdef dVAR |
598 | dVAR; |
599 | #endif |
600 | dXSARGS; |
de2f2e97 |
601 | dATTR; |
1ea12c91 |
602 | |
603 | if (items != 1) |
604 | Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "self"); |
605 | |
606 | SP -= items; |
607 | |
de2f2e97 |
608 | if ( has_slot_value(aTHX_ ST(0), attr) ) |
1ea12c91 |
609 | XSRETURN_YES; |
610 | else |
611 | XSRETURN_NO; |
612 | } |
613 | |
614 | enum xs_body { |
de2f2e97 |
615 | xs_body_getter = 0, |
616 | xs_body_setter, |
617 | xs_body_accessor, |
1ea12c91 |
618 | xs_body_predicate, |
619 | max_xs_body |
620 | }; |
621 | |
622 | STATIC XSPROTO ((*xs_bodies[])) = { |
de2f2e97 |
623 | getter, |
624 | setter, |
625 | accessor, |
1ea12c91 |
626 | predicate, |
627 | }; |
628 | |
629 | MODULE = Moose PACKAGE = Moose::XS |
630 | |
631 | CV * |
de2f2e97 |
632 | new_sub(attr, name) |
1ea12c91 |
633 | INPUT: |
de2f2e97 |
634 | SV *attr; |
635 | SV *name; |
1ea12c91 |
636 | ALIAS: |
de2f2e97 |
637 | new_getter = xs_body_getter |
638 | new_setter = xs_body_setter |
639 | new_accessor = xs_body_accessor |
640 | new_predicate = xs_body_predicate |
1ea12c91 |
641 | PREINIT: |
642 | CV * cv; |
643 | CODE: |
644 | if ( ix >= max_xs_body ) |
645 | croak("Unknown Moose::XS body type"); |
646 | |
de2f2e97 |
647 | if ( !sv_isobject(attr) ) |
648 | croak("'attr' must be a Moose::Meta::Attribute"); |
649 | |
650 | cv = newXS(SvOK(name) ? SvPV_nolen(name) : NULL, xs_bodies[ix], __FILE__); |
1ea12c91 |
651 | |
652 | if (cv == NULL) |
653 | croak("Oi vey!"); |
654 | |
de2f2e97 |
655 | /* associate CV with meta attr */ |
f253044f |
656 | stash_in_mg(aTHX_ (SV *)cv, attr); |
de2f2e97 |
657 | |
658 | /* this will be set on first call */ |
659 | XSANY.any_i32 = 0; |
1ea12c91 |
660 | |
661 | RETVAL = cv; |
662 | OUTPUT: |
663 | RETVAL |
664 | |
665 | |
f253044f |
666 | MODULE = Moose PACKAGE = Moose::XS::Meta::Instance |
667 | |
668 | void |
669 | DESTROY(self) |
670 | INPUT: |
671 | SV *self; |
672 | PREINIT: |
673 | MI *mi = INT2PTR(MI *, SvIV(SvRV(self))); |
674 | CODE: |
675 | /* foreach attr ( delete cvs XSANY ), free attrs free mi */ |