SV* mouse_methods;
SV* mouse_name;
-MODULE = Mouse PACKAGE = Mouse::Util
+MODULE = Mouse PACKAGE = Mouse
PROTOTYPES: DISABLE
mouse_methods = newSVpvs_share("methods");
mouse_name = newSVpvs_share("name");
+ MOUSE_CALL_BOOT(Mouse__Util);
MOUSE_CALL_BOOT(Mouse__Util__TypeConstraints);
-
-
-bool
-is_class_loaded(SV* sv)
-
-void
-get_code_info(CV* code)
-PREINIT:
- GV* gv;
- HV* stash;
-PPCODE:
- if((gv = CvGV(code)) && isGV(gv) && (stash = GvSTASH(gv))){
- EXTEND(SP, 2);
- mPUSHs(newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U));
- mPUSHs(newSVpvn_share(GvNAME_get(gv), GvNAMELEN_get(gv), 0U));
- }
-
-SV*
-get_code_package(CV* code)
-PREINIT:
- HV* stash;
-CODE:
- if(CvGV(code) && isGV(CvGV(code)) && (stash = GvSTASH(CvGV(code)))){
- RETVAL = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
- }
- else{
- RETVAL = &PL_sv_no;
- }
-OUTPUT:
- RETVAL
-
-CV*
-get_code_ref(SV* package, SV* name)
-CODE:
-{
- HV* stash;
- HE* he;
-
- if(!SvOK(package)){
- croak("You must define a package name");
- }
- if(!SvOK(name)){
- croak("You must define a subroutine name");
- }
-
- stash = gv_stashsv(package, FALSE);
- if(!stash){
- XSRETURN_UNDEF;
- }
- he = hv_fetch_ent(stash, name, FALSE, 0U);
- if(he){
- GV* const gv = (GV*)hv_iterval(stash, he);
- if(!isGV(gv)){ /* special constant or stub */
- STRLEN len;
- const char* const pv = SvPV_const(name, len);
- gv_init(gv, stash, pv, len, GV_ADDMULTI);
- }
- RETVAL = GvCVu(gv);
- }
- else{
- RETVAL = NULL;
- }
-
- if(!RETVAL){
- XSRETURN_UNDEF;
- }
-}
-OUTPUT:
- RETVAL
-
-void
-generate_isa_predicate_for(SV* klass, const char* predicate_name = NULL)
-PPCODE:
-{
- STRLEN klass_len;
- const char* klass_pv;
- HV* stash;
- CV* xsub;
-
- if(!SvOK(klass)){
- croak("You must define a class name for generate_for");
- }
- klass_pv = SvPV_const(klass, klass_len);
- klass_pv = mouse_canonicalize_package_name(klass_pv);
-
- if(strNE(klass_pv, "UNIVERSAL")){
- static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */
-
- xsub = newXS(predicate_name, XS_isa_check, __FILE__);
-
- stash = gv_stashpvn(klass_pv, klass_len, GV_ADD);
-
- CvXSUBANY(xsub).any_ptr = sv_magicext(
- (SV*)xsub,
- (SV*)stash, /* mg_obj */
- PERL_MAGIC_ext,
- &mouse_util_type_constraints_vtbl,
- klass_pv, /* mg_ptr */
- klass_len /* mg_len */
- );
- }
- else{
- xsub = newXS(predicate_name, XS_isa_check_for_universal, __FILE__);
- }
-
- if(predicate_name == NULL){ /* anonymous predicate */
- XPUSHs( newRV_noinc((SV*)xsub) );
- }
-}
+ MOUSE_CALL_BOOT(Mouse__Meta__Method__Accessor__XS);
MODULE = Mouse PACKAGE = Mouse::Meta::Module
INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion);
-MODULE = Mouse PACKAGE = Mouse::Meta::Method::Accessor::XS
-
-CV*
-_generate_accessor(klass, SV* attr, metaclass)
-CODE:
-{
- RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_accessor);
-}
-OUTPUT:
- RETVAL
-
-CV*
-_generate_reader(klass, SV* attr, metaclass)
-CODE:
-{
- RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_reader);
-}
-OUTPUT:
- RETVAL
-
-CV*
-_generate_writer(klass, SV* attr, metaclass)
-CODE:
-{
- RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_writer);
-}
-OUTPUT:
- RETVAL
-
-CV*
-_generate_clearer(klass, SV* attr, metaclass)
-CODE:
-{
- SV* const slot = mcall0s(attr, "name");
- STRLEN len;
- const char* const pv = SvPV_const(slot, len);
- RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, mouse_xs_simple_clearer);
-}
-OUTPUT:
- RETVAL
-
-CV*
-_generate_predicate(klass, SV* attr, metaclass)
-CODE:
-{
- SV* const slot = mcall0s(attr, "name");
- STRLEN len;
- const char* const pv = SvPV_const(slot, len);
- RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, mouse_xs_simple_predicate);
-}
-OUTPUT:
- RETVAL
-
--- /dev/null
+#include "mouse.h"
+
+#define CHECK_INSTANCE(instance) STMT_START{ \
+ if(!(SvROK(instance) && SvTYPE(SvRV(instance)) == SVt_PVHV)){ \
+ croak("Invalid object for instance managers"); \
+ } \
+ } STMT_END
+
+/* Moose XS Attribute object */
+enum mouse_xa_ix_t{
+ MOUSE_XA_ATTRIBUTE,
+ MOUSE_XA_TC,
+ MOUSE_XA_TC_CODE,
+
+ MOUSE_XA_last
+};
+
+#define MOUSE_xa_attribute(m) MOUSE_av_at(m, MOUSE_XA_ATTRIBUTE)
+#define MOUSE_xa_tc(m) MOUSE_av_at(m, MOUSE_XA_TC)
+#define MOUSE_xa_tc_code(m) MOUSE_av_at(m, MOUSE_XA_TC_CODE)
+
+#define MOUSE_mg_attribute(mg) MOUSE_xa_attribute(MOUSE_mg_xa(mg))
+
+enum mouse_xa_flags_t{
+ MOUSEf_ATTR_HAS_TC = 0x0001,
+ MOUSEf_ATTR_HAS_DEFAULT = 0x0002,
+ MOUSEf_ATTR_HAS_BUILDER = 0x0004,
+ MOUSEf_ATTR_HAS_INITIALIZER = 0x0008, /* not used in Mouse */
+ MOUSEf_ATTR_HAS_TRIGGER = 0x0010,
+
+ MOUSEf_ATTR_IS_LAZY = 0x0020,
+ MOUSEf_ATTR_IS_WEAK_REF = 0x0040,
+ MOUSEf_ATTR_IS_REQUIRED = 0x0080,
+
+ MOUSEf_ATTR_SHOULD_COERCE = 0x0100,
+
+ MOUSEf_ATTR_SHOULD_AUTO_DEREF
+ = 0x0200,
+ MOUSEf_TC_IS_ARRAYREF = 0x0400,
+ MOUSEf_TC_IS_HASHREF = 0x0800,
+
+ MOUSEf_OTHER1 = 0x1000,
+ MOUSEf_OTHER2 = 0x2000,
+ MOUSEf_OTHER3 = 0x4000,
+ MOUSEf_OTHER4 = 0x8000,
+
+ MOUSEf_MOUSE_MASK = 0xFFFF /* not used */
+};
+
+static MGVTBL mouse_accessor_vtbl; /* MAGIC identity */
+
+
+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;
+}
+
+
+CV*
+mouse_instantiate_xs_accessor(pTHX_ SV* const attr, XSUBADDR_t const accessor_impl){
+ SV* const slot = mcall0(attr, mouse_name);
+ AV* const xa = newAV();
+ CV* xsub;
+ MAGIC* mg;
+ U16 flags = 0;
+
+ sv_2mortal((SV*)xa);
+
+ xsub = newXS(NULL, accessor_impl, __FILE__);
+ sv_2mortal((SV*)xsub);
+
+ mg = sv_magicext((SV*)xsub, slot, PERL_MAGIC_ext, &mouse_accessor_vtbl, (char*)xa, HEf_SVKEY);
+
+ /* NOTE:
+ * although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx)
+ */
+ CvXSUBANY(xsub).any_ptr = (void*)mg;
+
+ av_extend(xa, MOUSE_XA_last - 1);
+
+ av_store(xa, MOUSE_XA_ATTRIBUTE, newSVsv(attr));
+
+ /* prepare attribute status */
+ /* XXX: making it lazy is a good way? */
+
+ if(SvTRUEx(mcall0s(attr, "has_type_constraint"))){
+ SV* tc;
+ flags |= MOUSEf_ATTR_HAS_TC;
+
+ ENTER;
+ SAVETMPS;
+
+ tc = mcall0s(attr, "type_constraint");
+ av_store(xa, MOUSE_XA_TC, newSVsv(tc));
+
+ if(SvTRUEx(mcall0s(attr, "should_auto_deref"))){
+ flags |= MOUSEf_ATTR_SHOULD_AUTO_DEREF;
+ if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("ArrayRef", SVs_TEMP))) ){
+ flags |= MOUSEf_TC_IS_ARRAYREF;
+ }
+ else if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("HashRef", SVs_TEMP))) ){
+ flags |= MOUSEf_TC_IS_HASHREF;
+ }
+ else{
+ mouse_throw_error(attr, tc,
+ "Can not auto de-reference the type constraint '%"SVf"'",
+ mcall0(tc, mouse_name));
+ }
+ }
+
+ if(SvTRUEx(mcall0s(attr, "should_coerce"))){
+ flags |= MOUSEf_ATTR_SHOULD_COERCE;
+ }
+
+ FREETMPS;
+ LEAVE;
+ }
+
+ if(SvTRUEx(mcall0s(attr, "has_trigger"))){
+ flags |= MOUSEf_ATTR_HAS_TRIGGER;
+ }
+
+ if(SvTRUEx(mcall0s(attr, "is_lazy"))){
+ flags |= MOUSEf_ATTR_IS_LAZY;
+
+ if(SvTRUEx(mcall0s(attr, "has_builder"))){
+ flags |= MOUSEf_ATTR_HAS_BUILDER;
+ }
+ else if(SvTRUEx(mcall0s(attr, "has_default"))){
+ flags |= MOUSEf_ATTR_HAS_DEFAULT;
+ }
+ }
+
+ if(SvTRUEx(mcall0s(attr, "is_weak_ref"))){
+ flags |= MOUSEf_ATTR_IS_WEAK_REF;
+ }
+
+ if(SvTRUEx(mcall0s(attr, "is_required"))){
+ flags |= MOUSEf_ATTR_IS_REQUIRED;
+ }
+
+ MOUSE_mg_flags(mg) = flags;
+
+ return xsub;
+}
+
+static SV*
+mouse_apply_type_constraint(pTHX_ AV* const xa, SV* value, U16 const flags){
+ SV* const tc = MOUSE_xa_tc(xa);
+ SV* tc_code;
+
+ if(flags & MOUSEf_ATTR_SHOULD_COERCE){
+ value = mcall1s(tc, "coerce", value);
+ }
+
+ if(!SvOK(MOUSE_xa_tc_code(xa))){
+ XS(XS_Mouse__Util__TypeConstraints_Item); /* prototype defined in Mouse.xs */
+
+ tc_code = mcall0s(tc, "_compiled_type_constraint");
+
+ if(SvROK(tc_code) && SvTYPE(SvRV(tc_code))
+ && CvXSUB((CV*)SvRV(tc_code)) == XS_Mouse__Util__TypeConstraints_Item){
+ /* built-in type constraints */
+ mouse_tc const id = CvXSUBANY((CV*)SvRV(tc_code)).any_i32;
+ av_store(xa, MOUSE_XA_TC_CODE, newSViv(id));
+ }
+ else{
+ av_store(xa, MOUSE_XA_TC_CODE, newSVsv(tc_code));
+ }
+ }
+ else{
+ tc_code = MOUSE_xa_tc_code(xa);
+ }
+
+ if(!mouse_tc_check(aTHX_ tc_code, value)){
+ mouse_throw_error(MOUSE_xa_attribute(xa), value,
+ "Attribute (%"SVf") does not pass the type constraint because: %"SVf,
+ mcall0(MOUSE_xa_attribute(xa), mouse_name),
+ mcall1s(tc, "get_message", value));
+ }
+
+ return value;
+}
+
+
+/* pushes return values, does auto-deref if needed */
+static void
+mouse_push_values(pTHX_ SV* const value, U16 const flags){
+ dSP;
+
+ if(flags & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY){
+ if(!(value && SvOK(value))){
+ return;
+ }
+
+ if(flags & MOUSEf_TC_IS_ARRAYREF){
+ AV* const av = (AV*)SvRV(value);
+ I32 len;
+ I32 i;
+
+ if(SvTYPE(av) != SVt_PVAV){
+ croak("Mouse-panic: Not an ARRAY reference");
+ }
+
+ len = av_len(av) + 1;
+ EXTEND(SP, len);
+ for(i = 0; i < len; i++){
+ SV** const svp = av_fetch(av, i, FALSE);
+ PUSHs(svp ? *svp : &PL_sv_undef);
+ }
+ }
+ else if(flags & MOUSEf_TC_IS_HASHREF){
+ HV* const hv = (HV*)SvRV(value);
+ HE* he;
+
+ if(SvTYPE(hv) != SVt_PVHV){
+ croak("Mouse-panic: Not a HASH reference");
+ }
+
+ hv_iterinit(hv);
+ while((he = hv_iternext(hv))){
+ EXTEND(SP, 2);
+ PUSHs(hv_iterkeysv(he));
+ PUSHs(hv_iterval(hv, he));
+ }
+ }
+ }
+ else{
+ XPUSHs(value ? value : &PL_sv_undef);
+ }
+
+ PUTBACK;
+}
+
+static void
+mouse_attr_get(pTHX_ SV* const self, MAGIC* const mg){
+ U16 const flags = MOUSE_mg_flags(mg);
+ SV* const slot = MOUSE_mg_slot(mg);
+ SV* value;
+
+ value = mouse_instance_get_slot(aTHX_ self, slot);
+
+ /* check_lazy */
+ if( !value && flags & MOUSEf_ATTR_IS_LAZY ){
+ AV* const xa = MOUSE_mg_xa(mg);
+ SV* const attr = MOUSE_xa_attribute(xa);
+
+ /* get default value by $attr->default or $attr->builder */
+ if(flags & MOUSEf_ATTR_HAS_DEFAULT){
+ value = mcall0s(attr, "default");
+
+ if(SvROK(value) && SvTYPE(SvRV(value)) == SVt_PVCV){
+ value = mcall0(self, value);
+ }
+ }
+ else if(flags & MOUSEf_ATTR_HAS_BUILDER){
+ SV* const builder = mcall0s(attr, "builder");
+ value = mcall0(self, builder);
+ }
+
+ if(!value){
+ value = sv_newmortal();
+ }
+
+ /* apply coerce and type constraint */
+ if(flags & MOUSEf_ATTR_HAS_TC){
+ value = mouse_apply_type_constraint(aTHX_ xa, value, flags);
+ }
+
+ /* store value to slot */
+ value = mouse_instance_set_slot(aTHX_ self, slot, value);
+ }
+
+ mouse_push_values(aTHX_ value, flags);
+}
+
+static void
+mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){
+ U16 const flags = MOUSE_mg_flags(mg);
+ SV* const slot = MOUSE_mg_slot(mg);
+
+ if(flags & MOUSEf_ATTR_HAS_TC){
+ value = mouse_apply_type_constraint(aTHX_ MOUSE_mg_xa(mg), value, flags);
+ }
+
+ mouse_instance_set_slot(aTHX_ self, slot, value);
+
+ if(flags & MOUSEf_ATTR_IS_WEAK_REF){
+ mouse_instance_weaken_slot(aTHX_ self, slot);
+ }
+
+ if(flags & MOUSEf_ATTR_HAS_TRIGGER){
+ SV* const trigger = mcall0s(MOUSE_mg_attribute(mg), "trigger");
+ dSP;
+
+ PUSHMARK(SP);
+ EXTEND(SP, 2);
+ PUSHs(self);
+ PUSHs(value);
+
+ PUTBACK;
+ call_sv(trigger, G_VOID | G_DISCARD);
+ /* need not SPAGAIN */
+ }
+
+ mouse_push_values(aTHX_ value, flags);
+}
+
+XS(mouse_xs_accessor)
+{
+ dVAR; dXSARGS;
+ dMOUSE_self;
+ MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
+
+ SP -= items; /* PPCODE */
+ PUTBACK;
+
+ if(items == 1){ /* reader */
+ mouse_attr_get(aTHX_ self, mg);
+ }
+ else if (items == 2){ /* writer */
+ mouse_attr_set(aTHX_ self, mg, ST(1));
+ }
+ else{
+ mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
+ "Expected exactly one or two argument for an accessor");
+ }
+}
+
+
+XS(mouse_xs_reader)
+{
+ dVAR; dXSARGS;
+ dMOUSE_self;
+ MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
+
+ if (items != 1) {
+ mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
+ "Cannot assign a value to a read-only accessor");
+ }
+
+ SP -= items; /* PPCODE */
+ PUTBACK;
+
+ mouse_attr_get(aTHX_ self, mg);
+}
+
+XS(mouse_xs_writer)
+{
+ dVAR; dXSARGS;
+ dMOUSE_self;
+ MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
+
+ if (items != 2) {
+ mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
+ "Too few arguments for a write-only accessor");
+ }
+
+ SP -= items; /* PPCODE */
+ PUTBACK;
+
+ mouse_attr_set(aTHX_ self, mg, ST(1));
+}
+
+/* simple accessors */
+
+/*
+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);
+}
+*/
+
+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_accessor_vtbl, NULL, 0);
+ SvREFCNT_dec(slot); /* sv_magicext() increases refcnt in mg_obj */
+
+ /* NOTE:
+ * although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx)
+ */
+ CvXSUBANY(xsub).any_ptr = (void*)mg;
+
+ return xsub;
+}
+
+XS(mouse_xs_simple_reader)
+{
+ dVAR; dXSARGS;
+ dMOUSE_self;
+ SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
+ SV* value;
+
+ if (items != 1) {
+ croak("Expected exactly one argument for a reader for '%"SVf"'", slot);
+ }
+
+ value = mouse_instance_get_slot(aTHX_ self, slot);
+ ST(0) = value ? value : &PL_sv_undef;
+ XSRETURN(1);
+}
+
+
+XS(mouse_xs_simple_writer)
+{
+ dVAR; dXSARGS;
+ dMOUSE_self;
+ SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
+
+ if (items != 2) {
+ croak("Expected exactly two argument for a writer for '%"SVf"'", slot);
+ }
+
+ ST(0) = mouse_instance_set_slot(aTHX_ self, slot, ST(1));
+ XSRETURN(1);
+}
+
+XS(mouse_xs_simple_clearer)
+{
+ dVAR; dXSARGS;
+ dMOUSE_self;
+ SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
+ SV* value;
+
+ if (items != 1) {
+ croak("Expected exactly one argument for a clearer for '%"SVf"'", slot);
+ }
+
+ value = mouse_instance_delete_slot(aTHX_ self, slot);
+ ST(0) = value ? value : &PL_sv_undef;
+ XSRETURN(1);
+}
+
+XS(mouse_xs_simple_predicate)
+{
+ dVAR; dXSARGS;
+ dMOUSE_self;
+ SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
+
+ if (items != 1) {
+ croak("Expected exactly one argument for a predicate for '%"SVf"'", slot);
+ }
+
+ ST(0) = boolSV( mouse_instance_has_slot(aTHX_ self, slot) );
+ XSRETURN(1);
+}
+
+/* simple instance slot accessor */
+
+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
+MODULE = Mouse::Meta::Method::Accessor::XS PACKAGE = Mouse::Meta::Method::Accessor::XS
+
+PROTOTYPES: DISABLE
+VERSIONCHECK: DISABLE
+
+CV*
+_generate_accessor(klass, SV* attr, metaclass)
+CODE:
+{
+ RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_accessor);
+}
+OUTPUT:
+ RETVAL
+
+CV*
+_generate_reader(klass, SV* attr, metaclass)
+CODE:
+{
+ RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_reader);
+}
+OUTPUT:
+ RETVAL
+
+CV*
+_generate_writer(klass, SV* attr, metaclass)
+CODE:
+{
+ RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_writer);
+}
+OUTPUT:
+ RETVAL
+
+CV*
+_generate_clearer(klass, SV* attr, metaclass)
+CODE:
+{
+ SV* const slot = mcall0s(attr, "name");
+ STRLEN len;
+ const char* const pv = SvPV_const(slot, len);
+ RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, mouse_xs_simple_clearer);
+}
+OUTPUT:
+ RETVAL
+
+CV*
+_generate_predicate(klass, SV* attr, metaclass)
+CODE:
+{
+ SV* const slot = mcall0s(attr, "name");
+ STRLEN len;
+ const char* const pv = SvPV_const(slot, len);
+ RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, mouse_xs_simple_predicate);
+}
+OUTPUT:
+ RETVAL
+
MODULE = Mouse::Util::TypeConstraints PACKAGE = Mouse::Util::TypeConstraints
-PROTOTYPES: DISABLE
+PROTOTYPES: DISABLE
+VERSIONCHECK: DISABLE
BOOT:
{
--- /dev/null
+#include "mouse.h"
+
+#define ISA_CACHE "::LINEALIZED_ISA_CACHE::"
+
+#ifdef no_mro_get_linear_isa
+AV*
+mouse_mro_get_linear_isa(pTHX_ HV* const stash){
+ GV* const cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE);
+ AV* isa;
+ SV* gen;
+ CV* get_linear_isa;
+
+ if(!isGV(cachegv))
+ gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, TRUE);
+
+ isa = GvAVn(cachegv);
+ gen = GvSVn(cachegv);
+
+
+ if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){
+ return isa; /* returns the cache if available */
+ }
+ else{
+ SvREADONLY_off(isa);
+ av_clear(isa);
+ }
+
+ get_linear_isa = get_cv("Mouse::Util::get_linear_isa", TRUE);
+
+ {
+ SV* avref;
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ mXPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash));
+ PUTBACK;
+
+ call_sv((SV*)get_linear_isa, G_SCALAR);
+
+ SPAGAIN;
+ avref = POPs;
+ PUTBACK;
+
+ if(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV){
+ AV* const av = (AV*)SvRV(avref);
+ I32 const len = AvFILLp(av) + 1;
+ I32 i;
+
+ for(i = 0; i < len; i++){
+ HV* const stash = gv_stashsv(AvARRAY(av)[i], FALSE);
+ if(stash)
+ av_push(isa, newSVpv(HvNAME(stash), 0));
+ }
+ SvREADONLY_on(isa);
+ }
+ else{
+ Perl_croak(aTHX_ "Mouse:Util::get_linear_isa() didn't return an ARRAY reference");
+ }
+
+ FREETMPS;
+ LEAVE;
+ }
+
+ sv_setiv(gen, (IV)mro_get_pkg_gen(stash));
+ return GvAV(cachegv);
+}
+#endif /* !no_mor_get_linear_isa */
+
+#ifdef DEBUGGING
+SV**
+mouse_av_at_safe(pTHX_ AV* const av, I32 const ix){
+ assert(av);
+ assert(SvTYPE(av) == SVt_PVAV);
+ assert(AvMAX(av) >= ix);
+ return &AvARRAY(av)[ix];
+}
+#endif
+
+void
+mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const char* const fmt, ...){
+ dTHX;
+ va_list args;
+ SV* message;
+
+ PERL_UNUSED_ARG(data); /* for moose-compat */
+
+ assert(metaobject);
+ assert(fmt);
+
+ va_start(args, fmt);
+ message = vnewSVpvf(fmt, &args);
+ va_end(args);
+
+ {
+ dSP;
+ PUSHMARK(SP);
+ EXTEND(SP, 4);
+
+ PUSHs(metaobject);
+ mPUSHs(message);
+
+ mPUSHs(newSVpvs("depth"));
+ mPUSHi(-1);
+
+ PUTBACK;
+
+ call_method("throw_error", G_VOID);
+ croak("throw_error() did not throw the error (%"SVf")", message);
+ }
+}
+
+
+/* equivalent to "blessed($x) && $x->isa($klass)" */
+bool
+mouse_is_instance_of(pTHX_ SV* const sv, SV* const klass){
+ assert(sv);
+ assert(klass);
+
+ if(IsObject(sv) && SvOK(klass)){
+ bool ok;
+
+ ENTER;
+ SAVETMPS;
+
+ ok = SvTRUEx(mcall1s(sv, "isa", klass));
+
+ FREETMPS;
+ LEAVE;
+
+ return ok;
+ }
+
+ return FALSE;
+}
+
+
+bool
+mouse_is_class_loaded(pTHX_ SV * const klass){
+ HV *stash;
+ GV** gvp;
+ HE* he;
+
+ if (!(SvPOKp(klass) && SvCUR(klass))) { /* XXX: SvPOK does not work with magical scalars */
+ return FALSE;
+ }
+
+ stash = gv_stashsv(klass, FALSE);
+ if (!stash) {
+ return FALSE;
+ }
+
+ if (( gvp = (GV**)hv_fetchs(stash, "VERSION", FALSE) )) {
+ if(isGV(*gvp) && GvSV(*gvp) && SvOK(GvSV(*gvp))){
+ return TRUE;
+ }
+ }
+
+ if (( gvp = (GV**)hv_fetchs(stash, "ISA", FALSE) )) {
+ if(isGV(*gvp) && GvAV(*gvp) && av_len(GvAV(*gvp)) != -1){
+ return TRUE;
+ }
+ }
+
+ hv_iterinit(stash);
+ while(( he = hv_iternext(stash) )){
+ GV* const gv = (GV*)HeVAL(he);
+
+ if(isGV(gv)){
+ if(GvCVu(gv)){
+ return TRUE;
+ }
+ }
+ else if(SvOK(gv)){
+ return TRUE;
+ }
+ }
+ return FALSE;
+}
+
+
+SV *
+mouse_call0 (pTHX_ SV *const self, SV *const method)
+{
+ dSP;
+ SV *ret;
+
+ PUSHMARK(SP);
+ XPUSHs(self);
+ PUTBACK;
+
+ call_sv(method, G_SCALAR | G_METHOD);
+
+ SPAGAIN;
+ ret = POPs;
+ PUTBACK;
+
+ return ret;
+}
+
+SV *
+mouse_call1 (pTHX_ SV *const self, SV *const method, SV* const arg1)
+{
+ dSP;
+ SV *ret;
+
+ PUSHMARK(SP);
+ EXTEND(SP, 2);
+ PUSHs(self);
+ PUSHs(arg1);
+ PUTBACK;
+
+ call_sv(method, G_SCALAR | G_METHOD);
+
+ SPAGAIN;
+ ret = POPs;
+ PUTBACK;
+
+ 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;
+}
+
+MODULE = Mouse::Util PACKAGE = Mouse::Util
+
+PROTOTYPES: DISABLE
+VERSIONCHECK: DISABLE
+
+bool
+is_class_loaded(SV* sv)
+
+void
+get_code_info(CV* code)
+PREINIT:
+ GV* gv;
+ HV* stash;
+PPCODE:
+ if((gv = CvGV(code)) && isGV(gv) && (stash = GvSTASH(gv))){
+ EXTEND(SP, 2);
+ mPUSHs(newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U));
+ mPUSHs(newSVpvn_share(GvNAME_get(gv), GvNAMELEN_get(gv), 0U));
+ }
+
+SV*
+get_code_package(CV* code)
+PREINIT:
+ HV* stash;
+CODE:
+ if(CvGV(code) && isGV(CvGV(code)) && (stash = GvSTASH(CvGV(code)))){
+ RETVAL = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
+ }
+ else{
+ RETVAL = &PL_sv_no;
+ }
+OUTPUT:
+ RETVAL
+
+CV*
+get_code_ref(SV* package, SV* name)
+CODE:
+{
+ HV* stash;
+ HE* he;
+
+ if(!SvOK(package)){
+ croak("You must define a package name");
+ }
+ if(!SvOK(name)){
+ croak("You must define a subroutine name");
+ }
+
+ stash = gv_stashsv(package, FALSE);
+ if(!stash){
+ XSRETURN_UNDEF;
+ }
+ he = hv_fetch_ent(stash, name, FALSE, 0U);
+ if(he){
+ GV* const gv = (GV*)hv_iterval(stash, he);
+ if(!isGV(gv)){ /* special constant or stub */
+ STRLEN len;
+ const char* const pv = SvPV_const(name, len);
+ gv_init(gv, stash, pv, len, GV_ADDMULTI);
+ }
+ RETVAL = GvCVu(gv);
+ }
+ else{
+ RETVAL = NULL;
+ }
+
+ if(!RETVAL){
+ XSRETURN_UNDEF;
+ }
+}
+OUTPUT:
+ RETVAL
+
+void
+generate_isa_predicate_for(SV* klass, const char* predicate_name = NULL)
+PPCODE:
+{
+ STRLEN klass_len;
+ const char* klass_pv;
+ HV* stash;
+ CV* xsub;
+
+ if(!SvOK(klass)){
+ croak("You must define a class name for generate_for");
+ }
+ klass_pv = SvPV_const(klass, klass_len);
+ klass_pv = mouse_canonicalize_package_name(klass_pv);
+
+ if(strNE(klass_pv, "UNIVERSAL")){
+ static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */
+
+ xsub = newXS(predicate_name, XS_isa_check, __FILE__);
+
+ stash = gv_stashpvn(klass_pv, klass_len, GV_ADD);
+
+ CvXSUBANY(xsub).any_ptr = sv_magicext(
+ (SV*)xsub,
+ (SV*)stash, /* mg_obj */
+ PERL_MAGIC_ext,
+ &mouse_util_type_constraints_vtbl,
+ klass_pv, /* mg_ptr */
+ klass_len /* mg_len */
+ );
+ }
+ else{
+ xsub = newXS(predicate_name, XS_isa_check_for_universal, __FILE__);
+ }
+
+ if(predicate_name == NULL){ /* anonymous predicate */
+ XPUSHs( newRV_noinc((SV*)xsub) );
+ }
+}
+++ /dev/null
-#include "mouse.h"
-
-/* Moose XS Attribute object */
-enum mouse_xa_ix_t{
- MOUSE_XA_ATTRIBUTE,
- MOUSE_XA_TC,
- MOUSE_XA_TC_CODE,
-
- MOUSE_XA_last
-};
-
-#define MOUSE_xa_attribute(m) MOUSE_av_at(m, MOUSE_XA_ATTRIBUTE)
-#define MOUSE_xa_tc(m) MOUSE_av_at(m, MOUSE_XA_TC)
-#define MOUSE_xa_tc_code(m) MOUSE_av_at(m, MOUSE_XA_TC_CODE)
-
-#define MOUSE_mg_attribute(mg) MOUSE_xa_attribute(MOUSE_mg_xa(mg))
-
-enum mouse_xa_flags_t{
- MOUSEf_ATTR_HAS_TC = 0x0001,
- MOUSEf_ATTR_HAS_DEFAULT = 0x0002,
- MOUSEf_ATTR_HAS_BUILDER = 0x0004,
- MOUSEf_ATTR_HAS_INITIALIZER = 0x0008, /* not used in Mouse */
- MOUSEf_ATTR_HAS_TRIGGER = 0x0010,
-
- MOUSEf_ATTR_IS_LAZY = 0x0020,
- MOUSEf_ATTR_IS_WEAK_REF = 0x0040,
- MOUSEf_ATTR_IS_REQUIRED = 0x0080,
-
- MOUSEf_ATTR_SHOULD_COERCE = 0x0100,
-
- MOUSEf_ATTR_SHOULD_AUTO_DEREF
- = 0x0200,
- MOUSEf_TC_IS_ARRAYREF = 0x0400,
- MOUSEf_TC_IS_HASHREF = 0x0800,
-
- MOUSEf_OTHER1 = 0x1000,
- MOUSEf_OTHER2 = 0x2000,
- MOUSEf_OTHER3 = 0x4000,
- MOUSEf_OTHER4 = 0x8000,
-
- MOUSEf_MOUSE_MASK = 0xFFFF /* not used */
-};
-
-static MGVTBL mouse_accessor_vtbl; /* MAGIC identity */
-
-CV*
-mouse_instantiate_xs_accessor(pTHX_ SV* const attr, XSUBADDR_t const accessor_impl){
- SV* const slot = mcall0(attr, mouse_name);
- AV* const xa = newAV();
- CV* xsub;
- MAGIC* mg;
- U16 flags = 0;
-
- sv_2mortal((SV*)xa);
-
- xsub = newXS(NULL, accessor_impl, __FILE__);
- sv_2mortal((SV*)xsub);
-
- mg = sv_magicext((SV*)xsub, slot, PERL_MAGIC_ext, &mouse_accessor_vtbl, (char*)xa, HEf_SVKEY);
-
- /* NOTE:
- * although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx)
- */
- CvXSUBANY(xsub).any_ptr = (void*)mg;
-
- av_extend(xa, MOUSE_XA_last - 1);
-
- av_store(xa, MOUSE_XA_ATTRIBUTE, newSVsv(attr));
-
- /* prepare attribute status */
- /* XXX: making it lazy is a good way? */
-
- if(SvTRUEx(mcall0s(attr, "has_type_constraint"))){
- SV* tc;
- flags |= MOUSEf_ATTR_HAS_TC;
-
- ENTER;
- SAVETMPS;
-
- tc = mcall0s(attr, "type_constraint");
- av_store(xa, MOUSE_XA_TC, newSVsv(tc));
-
- if(SvTRUEx(mcall0s(attr, "should_auto_deref"))){
- flags |= MOUSEf_ATTR_SHOULD_AUTO_DEREF;
- if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("ArrayRef", SVs_TEMP))) ){
- flags |= MOUSEf_TC_IS_ARRAYREF;
- }
- else if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("HashRef", SVs_TEMP))) ){
- flags |= MOUSEf_TC_IS_HASHREF;
- }
- else{
- mouse_throw_error(attr, tc,
- "Can not auto de-reference the type constraint '%"SVf"'",
- mcall0(tc, mouse_name));
- }
- }
-
- if(SvTRUEx(mcall0s(attr, "should_coerce"))){
- flags |= MOUSEf_ATTR_SHOULD_COERCE;
- }
-
- FREETMPS;
- LEAVE;
- }
-
- if(SvTRUEx(mcall0s(attr, "has_trigger"))){
- flags |= MOUSEf_ATTR_HAS_TRIGGER;
- }
-
- if(SvTRUEx(mcall0s(attr, "is_lazy"))){
- flags |= MOUSEf_ATTR_IS_LAZY;
-
- if(SvTRUEx(mcall0s(attr, "has_builder"))){
- flags |= MOUSEf_ATTR_HAS_BUILDER;
- }
- else if(SvTRUEx(mcall0s(attr, "has_default"))){
- flags |= MOUSEf_ATTR_HAS_DEFAULT;
- }
- }
-
- if(SvTRUEx(mcall0s(attr, "is_weak_ref"))){
- flags |= MOUSEf_ATTR_IS_WEAK_REF;
- }
-
- if(SvTRUEx(mcall0s(attr, "is_required"))){
- flags |= MOUSEf_ATTR_IS_REQUIRED;
- }
-
- MOUSE_mg_flags(mg) = flags;
-
- return xsub;
-}
-
-static SV*
-mouse_apply_type_constraint(pTHX_ AV* const xa, SV* value, U16 const flags){
- SV* const tc = MOUSE_xa_tc(xa);
- SV* tc_code;
-
- if(flags & MOUSEf_ATTR_SHOULD_COERCE){
- value = mcall1s(tc, "coerce", value);
- }
-
- if(!SvOK(MOUSE_xa_tc_code(xa))){
- XS(XS_Mouse__Util__TypeConstraints_Item); /* prototype defined in Mouse.xs */
-
- tc_code = mcall0s(tc, "_compiled_type_constraint");
-
- if(SvROK(tc_code) && SvTYPE(SvRV(tc_code))
- && CvXSUB((CV*)SvRV(tc_code)) == XS_Mouse__Util__TypeConstraints_Item){
- /* built-in type constraints */
- mouse_tc const id = CvXSUBANY((CV*)SvRV(tc_code)).any_i32;
- av_store(xa, MOUSE_XA_TC_CODE, newSViv(id));
- }
- else{
- av_store(xa, MOUSE_XA_TC_CODE, newSVsv(tc_code));
- }
- }
- else{
- tc_code = MOUSE_xa_tc_code(xa);
- }
-
- if(!mouse_tc_check(aTHX_ tc_code, value)){
- mouse_throw_error(MOUSE_xa_attribute(xa), value,
- "Attribute (%"SVf") does not pass the type constraint because: %"SVf,
- mcall0(MOUSE_xa_attribute(xa), mouse_name),
- mcall1s(tc, "get_message", value));
- }
-
- return value;
-}
-
-
-/* pushes return values, does auto-deref if needed */
-static void
-mouse_push_values(pTHX_ SV* const value, U16 const flags){
- dSP;
-
- if(flags & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY){
- if(!(value && SvOK(value))){
- return;
- }
-
- if(flags & MOUSEf_TC_IS_ARRAYREF){
- AV* const av = (AV*)SvRV(value);
- I32 len;
- I32 i;
-
- if(SvTYPE(av) != SVt_PVAV){
- croak("Mouse-panic: Not an ARRAY reference");
- }
-
- len = av_len(av) + 1;
- EXTEND(SP, len);
- for(i = 0; i < len; i++){
- SV** const svp = av_fetch(av, i, FALSE);
- PUSHs(svp ? *svp : &PL_sv_undef);
- }
- }
- else if(flags & MOUSEf_TC_IS_HASHREF){
- HV* const hv = (HV*)SvRV(value);
- HE* he;
-
- if(SvTYPE(hv) != SVt_PVHV){
- croak("Mouse-panic: Not a HASH reference");
- }
-
- hv_iterinit(hv);
- while((he = hv_iternext(hv))){
- EXTEND(SP, 2);
- PUSHs(hv_iterkeysv(he));
- PUSHs(hv_iterval(hv, he));
- }
- }
- }
- else{
- XPUSHs(value ? value : &PL_sv_undef);
- }
-
- PUTBACK;
-}
-
-static void
-mouse_attr_get(pTHX_ SV* const self, MAGIC* const mg){
- U16 const flags = MOUSE_mg_flags(mg);
- SV* const slot = MOUSE_mg_slot(mg);
- SV* value;
-
- value = mouse_instance_get_slot(aTHX_ self, slot);
-
- /* check_lazy */
- if( !value && flags & MOUSEf_ATTR_IS_LAZY ){
- AV* const xa = MOUSE_mg_xa(mg);
- SV* const attr = MOUSE_xa_attribute(xa);
-
- /* get default value by $attr->default or $attr->builder */
- if(flags & MOUSEf_ATTR_HAS_DEFAULT){
- value = mcall0s(attr, "default");
-
- if(SvROK(value) && SvTYPE(SvRV(value)) == SVt_PVCV){
- value = mcall0(self, value);
- }
- }
- else if(flags & MOUSEf_ATTR_HAS_BUILDER){
- SV* const builder = mcall0s(attr, "builder");
- value = mcall0(self, builder);
- }
-
- if(!value){
- value = sv_newmortal();
- }
-
- /* apply coerce and type constraint */
- if(flags & MOUSEf_ATTR_HAS_TC){
- value = mouse_apply_type_constraint(aTHX_ xa, value, flags);
- }
-
- /* store value to slot */
- value = mouse_instance_set_slot(aTHX_ self, slot, value);
- }
-
- mouse_push_values(aTHX_ value, flags);
-}
-
-static void
-mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){
- U16 const flags = MOUSE_mg_flags(mg);
- SV* const slot = MOUSE_mg_slot(mg);
-
- if(flags & MOUSEf_ATTR_HAS_TC){
- value = mouse_apply_type_constraint(aTHX_ MOUSE_mg_xa(mg), value, flags);
- }
-
- mouse_instance_set_slot(aTHX_ self, slot, value);
-
- if(flags & MOUSEf_ATTR_IS_WEAK_REF){
- mouse_instance_weaken_slot(aTHX_ self, slot);
- }
-
- if(flags & MOUSEf_ATTR_HAS_TRIGGER){
- SV* const trigger = mcall0s(MOUSE_mg_attribute(mg), "trigger");
- dSP;
-
- PUSHMARK(SP);
- EXTEND(SP, 2);
- PUSHs(self);
- PUSHs(value);
-
- PUTBACK;
- call_sv(trigger, G_VOID | G_DISCARD);
- /* need not SPAGAIN */
- }
-
- mouse_push_values(aTHX_ value, flags);
-}
-
-XS(mouse_xs_accessor)
-{
- dVAR; dXSARGS;
- dMOUSE_self;
- MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
-
- SP -= items; /* PPCODE */
- PUTBACK;
-
- if(items == 1){ /* reader */
- mouse_attr_get(aTHX_ self, mg);
- }
- else if (items == 2){ /* writer */
- mouse_attr_set(aTHX_ self, mg, ST(1));
- }
- else{
- mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
- "Expected exactly one or two argument for an accessor");
- }
-}
-
-
-XS(mouse_xs_reader)
-{
- dVAR; dXSARGS;
- dMOUSE_self;
- MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
-
- if (items != 1) {
- mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
- "Cannot assign a value to a read-only accessor");
- }
-
- SP -= items; /* PPCODE */
- PUTBACK;
-
- mouse_attr_get(aTHX_ self, mg);
-}
-
-XS(mouse_xs_writer)
-{
- dVAR; dXSARGS;
- dMOUSE_self;
- MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
-
- if (items != 2) {
- mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
- "Too few arguments for a write-only accessor");
- }
-
- SP -= items; /* PPCODE */
- PUTBACK;
-
- mouse_attr_set(aTHX_ self, mg, ST(1));
-}
+++ /dev/null
-#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
+++ /dev/null
-#include "mouse.h"
-
-static MGVTBL mouse_simple_accessor_vtbl;
-
-/*
-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);
-}
-*/
-
-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 mg to CvXSUBANY for efficiency (gfx)
- */
- CvXSUBANY(xsub).any_ptr = (void*)mg;
-
- return xsub;
-}
-
-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;
-}
-
-
-XS(mouse_xs_simple_reader)
-{
- dVAR; dXSARGS;
- dMOUSE_self;
- SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
- SV* value;
-
- if (items != 1) {
- croak("Expected exactly one argument for a reader for '%"SVf"'", slot);
- }
-
- value = mouse_instance_get_slot(aTHX_ self, slot);
- ST(0) = value ? value : &PL_sv_undef;
- XSRETURN(1);
-}
-
-
-XS(mouse_xs_simple_writer)
-{
- dVAR; dXSARGS;
- dMOUSE_self;
- SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
-
- if (items != 2) {
- croak("Expected exactly two argument for a writer for '%"SVf"'", slot);
- }
-
- ST(0) = mouse_instance_set_slot(aTHX_ self, slot, ST(1));
- XSRETURN(1);
-}
-
-XS(mouse_xs_simple_clearer)
-{
- dVAR; dXSARGS;
- dMOUSE_self;
- SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
- SV* value;
-
- if (items != 1) {
- croak("Expected exactly one argument for a clearer for '%"SVf"'", slot);
- }
-
- value = mouse_instance_delete_slot(aTHX_ self, slot);
- ST(0) = value ? value : &PL_sv_undef;
- XSRETURN(1);
-}
-
-XS(mouse_xs_simple_predicate)
-{
- dVAR; dXSARGS;
- dMOUSE_self;
- SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
-
- if (items != 1) {
- croak("Expected exactly one argument for a predicate for '%"SVf"'", slot);
- }
-
- ST(0) = boolSV( mouse_instance_has_slot(aTHX_ self, slot) );
- XSRETURN(1);
-}
+++ /dev/null
-#include "mouse.h"
-
-#define ISA_CACHE "::LINEALIZED_ISA_CACHE::"
-
-#ifdef no_mro_get_linear_isa
-AV*
-mouse_mro_get_linear_isa(pTHX_ HV* const stash){
- GV* const cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE);
- AV* isa;
- SV* gen;
- CV* get_linear_isa;
-
- if(!isGV(cachegv))
- gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, TRUE);
-
- isa = GvAVn(cachegv);
- gen = GvSVn(cachegv);
-
-
- if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){
- return isa; /* returns the cache if available */
- }
- else{
- SvREADONLY_off(isa);
- av_clear(isa);
- }
-
- get_linear_isa = get_cv("Mouse::Util::get_linear_isa", TRUE);
-
- {
- SV* avref;
- dSP;
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- mXPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash));
- PUTBACK;
-
- call_sv((SV*)get_linear_isa, G_SCALAR);
-
- SPAGAIN;
- avref = POPs;
- PUTBACK;
-
- if(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV){
- AV* const av = (AV*)SvRV(avref);
- I32 const len = AvFILLp(av) + 1;
- I32 i;
-
- for(i = 0; i < len; i++){
- HV* const stash = gv_stashsv(AvARRAY(av)[i], FALSE);
- if(stash)
- av_push(isa, newSVpv(HvNAME(stash), 0));
- }
- SvREADONLY_on(isa);
- }
- else{
- Perl_croak(aTHX_ "Mouse:Util::get_linear_isa() didn't return an ARRAY reference");
- }
-
- FREETMPS;
- LEAVE;
- }
-
- sv_setiv(gen, (IV)mro_get_pkg_gen(stash));
- return GvAV(cachegv);
-}
-#endif /* !no_mor_get_linear_isa */
-
-#ifdef DEBUGGING
-SV**
-mouse_av_at_safe(pTHX_ AV* const av, I32 const ix){
- assert(av);
- assert(SvTYPE(av) == SVt_PVAV);
- assert(AvMAX(av) >= ix);
- return &AvARRAY(av)[ix];
-}
-#endif
-
-void
-mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const char* const fmt, ...){
- dTHX;
- va_list args;
- SV* message;
-
- PERL_UNUSED_ARG(data); /* for moose-compat */
-
- assert(metaobject);
- assert(fmt);
-
- va_start(args, fmt);
- message = vnewSVpvf(fmt, &args);
- va_end(args);
-
- {
- dSP;
- PUSHMARK(SP);
- EXTEND(SP, 4);
-
- PUSHs(metaobject);
- mPUSHs(message);
-
- mPUSHs(newSVpvs("depth"));
- mPUSHi(-1);
-
- PUTBACK;
-
- call_method("throw_error", G_VOID);
- croak("throw_error() did not throw the error (%"SVf")", message);
- }
-}
-
-
-/* equivalent to "blessed($x) && $x->isa($klass)" */
-bool
-mouse_is_instance_of(pTHX_ SV* const sv, SV* const klass){
- assert(sv);
- assert(klass);
-
- if(IsObject(sv) && SvOK(klass)){
- bool ok;
-
- ENTER;
- SAVETMPS;
-
- ok = SvTRUEx(mcall1s(sv, "isa", klass));
-
- FREETMPS;
- LEAVE;
-
- return ok;
- }
-
- return FALSE;
-}
-
-
-bool
-mouse_is_class_loaded(pTHX_ SV * const klass){
- HV *stash;
- GV** gvp;
- HE* he;
-
- if (!(SvPOKp(klass) && SvCUR(klass))) { /* XXX: SvPOK does not work with magical scalars */
- return FALSE;
- }
-
- stash = gv_stashsv(klass, FALSE);
- if (!stash) {
- return FALSE;
- }
-
- if (( gvp = (GV**)hv_fetchs(stash, "VERSION", FALSE) )) {
- if(isGV(*gvp) && GvSV(*gvp) && SvOK(GvSV(*gvp))){
- return TRUE;
- }
- }
-
- if (( gvp = (GV**)hv_fetchs(stash, "ISA", FALSE) )) {
- if(isGV(*gvp) && GvAV(*gvp) && av_len(GvAV(*gvp)) != -1){
- return TRUE;
- }
- }
-
- hv_iterinit(stash);
- while(( he = hv_iternext(stash) )){
- GV* const gv = (GV*)HeVAL(he);
-
- if(isGV(gv)){
- if(GvCVu(gv)){
- return TRUE;
- }
- }
- else if(SvOK(gv)){
- return TRUE;
- }
- }
- return FALSE;
-}
-
-
-SV *
-mouse_call0 (pTHX_ SV *const self, SV *const method)
-{
- dSP;
- SV *ret;
-
- PUSHMARK(SP);
- XPUSHs(self);
- PUTBACK;
-
- call_sv(method, G_SCALAR | G_METHOD);
-
- SPAGAIN;
- ret = POPs;
- PUTBACK;
-
- return ret;
-}
-
-SV *
-mouse_call1 (pTHX_ SV *const self, SV *const method, SV* const arg1)
-{
- dSP;
- SV *ret;
-
- PUSHMARK(SP);
- EXTEND(SP, 2);
- PUSHs(self);
- PUSHs(arg1);
- PUTBACK;
-
- call_sv(method, G_SCALAR | G_METHOD);
-
- SPAGAIN;
- ret = POPs;
- PUTBACK;
-
- 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;
-}
projects / gitmo/Mouse.git / commitdiff