The first step to frame XS attributes

diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index 13889ab..20daad6 100644 (file)
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -72,6 +72,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 {
@@ -80,10 +92,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 b7b1248..cc10714 100644 (file)
--- a/mop.c
+++ b/mop.c
@@ -179,19 +179,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);
@@ -203,46 +202,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 (file)
--- 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 (file)
--- 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 a1bffab..438ed4b 100644 (file)
--- a/xs/MOP.xs
+++ b/xs/MOP.xs
@@ -28,6 +28,7 @@ EXTERN_C XS(boot_Class__MOP__Package);
 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
 
@@ -50,6 +51,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 (executable)
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
+