#include "mouse.h"
+#define MY_CXT_KEY "Mouse::Util::_guts" XS_VERSION
+typedef struct {
+ HV* metas;
+} my_cxt_t;
+START_MY_CXT
+
#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);
+ 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{
+ SvREFCNT_dec(isa);
+ GvAV(cachegv) = isa = newAV();
+ }
+
+ 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(IsArrayRef(avref)){
+ 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 isa;
}
#endif /* !no_mor_get_linear_isa */
}
}
-
-/* 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;
}
-SV *
-mouse_call0 (pTHX_ SV *const self, SV *const method)
-{
+SV*
+mouse_call0 (pTHX_ SV* const self, SV* const method) {
dSP;
SV *ret;
return ret;
}
-SV *
-mouse_call1 (pTHX_ SV *const self, SV *const method, SV* const arg1)
-{
+SV*
+mouse_call1 (pTHX_ SV* const self, SV* const method, SV* const arg1) {
dSP;
SV *ret;
return ret;
}
+int
+mouse_predicate_call(pTHX_ SV* const self, SV* const method) {
+ SV* const value = mcall0(self, method);
+ return SvTRUE(value);
+}
+
+SV*
+mouse_get_metaclass(pTHX_ SV* metaclass_name){
+ dMY_CXT;
+ HE* he;
+
+ assert(metaclass_name);
+ assert(MY_CXT.metas);
+
+ if(IsObject(metaclass_name)){
+ HV* const stash = SvSTASH(SvRV(metaclass_name));
+
+ metaclass_name = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
+ sv_2mortal(metaclass_name);
+ }
+
+ he = hv_fetch_ent(MY_CXT.metas, metaclass_name, FALSE, 0U);
+
+ return he ? HeVAL(he) : &PL_sv_undef;
+}
+
MAGIC*
mouse_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl, I32 const flags){
MAGIC* mg;
return NULL;
}
+GV*
+mouse_stash_fetch(pTHX_ HV* const stash, const char* const name, I32 const namelen, I32 const create) {
+ GV** const gvp = (GV**)hv_fetch(stash, name, namelen, create);
+
+ if(gvp){
+ if(!isGV(*gvp)){
+ gv_init(*gvp, stash, name, namelen, GV_ADDMULTI);
+ }
+ return *gvp;
+ }
+ else{
+ return NULL;
+ }
+}
+
MODULE = Mouse::Util PACKAGE = Mouse::Util
PROTOTYPES: DISABLE
VERSIONCHECK: DISABLE
+BOOT:
+{
+ MY_CXT_INIT;
+ MY_CXT.metas = NULL;
+}
+
+void
+__register_metaclass_storage(HV* metas, bool cloning)
+CODE:
+{
+ if(cloning){
+ MY_CXT_CLONE;
+ MY_CXT.metas = NULL;
+ }
+ {
+ dMY_CXT;
+ if(MY_CXT.metas) croak("Cannot set metaclass storage more than once");
+ MY_CXT.metas = metas;
+ SvREFCNT_inc_simple_void_NN(metas);
+ }
+}
+
bool
is_class_loaded(SV* sv)
CODE:
{
HV* stash;
- HE* he;
+ STRLEN name_len;
+ const char* name_pv;
+ GV* gv;
if(!SvOK(package)){
croak("You must define a package name");
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;
- }
+
+ name_pv = SvPV_const(name, name_len);
+ gv = stash_fetch(stash, name_pv, name_len, FALSE);
+ RETVAL = gv ? GvCVu(gv) : NULL;
if(!RETVAL){
XSRETURN_UNDEF;
RETVAL
void
-generate_isa_predicate_for(SV* klass, const char* predicate_name = NULL)
+generate_isa_predicate_for(SV* klass, SV* predicate_name = NULL)
PPCODE:
{
- STRLEN klass_len;
- const char* klass_pv;
- HV* stash;
+ const char* name_pv = NULL;
CV* xsub;
+ SvGETMAGIC(klass);
+
if(!SvOK(klass)){
- croak("You must define a class name for generate_for");
+ croak("You must define a class name");
}
- 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){
+ SvGETMAGIC(predicate_name);
+ if(!SvOK(predicate_name)){
+ croak("You must define a predicate_name");
+ }
+ name_pv = SvPV_nolen_const(predicate_name);
}
+ xsub = mouse_generate_isa_predicate_for(aTHX_ klass, name_pv);
+
if(predicate_name == NULL){ /* anonymous predicate */
XPUSHs( newRV_noinc((SV*)xsub) );
}