5 #define NEED_newRV_noinc
6 #define NEED_newSVpvn_share
7 #define NEED_sv_2pv_flags
11 #define XSPROTO(name) void name(pTHX_ CV* cv)
15 #define gv_stashpvs(x, y) gv_stashpvn(STR_WITH_LEN(x), y)
19 * delegations and attribute helpers:
28 * I32 *type; // hash, array, whatever + vtable for operation
38 /* These two functions attach magic with no behavior to an SV.
40 * The stashed value is reference counted, and is destroyed when it's parent
41 * object is destroyed.
43 * This is used to keep a reference the the meta attribute from a generated
44 * method, and to cache the C struct based wrapper attached to the meta
48 STATIC MGVTBL null_mg_vtbl = {
62 #endif /* MGf_LOCAL */
65 STATIC MAGIC *stash_in_mg (pTHX_ SV *sv, SV *obj) {
66 MAGIC *mg = sv_magicext(sv, obj, PERL_MAGIC_ext, &null_mg_vtbl, NULL, 0 );
67 mg->mg_flags |= MGf_REFCOUNTED;
72 STATIC SV *get_stashed_in_mg(pTHX_ SV *sv) {
73 MAGIC *mg, *moremagic;
75 if (SvTYPE(sv) >= SVt_PVMG) {
76 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
77 if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_virtual == &null_mg_vtbl))
95 /* The folloing data structures deal with type constraints */
97 /* this is an enum of the various kinds of constraint checking an attribute can
100 * tc_cv is the fallback behavior (simply applying the
101 * ->_compiled_type_constraint to the value, but other more optimal checks are
102 * implemented too. */
105 tc_none = 0, /* no type checking */
106 tc_type, /* a builtin type to be checked by check_sv_type */
107 tc_stash, /* a stash for a class, implements TypeConstraint::Class by comparing SvSTASH and then invoking C<isa> if necessary */
108 tc_cv, /* applies a code reference to the value and checks for truth */
109 tc_fptr, /* apply a C function pointer */
110 tc_enum, /* TODO check that the value is in an allowed set of values (strings) */
113 /* this is a enum of builtin type check. They are handled in a switch statement
114 * in check_sv_type */
116 Any, /* or item, or bool */
122 GlobRef, /* SVt_PVGV */
123 ArrayRef, /* SVt_PVAV */
124 HashRef, /* SVt_PVHV */
125 CodeRef, /* SVt_PVCV */
128 FileHandle, /* TODO */
135 /* auxillary pointer/int union used for constraint checking */
137 TC type; /* the builtin type number for tc_type */
138 SV *sv; /* the cv for tc_cv, or the stash for tc_stash */
139 OP *op; /* TODO not used */
140 bool (*fptr)(pTHX_ SV *type_constraint, SV *sv); /* the function pointer for tc_fptr FIXME aux data? */
148 /* The folloing data structures deal with type default value generation */
150 /* This is an enum for the various types of default value behaviors an
151 * attribute can have */
154 default_none = 0, /* no default value */
155 default_normal, /* code reference or scalar */
156 default_builder, /* builder method */
157 default_type, /* TODO enumerated type optimization (will call newHV, newAV etc to avoid calling a code ref for these simple cases) */
161 SV *sv; /* The default value, or a code ref to generate one. If builder then this sv is applied as a method (stringified) */
162 U32 type; /* TODO for default_type, should probably be one of SVt_PVAV/SVt_PVHV */
170 /* the ATTR struct contains all the meta data for a Moose::Meta::Attribute for
171 * a given meta instance
173 * flags determines the various behaviors
175 * This supports only one slot per attribute in the current implementation, but
176 * slot_sv could contain an array
178 * A list of XSUBs that rely on this attr struct are cross indexed in the cvs
179 * array, so that when the meta instance is destroyed the XSANY field will be
180 * cleared. This is done in delete_mi
184 /* pointer to the MI this attribute is a part of the meta instance struct */
187 U32 flags; /* slot type, TC behavior, coerce, weaken, (no default | default, builder + lazy), auto_deref */
189 /* slot access fields */
190 SV *slot_sv; /* value of the slot (currently always slot name) */
191 U32 slot_u32; /* for optimized access (precomputed hash, possibly something else) */
193 DEFAULT def; /* cv, value or other, depending on flags */
195 TC_CHECK tc_check; /* see TC_CHECK*/
196 SV *type_constraint; /* Moose::Meta::TypeConstraint object */
198 CV *initializer; /* TODO */
199 CV *trigger; /* TODO */
201 SV *meta_attr; /* the Moose::Meta::Attribute */
202 AV *cvs; /* an array of CVs which use this attr, see delete_mi */
205 /* the flags integer is mapped as follows
206 * instance misc reading writing
207 * 00000000 00000000 00000000 00000000
211 * ^ tc.sv is refcounted
218 * ^ def.sv is refcounted
221 * ^ attr is required TODO
223 * flags having to do with the instance layout (TODO, only hash supported for now)
224 * ^^^^^^^ if 0 then nothing special (just hash)? FIXME TBD
227 #define ATTR_INSTANCE_MASK 0xff000000
228 #define ATTR_READING_MASK 0x0000ff00
229 #define ATTR_WRITING_MASK 0x000000ff
231 #define ATTR_MASK_TYPE 0x7
233 #define ATTR_MASK_DEFAULT 0x700
234 #define ATTR_SHIFT_DEFAULT 8
236 #define ATTR_LAZY 0x800
237 #define ATTR_DEFREFCNT 0x1000
239 #define ATTR_COERCE 0x8
240 #define ATTR_TCREFCNT 0x10
241 #define ATTR_WEAK 0x20
242 #define ATTR_TRIGGER 0x40
244 #define ATTR_ISWEAK(attr) ( attr->flags & ATTR_WEAK )
245 #define ATTR_ISLAZY(attr) ( attr->flags & ATTR_LAZY )
246 #define ATTR_ISCOERCE(attr) ( attr->flags & ATTR_COERCE )
248 #define ATTR_TYPE(f) ( attr->flags & 0x7 )
249 #define ATTR_DEFAULT(f) ( ( attr->flags & ATTR_MASK_DEFAULT ) >> ATTR_SHIFT_DEFAULT )
251 #define ATTR_DUMB_READER(attr) !ATTR_IS_LAZY(attr)
252 #define ATTR_DUMB_WRITER(attr) ( ( attr->flags & ATTR_WRITING_MASK ) == 0 )
253 #define ATTR_DUMB_INSTANCE(attr) ( ( attr->flags & ATTR_INSTANCE_MASK ) == 0 )
257 /* This unused (TODO) vtable will implement the meta instance protocol in terms
258 * of function pointers to allow the XS accessors to be used with custom meta
259 * instances in the future.
261 * We'll need to define a default instance of this vtable that uses call_sv,
264 /* FIXME define a vtable that does call_sv for fallback meta instance protocol */
266 SV * (*get)(pTHX_ SV *self, ATTR *attr);
267 void (*set)(pTHX_ SV *self, ATTR *attr, SV *value);
268 bool * (*has)(pTHX_ SV *self, ATTR *attr);
269 SV * (*delete)(pTHX_ SV *self, ATTR *attr);
272 /* TODO this table describes the instance layout of the object. Not yet
277 /* these are not yet implemented */
285 /* this struct models the meta instance *and* meta attributes simultaneously.
286 * It is a cache of the meta attribute behaviors for a given class or subclass
287 * and can be parametrized on that level
290 * An object pointing to this structure is kept in a refcounted magic inside
291 * the meta instance it corresponds to. On C<invalidate_meta_instance> the meta
292 * instance is destroyed, causing the proxy object to be destroyed, deleting
293 * this structure, clearing the XSANY of all dependent attribute methods.
295 * The next invocation of an attribute method will eventually call get_attr,
296 * which will call C<get_meta_instance> on the metaclass (recreating it in the
297 * Class::MOP level), and cache a new MI struct inside it. Subsequent
298 * invocations of get_attr will then search the MI for an ATTR matching the
299 * meta_attribute of the attribute method */
303 /* slot access method */
304 instance_types type; /* TODO only hashes supported currently */
305 instance_vtbl *vtbl; /* TODO */
307 /* attr descriptors */
319 /* these functions implement type constraint checking */
321 /* checks that the SV is a scalar ref */
322 STATIC bool check_is_scalar_ref(SV *sv) {
324 switch (SvTYPE(SvRV(sv))) {
338 /* checks that the SV is a ref to a certain SvTYPE, where type is in the table
340 STATIC bool check_reftype(TC type, SV *sv) {
361 return SvTYPE(SvRV(sv)) == svt;
364 /* checks whether an SV is of a certain class
365 * SvSTASH is first compared by pointer for efficiency */
366 STATIC bool check_sv_class(pTHX_ HV *stash, SV *sv) {
379 if (SvSTASH(rv) == stash)
386 XPUSHs(sv_2mortal(newSVpv(HvNAME_get(stash), 0)));
389 call_method("isa", G_SCALAR);
400 /* checks whether SV of of a known simple type. Most of the non parametrized
401 * Moose core types are implemented here */
402 STATIC bool check_sv_type (TC type, SV *sv) {
417 return (SvOK(sv) && !SvROK(sv));
419 #if (PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION <5)
420 if (!SvPOK(sv) && !SvPOKp(sv))
421 return SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK);
424 return looks_like_number(sv);
429 } else if ( SvPOK(sv) ) {
430 /* FIXME i really don't like this */
433 char *pv = SvPV(sv, len);
434 char *end = pv + len;
438 i = strtol(pv, &tail, 0);
440 if ( errno ) return 0;
442 while ( tail != end ) {
443 if ( !isspace(*tail++) ) return 0;
454 return check_is_scalar_ref(sv);
460 return check_reftype(type, sv);
463 return ( sv_isobject(sv) && ( strEQ("Regexp", HvNAME_get(SvSTASH(SvRV(sv)))) ) );
466 return ( sv_isobject(sv) && ( strNE("Regexp", HvNAME_get(SvSTASH(SvRV(sv)))) ) );
469 if ( SvOK(sv) && !SvROK(sv) ) {
473 return ( gv_stashpvn(pv, len, 0) != NULL );
487 /* invoke a CV on an SV and return SvTRUE of the result */
488 STATIC bool check_sv_cv (pTHX_ SV *cv, SV *sv) {
498 call_sv(cv, G_SCALAR);
510 /* checks the type constraint for an SV based on the type constraint kind */
511 STATIC bool check_type_constraint(pTHX_ tc_kind kind, TC_CHECK tc_check, SV *type_constraint, SV *sv) {
517 return check_sv_type(tc_check.type, sv);
520 return check_sv_class(aTHX_ (HV *)tc_check.sv, sv);
523 return tc_check.fptr(aTHX_ type_constraint, sv);
526 return check_sv_cv(aTHX_ tc_check.sv, sv);
535 /* end of type constraint checking functions */
545 /* Initialize the ATTR structure using positional arguments from Perl space. */
547 STATIC void init_attr (MI *mi, ATTR *attr, AV *desc) {
552 I32 ix = av_len(desc);
553 SV **params = AvARRAY(desc);
561 croak("wrong number of args (%d != 13)", ix + 1);
563 for ( ; ix >= 0; ix-- ) {
564 if ( !params[ix] || params[ix] == &PL_sv_undef )
570 /* handle attribute slot array */
572 if ( !SvROK(params[1]) || SvTYPE(SvRV(params[1])) != SVt_PVAV )
573 croak("slots is not an array");
575 if ( av_len((AV *)SvRV(params[1])) != 0 )
576 croak("Only unary slots are supported at the moment");
578 /* calculate a hash from the slot */
579 /* FIXME arrays etc should also be supported */
580 key = *av_fetch((AV *)SvRV(params[1]), 0, 0);
582 PERL_HASH(hash, pv, len);
587 /* FIXME better organize these, positionals suck */
588 if ( SvTRUE(params[2]) )
591 if ( SvTRUE(params[3]) )
592 flags |= ATTR_COERCE;
594 if ( SvTRUE(params[4]) )
599 /* type constraint data */
604 int tc_kind = SvIV(params[6]);
605 SV *data = params[7];
609 attr->tc_check.type = SvIV(data);
612 flags |= ATTR_TCREFCNT;
613 attr->tc_check.sv = (SV *)gv_stashsv(data, 0);
616 flags |= ATTR_TCREFCNT;
617 attr->tc_check.sv = SvRV(data);
618 if ( SvTYPE(attr->tc_check.sv) != SVt_PVCV )
619 croak("compiled type constraint is not a coderef");
630 /* default/builder data */
632 if ( SvTRUE(params[10]) ) { /* has default */
636 attr->def.sv = SvRV(sv);
637 if ( SvTYPE(attr->def.sv) != SVt_PVCV )
638 croak("compiled type constraint is not a coderef");
640 attr->def.sv = newSVsv(sv);
641 sv_2mortal(attr->def.sv); /* in case of error soon, we refcnt inc it later after we're done checking params */
644 flags |= ( ATTR_DEFREFCNT | ( default_normal << ATTR_SHIFT_DEFAULT ) );
645 } else if ( SvOK(params[12]) ) { /* builder */
646 attr->def.sv = newSVsv(params[12]);
647 flags |= ( ATTR_DEFREFCNT | ( default_builder << ATTR_SHIFT_DEFAULT ) );
652 attr->trigger = SvROK(params[6]) ? (CV *)SvRV(params[6]) : NULL;
653 if ( attr->trigger && SvTYPE(attr->trigger) != SVt_PVCV )
654 croak("trigger is not a coderef");
656 attr->initializer = SvROK(params[7]) ? (CV *)SvRV(params[7]) : NULL;
657 if ( attr->initializer && SvTYPE(attr->initializer) != SVt_PVCV )
658 croak("initializer is not a coderef");
662 /* now that we're done preparing/checking args and shit, so we finalize the
663 * attr, increasing refcounts for any referenced data, and creating the CV
668 /* copy the outer ref SV */
669 attr->meta_attr = newSVsv(params[0]);
670 attr->type_constraint = newSVsv(tc);
672 /* increase the refcount for auxillary structures */
673 SvREFCNT_inc(attr->trigger);
674 SvREFCNT_inc(attr->initializer);
675 if ( flags & ATTR_TCREFCNT ) SvREFCNT_inc(attr->tc_check.sv);
676 if ( flags & ATTR_DEFREFCNT ) SvREFCNT_inc(attr->def.sv);
678 /* create a new SV for the hash key */
679 attr->slot_sv = newSVpvn_share(pv, len, hash);
680 attr->slot_u32 = hash;
682 /* cross refs to CVs which use this struct */
686 STATIC SV *new_mi (pTHX_ HV *stash, AV *attrs) {
687 HV *mi_stash = gv_stashpvs("Moose::XS::Meta::Instance",0);
688 SV *sv_ptr = newSViv(0);
689 SV *obj = sv_2mortal(sv_bless(newRV_noinc(sv_ptr), mi_stash));
691 const I32 num_attrs = av_len(attrs) + 1;
695 /* set the pointer now, if we have any initialization errors it'll get
696 * cleaned up because obj is mortal */
697 sv_setiv(sv_ptr, PTR2IV(mi));
699 Newxz(mi->attrs, num_attrs, ATTR);
701 SvREFCNT_inc_simple(stash);
704 mi->type = 0; /* nothing else implemented yet */
706 /* initialize attributes */
707 for ( ; mi->num_attrs < num_attrs; mi->num_attrs++ ) {
708 SV **desc = av_fetch(attrs, mi->num_attrs, 0);
710 if ( !desc || !*desc || !SvROK(*desc) || !(SvTYPE(SvRV(*desc)) == SVt_PVAV) ) {
711 croak("Attribute descriptor has to be a hash reference");
714 init_attr(mi, &mi->attrs[mi->num_attrs], (AV *)SvRV(*desc));
720 STATIC void delete_attr (pTHX_ ATTR *attr) {
722 SV **cvs = AvARRAY(attr->cvs);
724 /* remove the pointers to this ATTR struct from all the the dependent CVs */
725 for ( i = av_len(attr->cvs); i >= 0; i-- ) {
726 CV *cv = (CV *)cvs[i];
730 SvREFCNT_dec(attr->cvs);
731 SvREFCNT_dec(attr->slot_sv);
732 SvREFCNT_dec(attr->type_constraint);
733 if ( attr->flags & ATTR_TCREFCNT ) SvREFCNT_dec(attr->tc_check.sv);
734 if ( attr->flags & ATTR_DEFREFCNT ) SvREFCNT_dec(attr->def.sv);
735 SvREFCNT_dec(attr->initializer);
736 SvREFCNT_dec(attr->trigger);
737 SvREFCNT_dec(attr->meta_attr);
740 STATIC void delete_mi (pTHX_ MI *mi) {
741 SvREFCNT_dec(mi->stash);
743 while ( mi->num_attrs--) {
744 ATTR *attr = &mi->attrs[mi->num_attrs];
745 delete_attr(aTHX_ attr);
748 if ( mi->attrs ) Safefree(mi->attrs);
755 /* these functions call Perl-space for MOP methods, helpers etc */
758 /* wow, so much code for the equivalent of
759 * $attr->associated_class->get_meta_instance */
760 STATIC SV *attr_to_meta_instance(pTHX_ SV *meta_attr) {
766 croak("No attr found in magic!");
775 count = call_pv("Moose::XS::attr_to_meta_instance", G_SCALAR);
778 croak("attr_to_meta_instance borked (%d args returned, expecting 1)", count);
789 return sv_2mortal(mi);
792 /* gets a class and an array of attr parameters */
793 STATIC SV *perl_mi_to_c_mi(pTHX_ SV *perl_mi) {
808 count = call_pv("Moose::XS::meta_instance_to_attr_descs", G_ARRAY);
811 croak("meta_instance_to_attr_descs borked (%d args returned, expecting 2)", count);
819 stash = gv_stashsv(class, 0);
821 mi = new_mi(aTHX_ stash, (AV *)SvRV(attrs));
827 return sv_2mortal(mi);
832 /* locate an ATTR for a MOP level attribute inside an MI */
833 STATIC ATTR *mi_find_attr(SV *mi_obj, SV *meta_attr) {
835 MI *mi = INT2PTR(MI *, SvIV(SvRV(mi_obj)));
837 for ( ix = 0; ix < mi->num_attrs; ix++ ) {
838 if ( SvRV(mi->attrs[ix].meta_attr) == SvRV(meta_attr) ) {
839 return &mi->attrs[ix];
843 croak("Attr %x not found in meta instance of %s", SvRV(meta_attr) /* SvPV_force_nomg(sv_2mortal(newSVsv(meta_attr))) */, HvNAME_get(mi->stash) );
847 /* returns the ATTR for a CV:
849 * 1. get the Moose::Meta::Attribute using get_stashed_in_mg from the CV itself
850 * 2. get the meta instance by calling $attr->associated_class->get_meta_instance
851 * 3. get the MI by using get_stashed_in_mg from the meta instance, creating it if necessary
852 * 4. search for the appropriate ATTR in the MI using mi_find_attr
854 STATIC ATTR *get_attr(pTHX_ CV *cv) {
855 SV *meta_attr = get_stashed_in_mg(aTHX_ (SV *)cv);
856 SV *perl_mi = attr_to_meta_instance(aTHX_ meta_attr);
857 SV *mi_obj = get_stashed_in_mg(aTHX_ SvRV(perl_mi));
860 mi_obj = perl_mi_to_c_mi(aTHX_ perl_mi);
861 stash_in_mg(aTHX_ SvRV(perl_mi), mi_obj);
864 return mi_find_attr(mi_obj, meta_attr);
867 /* Cache a pointer to the appropriate ATTR in the XSANY of the CV, using
869 STATIC ATTR *define_attr (pTHX_ CV *cv) {
870 ATTR *attr = get_attr(aTHX_ cv);
873 XSANY.any_i32 = PTR2IV(attr);
876 av_push( attr->cvs, (SV *)cv );
887 STATIC void weaken(pTHX_ SV *sv) {
889 sv_rvweaken(sv); /* FIXME i think this might warn when weakening an already weak ref */
891 croak("weak references are not implemented in this release of perl");
900 /* meta instance protocol */
902 STATIC SV *get_slot_value(pTHX_ SV *self, ATTR *attr) {
907 assert(SvTYPE(SvRV(self)) == SVt_PVHV);
909 assert( ATTR_DUMB_INSTANCE(attr) );
911 if ((he = hv_fetch_ent((HV *)SvRV(self), attr->slot_sv, 0, attr->slot_u32)))
917 STATIC void set_slot_value(pTHX_ SV *self, ATTR *attr, SV *value) {
923 assert(SvTYPE(SvRV(self)) == SVt_PVHV);
925 assert( ATTR_DUMB_INSTANCE(attr) );
927 copy = newSVsv(value);
929 he = hv_store_ent((HV*)SvRV(self), attr->slot_sv, copy, attr->slot_u32);
932 if ( ATTR_ISWEAK(attr) )
933 weaken(aTHX_ HeVAL(he));
936 croak("Hash store failed.");
940 STATIC bool has_slot_value(pTHX_ SV *self, ATTR *attr) {
943 assert(SvTYPE(SvRV(self)) == SVt_PVHV);
945 assert( ATTR_DUMB_INSTANCE(attr) );
947 return hv_exists_ent((HV *)SvRV(self), attr->slot_sv, attr->slot_u32);
950 STATIC SV *deinitialize_slot(pTHX_ SV *self, ATTR *attr) {
953 assert(SvTYPE(SvRV(self)) == SVt_PVHV);
955 assert( ATTR_DUMB_INSTANCE(attr) );
957 return hv_delete_ent((HV *)SvRV(self), attr->slot_sv, 0, attr->slot_u32);
965 /* Shared functionality for readers/writers/accessors, this roughly corresponds
966 * to the methods of Moose::Meta::Attribute on the instance
967 * (get_value/set_value, default value handling, etc) */
969 STATIC void attr_set_value(pTHX_ SV *self, ATTR *attr, SV *value);
971 STATIC SV *call_builder (pTHX_ SV *self, ATTR *attr) {
981 /* we invoke the builder as a stringified method. This will not work for
982 * $obj->$coderef etc, for that we need to use 'default' */
984 call_method(SvPV_nolen(attr->def.sv), G_SCALAR);
987 /* the value is a mortal with a refcount of 1, so we need to keep it around */
995 return sv_2mortal(sv);
999 /* Returns an SV for the default value. Should be copied by the caller because
1000 * it's either an alias for a simple value, or a mortal from cv/builder */
1001 STATIC SV *get_default(pTHX_ SV *self, ATTR *attr) {
1002 switch ( ATTR_DEFAULT(attr) ) {
1006 case default_builder:
1007 return call_builder(aTHX_ self, attr);
1009 case default_normal:
1010 if ( SvROK(attr->def.sv) ) {
1011 printf("CV default\n");
1014 printf("simple value\n");
1015 return attr->def.sv; /* will be copied by set for lazy, and by reader for both cases */
1026 /* $attr->get_value($self), will vivify lazy values if needed
1027 * returns an alias to the sv that is copied in the reader/writer/accessor code
1029 STATIC SV *attr_get_value(pTHX_ SV *self, ATTR *attr) {
1030 SV *value = get_slot_value(aTHX_ self, attr);
1034 } else if ( ATTR_ISLAZY(attr) ) {
1035 value = get_default(aTHX_ self, attr);
1036 attr_set_value(aTHX_ self, attr, value);
1043 /* $attr->set_value($self) */
1044 STATIC void attr_set_value(pTHX_ SV *self, ATTR *attr, SV *value) {
1045 if ( ATTR_TYPE(attr) ) {
1046 if ( !check_type_constraint(aTHX_ ATTR_TYPE(attr), attr->tc_check, attr->type_constraint, value) )
1050 set_slot_value(aTHX_ self, attr, value);
1059 /* Perl-space level functionality
1061 * These subs are installed by new_sub's various aliases as the bodies of the
1067 /* This macro is used in the XS subs to set up the 'attr' variable.
1069 * if XSANY is NULL then define_attr is called on the CV, to set the pointer
1070 * to the ATTR struct.
1072 #define dATTR ATTR *attr = (XSANY.any_i32 ? INT2PTR(ATTR *, (XSANY.any_i32)) : define_attr(aTHX_ cv))
1086 Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "self");
1090 value = attr_get_value(aTHX_ ST(0), attr);
1093 ST(0) = sv_mortalcopy(value); /* mortalcopy because $_ .= "blah" for $foo->bar */
1110 Perl_croak(aTHX_ "Usage: %s(%s, %s)", GvNAME(CvGV(cv)), "self", "value");
1114 attr_set_value(aTHX_ ST(0), attr, ST(1));
1116 ST(0) = ST(1); /* return value */
1120 STATIC XS(accessor);
1130 Perl_croak(aTHX_ "Usage: %s(%s, [ %s ])", GvNAME(CvGV(cv)), "self", "value");
1135 attr_set_value(aTHX_ ST(0), attr, ST(1));
1136 ST(0) = ST(1); /* return value */
1138 SV *value = attr_get_value(aTHX_ ST(0), attr);
1149 STATIC XS(predicate);
1150 STATIC XS(predicate)
1159 Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "self");
1163 if ( has_slot_value(aTHX_ ST(0), attr) )
1177 STATIC XSPROTO ((*xs_bodies[])) = {
1184 MODULE = Moose PACKAGE = Moose::XS
1194 new_reader = xs_body_reader
1195 new_writer = xs_body_writer
1196 new_accessor = xs_body_accessor
1197 new_predicate = xs_body_predicate
1201 if ( ix >= max_xs_body )
1202 croak("Unknown Moose::XS body type");
1204 if ( !sv_isobject(attr) )
1205 croak("'attr' must be a Moose::Meta::Attribute");
1207 cv = newXS(SvOK(name) ? SvPV_nolen(name) : NULL, xs_bodies[ix], __FILE__);
1212 /* associate CV with meta attr */
1213 stash_in_mg(aTHX_ (SV *)cv, attr);
1215 /* this will be set on first call */
1223 MODULE = Moose PACKAGE = Moose::XS::Meta::Instance
1231 MI *mi = INT2PTR(MI *, SvIV(SvRV(self)));
1234 delete_mi(aTHX_ mi);
1237 MODULE = Moose PACKAGE = Moose::XS::TypeConstraints
1259 ScalarRef = ScalarRef
1260 FileHandle = FileHandle
1261 RegexpRef = RegexpRef
1264 ClassName = ClassName
1266 RETVAL = check_sv_type(ix, sv);
1271 ObjectOfType(sv, class)
1276 HV *stash = gv_stashsv(class, 0);
1278 RETVAL = check_sv_class(aTHX_ stash, sv);