Move accessors into XS
gfx [Sat, 24 Oct 2009 06:48:39 +0000 (15:48 +0900)]
13 files changed:
lib/Mouse.pm
lib/Mouse/Meta/Attribute.pm
lib/Mouse/Meta/Class.pm
lib/Mouse/Meta/Module.pm
lib/Mouse/Meta/Role.pm
lib/Mouse/Meta/TypeConstraint.pm
lib/Mouse/PurePerl.pm
mouse.h
t/lib/Test/Mouse.pm
xs-src/Mouse.xs
xs-src/mouse_instance.xs [new file with mode: 0644]
xs-src/mouse_simple_accessor.xs [new file with mode: 0644]
xs-src/mouse_util.xs

index f5ddb58..a0ea7c3 100644 (file)
@@ -12,6 +12,7 @@ use Mouse::Util qw(load_class is_class_loaded get_code_package not_supported);
 
 use Mouse::Meta::Module;
 use Mouse::Meta::Class;
+use Mouse::Meta::Role;
 use Mouse::Meta::Attribute;
 use Mouse::Object;
 use Mouse::Util::TypeConstraints ();
index dff0b1e..764abbb 100644 (file)
@@ -156,48 +156,8 @@ sub new {
     return $self;
 }
 
-# readers
-
-sub name                 { $_[0]->{name}                   }
-sub associated_class     { $_[0]->{associated_class}       }
-
-sub accessor             { $_[0]->{accessor}               }
-sub reader               { $_[0]->{reader}                 }
-sub writer               { $_[0]->{writer}                 }
-sub predicate            { $_[0]->{predicate}              }
-sub clearer              { $_[0]->{clearer}                }
-sub handles              { $_[0]->{handles}                }
-
-sub _is_metadata         { $_[0]->{is}                     }
-sub is_required          { $_[0]->{required}               }
-sub default              { $_[0]->{default}                }
-sub is_lazy              { $_[0]->{lazy}                   }
-sub is_lazy_build        { $_[0]->{lazy_build}             }
-sub is_weak_ref          { $_[0]->{weak_ref}               }
-sub init_arg             { $_[0]->{init_arg}               }
-sub type_constraint      { $_[0]->{type_constraint}        }
-
-sub trigger              { $_[0]->{trigger}                }
-sub builder              { $_[0]->{builder}                }
-sub should_auto_deref    { $_[0]->{auto_deref}             }
-sub should_coerce        { $_[0]->{coerce}                 }
-
-# predicates
-
-sub has_accessor         { exists $_[0]->{accessor}        }
-sub has_reader           { exists $_[0]->{reader}          }
-sub has_writer           { exists $_[0]->{writer}          }
-sub has_predicate        { exists $_[0]->{predicate}       }
-sub has_clearer          { exists $_[0]->{clearer}         }
-sub has_handles          { exists $_[0]->{handles}         }
-
-sub has_default          { exists $_[0]->{default}         }
-sub has_type_constraint  { exists $_[0]->{type_constraint} }
-sub has_trigger          { exists $_[0]->{trigger}         }
-sub has_builder          { exists $_[0]->{builder}         }
-
-sub has_read_method      { exists $_[0]->{reader} || exists $_[0]->{accessor} }
-sub has_write_method     { exists $_[0]->{writer} || exists $_[0]->{accessor} }
+sub has_read_method      { $_[0]->has_reader || $_[0]->has_accessor }
+sub has_write_method     { $_[0]->has_writer || $_[0]->has_accessor }
 
 sub _create_args { # DEPRECATED
     $_[0]->{_create_args} = $_[1] if @_ > 1;
@@ -337,10 +297,10 @@ sub get_parent_args { # DEPRECATED
 
 
 sub get_read_method {
-    $_[0]->{reader} || $_[0]->{accessor}
+    $_[0]->reader || $_[0]->accessor
 }
 sub get_write_method {
-    $_[0]->{writer} || $_[0]->{accessor}
+    $_[0]->writer || $_[0]->accessor
 }
 
 sub get_read_method_ref{
index 50f21b5..46cfd31 100644 (file)
@@ -38,11 +38,9 @@ sub create_anon_class{
     return $self->create(undef, @_);
 }
 
-sub is_anon_class{
-    return exists $_[0]->{anon_serial_id};
-}
+sub is_anon_class;
 
-sub roles { $_[0]->{roles} }
+sub roles;
 
 sub calculate_all_roles {
     my $self = shift;
index 6c3abf6..9f2c7f8 100755 (executable)
@@ -39,8 +39,7 @@ sub get_metaclass_by_name       { $METAS{$_[0]}         }
 #sub remove_metaclass_by_name    { delete $METAS{$_[0]}  }
 
 
-
-sub name { $_[0]->{package} }
+sub name;
 
 # The followings are Class::MOP specific methods
 
index 4c53da3..e850b87 100644 (file)
@@ -29,11 +29,9 @@ sub create_anon_role{
     return $self->create(undef, @_);
 }
 
-sub is_anon_role{
-    return exists $_[0]->{anon_serial_id};
-}
+sub is_anon_role;
 
-sub get_roles { $_[0]->{roles} }
+sub get_roles;
 
 sub calculate_all_roles {
     my $self = shift;
index d106313..d783a73 100644 (file)
@@ -86,13 +86,6 @@ sub create_child_type{
    );
 }
 
-sub name    { $_[0]->{name}    }
-sub parent  { $_[0]->{parent}  }
-sub message { $_[0]->{message} }
-
-sub _compiled_type_constraint{ $_[0]->{compiled_type_constraint} }
-
-sub has_coercion{ exists $_[0]->{_compiled_type_coercion} }
 
 sub compile_type_constraint{
     my($self) = @_;
index e0eb596..23f7520 100644 (file)
@@ -66,6 +66,83 @@ sub get_code_package{
     return $gv->STASH->NAME;
 }
 
+package
+    Mouse::Meta::Module;
+
+sub name { $_[0]->{package} }
+
+package
+    Mouse::Meta::Class;
+
+sub is_anon_class{
+    return exists $_[0]->{anon_serial_id};
+}
+
+sub roles { $_[0]->{roles} }
+
+package
+    Mouse::Meta::Role;
+
+sub is_anon_role{
+    return exists $_[0]->{anon_serial_id};
+}
+
+sub get_roles { $_[0]->{roles} }
+
+package
+    Mouse::Meta::Attribute;
+
+
+# readers
+
+sub name                 { $_[0]->{name}                   }
+sub associated_class     { $_[0]->{associated_class}       }
+
+sub accessor             { $_[0]->{accessor}               }
+sub reader               { $_[0]->{reader}                 }
+sub writer               { $_[0]->{writer}                 }
+sub predicate            { $_[0]->{predicate}              }
+sub clearer              { $_[0]->{clearer}                }
+sub handles              { $_[0]->{handles}                }
+
+sub _is_metadata         { $_[0]->{is}                     }
+sub is_required          { $_[0]->{required}               }
+sub default              { $_[0]->{default}                }
+sub is_lazy              { $_[0]->{lazy}                   }
+sub is_lazy_build        { $_[0]->{lazy_build}             }
+sub is_weak_ref          { $_[0]->{weak_ref}               }
+sub init_arg             { $_[0]->{init_arg}               }
+sub type_constraint      { $_[0]->{type_constraint}        }
+
+sub trigger              { $_[0]->{trigger}                }
+sub builder              { $_[0]->{builder}                }
+sub should_auto_deref    { $_[0]->{auto_deref}             }
+sub should_coerce        { $_[0]->{coerce}                 }
+
+# predicates
+
+sub has_accessor         { exists $_[0]->{accessor}        }
+sub has_reader           { exists $_[0]->{reader}          }
+sub has_writer           { exists $_[0]->{writer}          }
+sub has_predicate        { exists $_[0]->{predicate}       }
+sub has_clearer          { exists $_[0]->{clearer}         }
+sub has_handles          { exists $_[0]->{handles}         }
+
+sub has_default          { exists $_[0]->{default}         }
+sub has_type_constraint  { exists $_[0]->{type_constraint} }
+sub has_trigger          { exists $_[0]->{trigger}         }
+sub has_builder          { exists $_[0]->{builder}         }
+
+package
+    Mouse::Meta::TypeConstraint;
+
+sub name    { $_[0]->{name}    }
+sub parent  { $_[0]->{parent}  }
+sub message { $_[0]->{message} }
+
+sub _compiled_type_constraint{ $_[0]->{compiled_type_constraint} }
+
+sub has_coercion{ exists $_[0]->{_compiled_type_coercion} }
 
 package
     Mouse::Meta::Method::Accessor;
diff --git a/mouse.h b/mouse.h
index 5fe65b5..2f4312e 100644 (file)
--- a/mouse.h
+++ b/mouse.h
@@ -8,6 +8,13 @@
 
 #include "ppport.h"
 
+#define MOUSE_CALL_BOOT(name) STMT_START {        \
+        EXTERN_C XS(CAT2(boot_, name));         \
+        PUSHMARK(SP);                           \
+        CALL_FPTR(CAT2(boot_, name))(aTHX_ cv); \
+    } STMT_END
+
+
 #define is_class_loaded(sv) mouse_is_class_loaded(aTHX_ sv)
 bool mouse_is_class_loaded(pTHX_ SV*);
 
@@ -24,6 +31,36 @@ bool mouse_is_instance_of(pTHX_ SV* const sv, SV* const klass);
 SV* mouse_call0(pTHX_ SV *const self, SV *const method);
 SV* mouse_call1(pTHX_ SV *const self, SV *const method, SV* const arg1);
 
+#define MOUSEf_DIE_ON_FAIL 0x01
+MAGIC* mouse_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl, I32 const flags);
+
+#define dMOUSE_self      SV* const self = mouse_accessor_get_self(aTHX_ ax, items, cv)
+
+/* mouse_instance.xs stuff */
+SV*  mouse_instance_create     (pTHX_ HV* const stash);
+SV*  mouse_instance_clone      (pTHX_ SV* const instance);
+bool mouse_instance_has_slot   (pTHX_ SV* const instance, SV* const slot);
+SV*  mouse_instance_get_slot   (pTHX_ SV* const instance, SV* const slot);
+SV*  mouse_instance_set_slot   (pTHX_ SV* const instance, SV* const slot, SV* const value);
+SV*  mouse_instance_delete_slot(pTHX_ SV* const instance, SV* const slot);
+void mouse_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot);
+
+
+/* mouse_simle_accessor.xs */
+#define INSTALL_SIMPLE_READER(klass, name)                  INSTALL_SIMPLE_READER_WITH_KEY(klass, name, name)
+#define INSTALL_SIMPLE_READER_WITH_KEY(klass, name, key)    (void)mouse_install_simple_accessor(aTHX_ "Mouse::Meta::" #klass "::" #name, #key, sizeof(#key)-1, mouse_xs_simple_reader)
+
+#define INSTALL_SIMPLE_WRITER(klass, name)                  INSTALL_SIMPLE_WRITER_WITH_KEY(klass, name, name)
+#define INSTALL_SIMPLE_WRITER_WITH_KEY(klass, name, key)    (void)mouse_install_simple_accessor(aTHX_ "Mouse::Meta::" #klass "::" #name, #key, sizeof(#key)-1, mouse_xs_simple_writer)
+
+#define INSTALL_SIMPLE_PREDICATE(klass, name)                INSTALL_SIMPLE_PREDICATE_WITH_KEY(klass, name, name)
+#define INSTALL_SIMPLE_PREDICATE_WITH_KEY(klass, name, key) (void)mouse_install_simple_accessor(aTHX_ "Mouse::Meta::" #klass "::" #name, #key, sizeof(#key)-1, mouse_xs_simple_predicate)
+
+CV* mouse_install_simple_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl);
+
+XS(mouse_xs_simple_reader);
+XS(mouse_xs_simple_writer);
+XS(mouse_xs_simple_predicate);
 
 #endif /* !MOUSE_H */
 
index 93b4946..2d46cbd 100644 (file)
@@ -120,9 +120,6 @@ package
 sub applied_traits{            $_[0]->{traits} } # TEST ONLY
 sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY
 
-sub has_documentation{ exists $_[0]->{documentation} } # TEST ONLY
-sub documentation{            $_[0]->{documentation} } # TEST ONLY
-
 1;
 
 __END__
index f96dce3..d5e7842 100644 (file)
@@ -33,3 +33,76 @@ CODE:
 OUTPUT:
     RETVAL
 
+MODULE = Mouse  PACKAGE = Mouse::Meta::Module
+
+BOOT:
+    INSTALL_SIMPLE_READER_WITH_KEY(Module, name, package);
+    INSTALL_SIMPLE_READER_WITH_KEY(Module, _method_map, methods);
+    INSTALL_SIMPLE_READER_WITH_KEY(Module, _attribute_map, attributes);
+
+MODULE = Mouse  PACKAGE = Mouse::Meta::Class
+
+BOOT:
+    INSTALL_SIMPLE_READER(Class, roles);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id);
+
+MODULE = Mouse  PACKAGE = Mouse::Meta::Role
+
+BOOT:
+    INSTALL_SIMPLE_READER_WITH_KEY(Role, get_roles, roles);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Role, is_anon_role, anon_serial_id);
+
+
+MODULE = Mouse  PACKAGE = Mouse::Meta::Attribute
+
+BOOT:
+    /* readers */
+    INSTALL_SIMPLE_READER(Attribute, name);
+    INSTALL_SIMPLE_READER(Attribute, associated_class);
+    INSTALL_SIMPLE_READER(Attribute, accessor);
+    INSTALL_SIMPLE_READER(Attribute, reader);
+    INSTALL_SIMPLE_READER(Attribute, writer);
+    INSTALL_SIMPLE_READER(Attribute, predicate);
+    INSTALL_SIMPLE_READER(Attribute, clearer);
+    INSTALL_SIMPLE_READER(Attribute, handles);
+
+    INSTALL_SIMPLE_READER_WITH_KEY(Attribute, _is_metadata, is);
+    INSTALL_SIMPLE_READER_WITH_KEY(Attribute, is_required, required);
+    INSTALL_SIMPLE_READER(Attribute, default);
+    INSTALL_SIMPLE_READER_WITH_KEY(Attribute, is_lazy, lazy);
+    INSTALL_SIMPLE_READER_WITH_KEY(Attribute, is_lazy_build, lazy_build);
+    INSTALL_SIMPLE_READER_WITH_KEY(Attribute, is_weak_ref, weak_ref);
+    INSTALL_SIMPLE_READER(Attribute, init_arg);
+    INSTALL_SIMPLE_READER(Attribute, type_constraint);
+    INSTALL_SIMPLE_READER(Attribute, trigger);
+    INSTALL_SIMPLE_READER(Attribute, builder);
+    INSTALL_SIMPLE_READER_WITH_KEY(Attribute, should_auto_deref, auto_deref);
+    INSTALL_SIMPLE_READER_WITH_KEY(Attribute, should_coerce, coerce);
+    INSTALL_SIMPLE_READER(Attribute, documentation);
+
+    /* predicates */
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_accessor, accessor);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_reader, reader);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_writer, writer);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_predicate, predicate);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_clearer, clearer);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_handles, handles);
+
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_default, default);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_type_constraint, type_constraint);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_trigger, trigger);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_builder, builder);
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_documentation, documentation);
+
+MODULE = Mouse  PACKAGE = Mouse::Meta::TypeConstraint
+
+BOOT:
+    INSTALL_SIMPLE_READER(TypeConstraint, name);
+    INSTALL_SIMPLE_READER(TypeConstraint, parent);
+    INSTALL_SIMPLE_READER(TypeConstraint, message);
+
+    INSTALL_SIMPLE_READER_WITH_KEY(TypeConstraint, _compiled_type_constraint, compiled_type_constraint);
+    INSTALL_SIMPLE_READER(TypeConstraint, _compiled_type_coercion); /* Mouse specific */
+
+    INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion);
+
diff --git a/xs-src/mouse_instance.xs b/xs-src/mouse_instance.xs
new file mode 100644 (file)
index 0000000..dd74c1c
--- /dev/null
@@ -0,0 +1,76 @@
+#include "mouse.h"\r
+\r
+#define CHECK_INSTANCE(instance) STMT_START{                          \
+        if(!(SvROK(instance) && SvTYPE(SvRV(instance)) == SVt_PVHV)){ \
+            croak("Invalid object for instance managers");            \
+        }                                                             \
+    } STMT_END
+
+SV*
+mouse_instance_create(pTHX_ HV* const stash) {
+    assert(stash);
+    return sv_bless( newRV_noinc((SV*)newHV()), stash );
+}
+
+SV*
+mouse_instance_clone(pTHX_ SV* const instance) {
+    HV* proto;
+    assert(instance);
+
+    CHECK_INSTANCE(instance);
+    proto = newHVhv((HV*)SvRV(instance));
+    return sv_bless( newRV_noinc((SV*)proto), SvSTASH(SvRV(instance)) );
+}
+
+bool
+mouse_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
+    assert(instance);
+    assert(slot);
+    CHECK_INSTANCE(instance);
+    return hv_exists_ent((HV*)SvRV(instance), slot, 0U);
+}
+
+SV*
+mouse_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
+    HE* he;
+    assert(instance);
+    assert(slot);
+    CHECK_INSTANCE(instance);
+    he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
+    return he ? HeVAL(he) : NULL;
+}
+
+SV*
+mouse_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value) {
+    HE* he;
+    SV* sv;
+    assert(instance);
+    assert(slot);
+    assert(value);
+    CHECK_INSTANCE(instance);
+    he = hv_fetch_ent((HV*)SvRV(instance), slot, TRUE, 0U);
+    sv = HeVAL(he);
+    sv_setsv_mg(sv, value);
+    return sv;
+}
+
+SV*
+mouse_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
+    assert(instance);
+    assert(slot);
+    CHECK_INSTANCE(instance);
+    return hv_delete_ent((HV*)SvRV(instance), slot, 0, 0U);
+}
+
+void
+mouse_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
+    HE* he;
+    assert(instance);
+    assert(slot);
+    CHECK_INSTANCE(instance);
+    he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
+    if(he){
+        sv_rvweaken(HeVAL(he));
+    }
+}
+\r
diff --git a/xs-src/mouse_simple_accessor.xs b/xs-src/mouse_simple_accessor.xs
new file mode 100644 (file)
index 0000000..cf835fb
--- /dev/null
@@ -0,0 +1,98 @@
+#include "mouse.h"\r
+\r
+static MGVTBL mouse_simple_accessor_vtbl;
+\r\r
+/*
+static MAGIC*
+mouse_accessor_get_mg(pTHX_ CV* const xsub){
+    return moose_mg_find(aTHX_ (SV*)xsub, &mouse_simple_accessor_vtbl, MOOSEf_DIE_ON_FAIL);
+}\r
+*/\r
+\r
+CV*
+mouse_install_simple_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl){
+    CV* const xsub = newXS((char*)fq_name, accessor_impl, __FILE__);
+    SV* const slot = newSVpvn_share(key, keylen, 0U);
+    MAGIC* mg;
+
+    if(!fq_name){
+        /* anonymous xsubs need sv_2mortal */
+        sv_2mortal((SV*)xsub);
+    }
+
+    mg = sv_magicext((SV*)xsub, slot, PERL_MAGIC_ext, &mouse_simple_accessor_vtbl, NULL, 0);
+    SvREFCNT_dec(slot); /* sv_magicext() increases refcnt in mg_obj */
+
+    /* NOTE:
+     * although we use MAGIC for gc, we also store slot to CvXSUBANY slot for efficiency (gfx)
+     */
+    CvXSUBANY(xsub).any_ptr = (void*)slot;
+
+    return xsub;
+}
+\r
+SV*
+mouse_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) {
+    SV* self;
+
+    if(items < 1){
+        croak("Too few arguments for %s", GvNAME(CvGV(cv)));
+    }
+
+    /* NOTE: If self has GETMAGIC, $self->accessor will invoke GETMAGIC
+     *       before calling methods, so SvGETMAGIC(self) is not necessarily needed here.
+     */
+
+    self = ST(0);
+    if(!IsObject(self)){
+        croak("Cant call %s as a class method", GvNAME(CvGV(cv)));
+    }
+    return self;
+}\r
+
+
+XS(mouse_xs_simple_reader)
+{
+    dVAR; dXSARGS;\r
+    dMOUSE_self;
+    SV* const slot = (SV*)XSANY.any_ptr;
+    SV* value;
+
+    if (items != 1) {
+        croak("Expected exactly one argument");
+    }
+
+    value = mouse_instance_get_slot(self, slot);
+    ST(0) = value ? value : &PL_sv_undef;
+    XSRETURN(1);
+}
+
+
+XS(mouse_xs_simple_writer)
+{
+    dVAR; dXSARGS;
+    dMOUSE_self;
+    SV* const slot = (SV*)XSANY.any_ptr;
+\r
+    if (items != 2) {
+        croak("Expected exactly two argument");
+    }
+
+    ST(0) = mouse_instance_set_slot(self, slot, ST(1));
+    XSRETURN(1);
+}
+
+
+XS(mouse_xs_simple_predicate)
+{
+    dVAR; dXSARGS;
+    dMOUSE_self;
+    SV* const slot = (SV*)XSANY.any_ptr;
+\r
+    if (items != 1) {
+        croak("Expected exactly one argument");
+    }
+
+    ST(0) = boolSV( mouse_instance_has_slot(self, slot) );
+    XSRETURN(1);
+}\r
index 772deaf..5da4071 100644 (file)
@@ -108,3 +108,19 @@ mouse_call1 (pTHX_ SV *const self, SV *const method, SV* const arg1)
     return ret;
 }
 
+MAGIC*
+mouse_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl, I32 const flags){
+    MAGIC* mg;
+
+    assert(sv != NULL);
+    for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){
+        if(mg->mg_virtual == vtbl){
+            return mg;
+        }
+    }
+
+    if(flags & MOUSEf_DIE_ON_FAIL){
+        croak("mouse_mg_find: no MAGIC found for %"SVf, sv_2mortal(newRV_inc(sv)));
+    }
+    return NULL;
+}