From: gfx <gfuji@cpan.org>
Date: Fri, 28 Aug 2009 09:59:34 +0000 (+0900)
Subject: Reconsider method generation
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=003eb62afa68183b45f1e8220ff95b0ee2d219ae;p=gitmo%2FClass-MOP.git

Reconsider method generation
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 7695d42..80a22d8 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -519,9 +519,7 @@ Class::MOP::Attribute->meta->add_attribute(
 
 Class::MOP::Attribute->meta->add_method('clone' => sub {
     my $self  = shift;
-    my $cloned = $self->meta->clone_object($self, @_);
-    $cloned->BUILD();
-    return $cloned;
+    return $self->meta->clone_object($self, @_);
 });
 
 ## --------------------------------------------------------
diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index 97b47aa..33346ef 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -52,9 +52,7 @@ sub new {
         confess("A required attribute must have either 'init_arg', 'builder', or 'default'");
     }
 
-    my $self = $class->_new(\%options);
-    $self->BUILD(); # Initializer in XS
-    return $self;
+    return $class->_new(\%options);
 }
 
 sub _new {
@@ -100,9 +98,7 @@ sub clone {
     my %options = @_;
     (blessed($self))
         || confess "Can only clone an instance";
-    my $cloned = bless { %{$self}, %options } => ref($self);
-    $cloned->BUILD();
-    return $cloned;
+    return bless { %{$self}, %options } => ref($self);
 }
 
 sub initialize_instance_slot {
diff --git a/mop.h b/mop.h
index 14774b7..995bdeb 100644
--- a/mop.h
+++ b/mop.h
@@ -84,6 +84,13 @@ typedef struct {
     void (*weaken_slot)    (pTHX_ SV* const mi, SV* const instance);
 } mop_instance_vtbl;
 
+SV*  mop_instance_create_instance(pTHX_ HV* const stash);
+bool mop_instance_has_slot(pTHX_ SV* const instance, SV* const slot);
+SV*  mop_instance_get_slot(pTHX_ SV* const instance, SV* const slot);
+SV*  mop_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value);
+SV*  mop_instance_delete_slot(pTHX_ SV* const instance, SV* const slot);
+void mop_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot);
+
 const mop_instance_vtbl* mop_get_default_instance_vtbl(pTHX);
 
 #define MOP_mg_obj(mg)   ((mg)->mg_obj)
@@ -115,7 +122,7 @@ MAGIC* mop_attr_get_mg(pTHX_ SV* const attr);
 
 
 SV*    mop_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv);
-MAGIC* mop_accessor_get_mg(pTHX_ CV* const cv);
+MAGIC* mop_attr_get_mg(pTHX_ SV* const attr);
 
 CV*    mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl, const mop_instance_vtbl* vtbl);
 CV*    mop_instantiate_xs_accessor(pTHX_ SV* const accessor, XSUBADDR_t const accessor_impl, mop_instance_vtbl* const vtbl);
diff --git a/xs/Attribute.xs b/xs/Attribute.xs
index ca2c4fb..157b7be 100644
--- a/xs/Attribute.xs
+++ b/xs/Attribute.xs
@@ -1,15 +1,5 @@
 #include "mop.h"
 
-static MGVTBL mop_attr_vtbl;
-
-
-MAGIC*
-mop_attr_get_mg(pTHX_ SV* const attr){
-    if(!SvROK(attr)) croak("Invalid object");
-
-    return mop_mg_find(aTHX_ SvRV(attr), &mop_attr_vtbl, MOPf_DIE_ON_FAIL);
-}
-
 
 MODULE = Class::MOP::Attribute   PACKAGE = Class::MOP::Attribute
 
@@ -42,13 +32,3 @@ BOOT:
     INSTALL_SIMPLE_PREDICATE(Attribute, initializer);
     INSTALL_SIMPLE_PREDICATE(Attribute, default);
 
-void
-BUILD(SV* self)
-PREINIT:
-    mop_instance_vtbl* vtbl;
-CODE:
-    if(!( SvROK(self) && SvOBJECT(SvRV(self)) )){
-        croak("Invalid object");
-    }
-    sv_magicext(SvRV(self), NULL, PERL_MAGIC_ext, &mop_attr_vtbl, NULL, 0);
-
diff --git a/xs/Class.xs b/xs/Class.xs
index cca3823..38b3134 100644
--- a/xs/Class.xs
+++ b/xs/Class.xs
@@ -1,5 +1,18 @@
 #include "mop.h"
 
+#define _generate_constructor_method_xs(self, vtbl) mop_generate_constructor_method_xs(aTHX_ self, (mop_instance_vtbl*)vtbl)
+
+static MGVTBL mop_constructor_vtbl;
+
+static CV*
+mop_generate_constructor_method_xs(pTHX_ SV* const metaclass, mop_instance_vtbl* const instance_vtbl){
+   // CV* const xsub = newXS(NULL, mop_xs_constructor, __FILE__);
+
+    assert(instance_vtbl);
+
+}
+
+
 
 MODULE = Class::MOP::Class    PACKAGE = Class::MOP::Class
 
@@ -13,3 +26,6 @@ BOOT:
     INSTALL_SIMPLE_READER(Class, constructor_name);
     INSTALL_SIMPLE_READER(Class, constructor_class);
     INSTALL_SIMPLE_READER(Class, destructor_class);
+
+CV*
+_generate_constructor_method_xs(SV* self, void* instance_vtbl)
diff --git a/xs/Instance.xs b/xs/Instance.xs
index d378c91..18c9c27 100644
--- a/xs/Instance.xs
+++ b/xs/Instance.xs
@@ -9,13 +9,13 @@
         }                                                             \
     } STMT_END
 
-static SV*
+SV*
 mop_instance_create_instance(pTHX_ HV* const stash) {
     assert(stash);
     return sv_bless( newRV_noinc((SV*)newHV()), stash );
 }
 
-static bool
+bool
 mop_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
     assert(instance);
     assert(slot);
@@ -23,7 +23,7 @@ mop_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
     return hv_exists_ent((HV*)SvRV(instance), slot, 0U);
 }
 
-static SV*
+SV*
 mop_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
     HE* he;
     assert(instance);
@@ -33,7 +33,7 @@ mop_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
     return he ? HeVAL(he) : NULL;
 }
 
-static SV*
+SV*
 mop_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value) {
     HE* he;
     SV* sv;
@@ -47,7 +47,7 @@ mop_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value)
     return sv;
 }
 
-static SV*
+SV*
 mop_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
     assert(instance);
     assert(slot);
@@ -55,7 +55,7 @@ mop_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
     return hv_delete_ent((HV*)SvRV(instance), slot, 0, 0U);
 }
 
-static void
+void
 mop_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
     HE* he;
     assert(instance);
diff --git a/xs/MOP.xs b/xs/MOP.xs
index ad2df5b..fc92ea3 100644
--- a/xs/MOP.xs
+++ b/xs/MOP.xs
@@ -32,7 +32,7 @@ mop_is_instance_of(pTHX_ SV* const sv, SV* const klass){
         FREETMPS;
         LEAVE;
 
-        return FALSE;
+        return ok;
     }
 
     return FALSE;
diff --git a/xs/MethodAccessor.xs b/xs/MethodAccessor.xs
index 57c484c..c5b99e0 100644
--- a/xs/MethodAccessor.xs
+++ b/xs/MethodAccessor.xs
@@ -55,16 +55,20 @@ mop_instantiate_xs_accessor(pTHX_ SV* const accessor, XSUBADDR_t const accessor_
 
     STRLEN klen;
     const char* const kpv = SvPV_const(key, klen);
+    SV* const keysv       = newSVpvn_share(kpv, klen, 0U);
 
-    MAGIC* mg       = mop_attr_get_mg(aTHX_ attr);
+    MAGIC* mg;
 
     CV* const xsub = newXS(NULL, accessor_impl, __FILE__);
     sv_2mortal((SV*)xsub);
 
-    MOP_mg_obj(mg) = newSVpvn_share(kpv, klen, 0U);
-    MOP_mg_obj_refcounted_on(mg);
+    mg =  sv_magicext((SV*)xsub, keysv, PERL_MAGIC_ext, &mop_accessor_vtbl, (char*)vtbl, 0);
+    SvREFCNT_dec(keysv); /* sv_magicext() increases refcnt in mg_obj */
 
-    CvXSUBANY(xsub).any_ptr = sv_magicext((SV*)xsub, MOP_mg_obj(mg), PERL_MAGIC_ext, MOP_mg_virtual(mg), (char*)vtbl, 0);
+    /* NOTE:
+     * although we use MAGIC for gc, we also store mg to CvXSUBANY slot for efficiency (gfx)
+     */
+    CvXSUBANY(xsub).any_ptr = mg;
 
     return xsub;
 }