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, @_);
});
## --------------------------------------------------------
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 {
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 {
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)
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);
#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
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);
-
#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
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)
} \
} 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);
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);
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;
return sv;
}
-static SV*
+SV*
mop_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
assert(instance);
assert(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);
FREETMPS;
LEAVE;
- return FALSE;
+ return ok;
}
return FALSE;
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;
}