From: gfx Date: Mon, 20 Jul 2009 23:48:12 +0000 (+0900) Subject: The first step to frame XS attributes X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a69b95017efe6e1a4880c6f24b6523bc7ca302da;p=gitmo%2FClass-MOP.git The first step to frame XS attributes --- diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm index ecc84ad..f43770a 100644 --- a/lib/Class/MOP/Method/Accessor.pm +++ b/lib/Class/MOP/Method/Accessor.pm @@ -55,6 +55,18 @@ sub _new { sub associated_attribute { (shift)->{'attribute'} } sub accessor_type { (shift)->{'accessor_type'} } + +sub can_xs { + my($self, $method_name) = @_; + # don't use $method_name here, but there may be cases it is required. + + # FIXME: I didn't know how to detect it properly (gfx) + return ref($self) eq __PACKAGE__ + && $self->associated_attribute->associated_class->instance_metaclass eq 'Class::MOP::Instance'; +} + +sub attribute_name{ (shift)->associated_attribute->name } + ## factory sub initialize_body { @@ -69,10 +81,16 @@ sub _initialize_body { my $method_name = join "_" => ( '_generate', $self->accessor_type, - 'method', - ($self->is_inline ? 'inline' : ()) + 'method' ); + if($self->can_xs($method_name)){ + $method_name .= '_xs'; + } + elsif($self->is_inline){ + $method_name .= '_inline'; + } + $self->{'body'} = $self->$method_name(); } diff --git a/mop.c b/mop.c index 963b8b5..6ab9c57 100644 --- a/mop.c +++ b/mop.c @@ -204,19 +204,18 @@ mop_get_all_package_symbols (HV *stash, type_filter_t filter) static MGVTBL mop_accessor_vtbl; /* the MAGIC identity */ -void -mop_install_simple_reader(const char* const fq_name, const char* const key, const int accessor_type){ - CV* const xsub = newXS((char*)fq_name, mop_xs_simple_reader, __FILE__); - SV* const keysv = newSVpvn_share(key, strlen(key), 0U); +CV* +mop_install_simple_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSPROTO(accessor_impl)){ + CV* const xsub = newXS((char*)fq_name, accessor_impl, __FILE__); + SV* const keysv = newSVpvn_share(key, keylen, 0U); sv_magicext((SV*)xsub, keysv, PERL_MAGIC_ext, &mop_accessor_vtbl, NULL, 0); SvREFCNT_dec(keysv); /* sv_magicext() increases refcnt in mg_obj */ - - CvXSUBANY(xsub).any_i32 = accessor_type; + return xsub; } static MAGIC* -mop_mg_find_by_vtbl(SV* const sv, const MGVTBL* const vtbl){ +mop_mg_find_by_vtbl(pTHX_ SV* const sv, const MGVTBL* const vtbl){ MAGIC* mg; assert(sv != NULL); @@ -228,46 +227,135 @@ mop_mg_find_by_vtbl(SV* const sv, const MGVTBL* const vtbl){ return mg; } +static SV* +mop_fetch_attr(pTHX_ SV* const self, SV* const key, I32 const create, CV* const cv){ + HE* he; + if (!SvROK(self)) { + croak("can't call %s as a class method", GvNAME(CvGV(cv))); + } + if (SvTYPE(SvRV(self)) != SVt_PVHV) { + croak("object is not a hashref"); + } + if((he = hv_fetch_ent((HV*)SvRV(self), key, create, 0U))){ + return HeVAL(he); + } + return NULL; +} +static SV* +mop_delete_attr(pTHX_ SV* const self, SV* const key, CV* const cv){ + SV* sv; + if (!SvROK(self)) { + croak("can't call %s as a class method", GvNAME(CvGV(cv))); + } + if (SvTYPE(SvRV(self)) != SVt_PVHV) { + croak("object is not a hashref"); + } + if((sv = hv_delete_ent((HV*)SvRV(self), key, 0, 0U))){ + return sv; + } + return NULL; +} + +XS(mop_xs_simple_accessor) +{ + dVAR; dXSARGS; + MAGIC* const mg = mop_mg_find_by_vtbl(aTHX_ (SV*)cv, &mop_accessor_vtbl); + SV* const key = mg->mg_obj; + SV* attr; + if(items == 1){ /* reader */ + attr = mop_fetch_attr(aTHX_ ST(0), key, FALSE, cv); + } + else if (items == 2){ /* writer */ + attr = mop_fetch_attr(aTHX_ ST(0), key, TRUE, cv); + sv_setsv(attr, ST(1)); + } + else{ + croak("expected exactly one or two argument"); + } + ST(0) = attr ? attr : &PL_sv_undef; + XSRETURN(1); +} + + XS(mop_xs_simple_reader) { dVAR; dXSARGS; - MAGIC* const mg = mop_mg_find_by_vtbl((SV*)cv, &mop_accessor_vtbl); + MAGIC* const mg = mop_mg_find_by_vtbl(aTHX_ (SV*)cv, &mop_accessor_vtbl); SV* const key = mg->mg_obj; - register HE *he; - SV *self; - SV *retval; + SV* attr; if (items != 1) { croak("expected exactly one argument"); } - self = ST(0); + attr = mop_fetch_attr(aTHX_ ST(0), key, FALSE, cv); + ST(0) = attr ? attr : &PL_sv_undef; + XSRETURN(1); +} - if (!SvROK(self)) { - croak("can't call %s as a class method", GvNAME(CvGV(cv))); +XS(mop_xs_simple_writer) +{ + dVAR; dXSARGS; + MAGIC* const mg = mop_mg_find_by_vtbl(aTHX_ (SV*)cv, &mop_accessor_vtbl); + SV* const key = mg->mg_obj; + SV* attr; + + if (items != 2) { + croak("expected exactly two argument"); } - if (SvTYPE(SvRV(self)) != SVt_PVHV) { - croak("object is not a hashref"); + attr = mop_fetch_attr(aTHX_ ST(0), key, TRUE, cv); + sv_setsv(attr, ST(1)); + ST(0) = attr; + XSRETURN(1); +} + +XS(mop_xs_simple_clearer) +{ + dVAR; dXSARGS; + MAGIC* const mg = mop_mg_find_by_vtbl(aTHX_ (SV*)cv, &mop_accessor_vtbl); + SV* const key = mg->mg_obj; + SV* attr; + + if (items != 1) { + croak("expected exactly one argument"); } - if ((he = hv_fetch_ent((HV *)SvRV(self), key, 0, 0U))) { - switch(XSANY.any_i32){ - case SIMPLE_READER: - retval = HeVAL(he); - break; - case SIMPLE_PREDICATE: - retval = boolSV(SvOK(HeVAL(he))); - break; - default: - croak("panic: not reached"); - retval = NULL; /* -W */ - } + attr = mop_delete_attr(aTHX_ ST(0), key, cv); + ST(0) = attr ? attr : &PL_sv_undef; + XSRETURN(1); +} + + +XS(mop_xs_simple_predicate) +{ + dVAR; dXSARGS; + MAGIC* const mg = mop_mg_find_by_vtbl(aTHX_ (SV*)cv, &mop_accessor_vtbl); + SV* const key = mg->mg_obj; + SV* attr; + + if (items != 1) { + croak("expected exactly one argument"); } - else { - retval = &PL_sv_undef; + + attr = mop_fetch_attr(aTHX_ ST(0), key, FALSE, cv); + ST(0) = boolSV(attr); /* exists */ + XSRETURN(1); +} + + +XS(mop_xs_simple_predicate_for_metaclass) +{ + dVAR; dXSARGS; + MAGIC* const mg = mop_mg_find_by_vtbl(aTHX_ (SV*)cv, &mop_accessor_vtbl); + SV* const key = mg->mg_obj; + SV* attr; + + if (items != 1) { + croak("expected exactly one argument"); } - ST(0) = retval; + attr = mop_fetch_attr(aTHX_ ST(0), key, FALSE, cv); + ST(0) = boolSV(attr && SvOK(attr)); /* defined */ XSRETURN(1); } diff --git a/mop.h b/mop.h index 849ad1d..c7259c3 100644 --- a/mop.h +++ b/mop.h @@ -21,19 +21,21 @@ void mop_call_xs (pTHX_ XSPROTO(subaddr), CV *cv, SV **mark); #define MAKE_KEYSV(name) newSVpvn_share(#name, sizeof(#name)-1, 0U) -void mop_install_simple_reader(const char* const fq_name, const char* const key, const int accessor_type); - -#define SIMPLE_READER 1 -#define SIMPLE_PREDICATE 2 +CV* mop_install_simple_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSPROTO(accessor_impl)); #define INSTALL_SIMPLE_READER(klass, name) INSTALL_SIMPLE_READER_WITH_KEY(klass, name, name) -#define INSTALL_SIMPLE_READER_WITH_KEY(klass, name, key) mop_install_simple_reader("Class::MOP::" #klass "::" #name, #key, SIMPLE_READER) +#define INSTALL_SIMPLE_READER_WITH_KEY(klass, name, key) (void)mop_install_simple_accessor(aTHX_ "Class::MOP::" #klass "::" #name, #key, sizeof(#key)-1, mop_xs_simple_reader) #define INSTALL_SIMPLE_PREDICATE(klass, name) INSTALL_SIMPLE_PREDICATE_WITH_KEY(klass, name, name) -#define INSTALL_SIMPLE_PREDICATE_WITH_KEY(klass, name, key) mop_install_simple_reader("Class::MOP::" #klass "::has_" #name, #key, SIMPLE_PREDICATE) +#define INSTALL_SIMPLE_PREDICATE_WITH_KEY(klass, name, key) (void)mop_install_simple_accessor(aTHX_ "Class::MOP::" #klass "::has_" #name, #key, sizeof(#key)-1, mop_xs_simple_predicate_for_metaclass) +XS(mop_xs_simple_accessor); XS(mop_xs_simple_reader); +XS(mop_xs_simple_writer); +XS(mop_xs_simple_predicate); +XS(mop_xs_simple_predicate_for_metaclass); +XS(mop_xs_simple_clearer); extern SV *mop_method_metaclass; extern SV *mop_associated_metaclass; diff --git a/xs/Attribute.xs b/xs/Attribute.xs index 6097b7c..2083786 100644 --- a/xs/Attribute.xs +++ b/xs/Attribute.xs @@ -28,3 +28,4 @@ BOOT: INSTALL_SIMPLE_PREDICATE(Attribute, init_arg); INSTALL_SIMPLE_PREDICATE(Attribute, initializer); INSTALL_SIMPLE_PREDICATE(Attribute, default); + diff --git a/xs/MOP.xs b/xs/MOP.xs index fe98956..11e4f95 100644 --- a/xs/MOP.xs +++ b/xs/MOP.xs @@ -29,6 +29,7 @@ EXTERN_C XS(boot_Class__MOP__Class); EXTERN_C XS(boot_Class__MOP__Attribute); EXTERN_C XS(boot_Class__MOP__Method); EXTERN_C XS(boot_Class__MOP__Instance); +EXTERN_C XS(boot_Class__MOP__Method__Accessor); MODULE = Class::MOP PACKAGE = Class::MOP @@ -52,6 +53,7 @@ BOOT: MOP_CALL_BOOT (boot_Class__MOP__Attribute); MOP_CALL_BOOT (boot_Class__MOP__Method); MOP_CALL_BOOT (boot_Class__MOP__Instance); + MOP_CALL_BOOT (boot_Class__MOP__Method__Accessor); # use prototype here to be compatible with get_code_info from Sub::Identify void diff --git a/xs/MethodAccessor.xs b/xs/MethodAccessor.xs new file mode 100755 index 0000000..86dad34 --- /dev/null +++ b/xs/MethodAccessor.xs @@ -0,0 +1,54 @@ +#include "mop.h" + +static CV* +mop_instantiate_xs_accessor(pTHX_ SV* const meta_attr, XSPROTO(accessor_impl)){ + SV* const key = mop_call0(aTHX_ meta_attr, sv_2mortal(newSVpvs("attribute_name"))); + STRLEN len; + const char* const pv = SvPV_const(key, len); + return mop_install_simple_accessor(aTHX_ NULL /* anonymous */, pv, len, accessor_impl); +} + +MODULE = Class::MOP::Method::Accessor PACKAGE = Class::MOP::Method::Accessor + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER_WITH_KEY(Method::Accessor, associated_attribute, attribute); + INSTALL_SIMPLE_READER(Method::Accessor, accessor_type); + + +CV* +_generate_accessor_method_xs(SV* self) +CODE: + RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_accessor); +OUTPUT: + RETVAL + +CV* +_generate_reader_method_xs(SV* self) +CODE: + RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_reader); +OUTPUT: + RETVAL + +CV* +_generate_writer_method_xs(SV* self) +CODE: + RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_writer); +OUTPUT: + RETVAL + +CV* +_generate_predicate_method_xs(SV* self) +CODE: + RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_predicate); +OUTPUT: + RETVAL + +CV* +_generate_clearer_method_xs(SV* self) +CODE: + RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_clearer); +OUTPUT: + RETVAL +