From: gfx Date: Sat, 31 Oct 2009 04:26:52 +0000 (+0900) Subject: Re-organize xs-src/ X-Git-Tag: 0.40_04~26 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=646c0371bdfda5817f842c54577c4d5605a4c3c0 Re-organize xs-src/ --- diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs index 137e5a0..8d0f3a8 100644 --- a/xs-src/Mouse.xs +++ b/xs-src/Mouse.xs @@ -5,7 +5,7 @@ SV* mouse_namespace; SV* mouse_methods; SV* mouse_name; -MODULE = Mouse PACKAGE = Mouse::Util +MODULE = Mouse PACKAGE = Mouse PROTOTYPES: DISABLE @@ -15,116 +15,9 @@ BOOT: 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 @@ -290,56 +183,3 @@ BOOT: 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 - diff --git a/xs-src/MouseAccessor.xs b/xs-src/MouseAccessor.xs new file mode 100644 index 0000000..a9de903 --- /dev/null +++ b/xs-src/MouseAccessor.xs @@ -0,0 +1,596 @@ +#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)); + } +} + +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 + diff --git a/xs-src/mouse_type_constraint.xs b/xs-src/MouseTypeConstraints.xs similarity index 99% rename from xs-src/mouse_type_constraint.xs rename to xs-src/MouseTypeConstraints.xs index 729344e..ffae815 100644 --- a/xs-src/mouse_type_constraint.xs +++ b/xs-src/MouseTypeConstraints.xs @@ -402,7 +402,8 @@ setup_my_cxt(pTHX_ pMY_CXT){ MODULE = Mouse::Util::TypeConstraints PACKAGE = Mouse::Util::TypeConstraints -PROTOTYPES: DISABLE +PROTOTYPES: DISABLE +VERSIONCHECK: DISABLE BOOT: { diff --git a/xs-src/MouseUtil.xs b/xs-src/MouseUtil.xs new file mode 100644 index 0000000..0e2ae3b --- /dev/null +++ b/xs-src/MouseUtil.xs @@ -0,0 +1,352 @@ +#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) ); + } +} diff --git a/xs-src/mouse_accessor.xs b/xs-src/mouse_accessor.xs deleted file mode 100644 index 6222f74..0000000 --- a/xs-src/mouse_accessor.xs +++ /dev/null @@ -1,350 +0,0 @@ -#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)); -} diff --git a/xs-src/mouse_instance.xs b/xs-src/mouse_instance.xs deleted file mode 100644 index dd74c1c..0000000 --- a/xs-src/mouse_instance.xs +++ /dev/null @@ -1,76 +0,0 @@ -#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 - -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)); - } -} - diff --git a/xs-src/mouse_simple_accessor.xs b/xs-src/mouse_simple_accessor.xs deleted file mode 100644 index f05d753..0000000 --- a/xs-src/mouse_simple_accessor.xs +++ /dev/null @@ -1,113 +0,0 @@ -#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); -} diff --git a/xs-src/mouse_util.xs b/xs-src/mouse_util.xs deleted file mode 100644 index 94239c8..0000000 --- a/xs-src/mouse_util.xs +++ /dev/null @@ -1,239 +0,0 @@ -#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; -}