[gitmo/Mouse.git] / xs-src / MouseAccessor.xs

#include "mouse.h"

#define CHECK_INSTANCE(instance) STMT_START{                          \
        if(!(SvROK(instance) && SvTYPE(SvRV(instance)) == SVt_PVHV)){ \
            croak("Invalid object instance");                         \
        }                                                             \
    } 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) {
    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.
     */

    return ST(0);
}


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;
}

#define PUSH_VALUE(value, flags) STMT_START { \
        if((flags) & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY){ \
            mouse_push_values(aTHX_ value, (flags));                       \
        }                                                                  \
        else{                                                              \
            dSP;                                                           \
            XPUSHs(value ? value : &PL_sv_undef);                          \
            PUTBACK;                                                       \
        }                                                                  \
    } STMT_END                                                             \

/* pushes return values, does auto-deref if needed */
static void
mouse_push_values(pTHX_ SV* const value, U16 const flags){
    dSP;

    assert( 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));
        }
    }

    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);
    }

    PUSH_VALUE(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 */
    }

    PUSH_VALUE(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 (or Mouse::Meta::Instance) */

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
Commit	Line	Data
646c0371	1	#include "mouse.h"
	2
	3	#define CHECK_INSTANCE(instance) STMT_START{ \
	4	if(!(SvROK(instance) && SvTYPE(SvRV(instance)) == SVt_PVHV)){ \
76770976	5	croak("Invalid object instance"); \
646c0371	6	} \
	7	} STMT_END
	8
	9	/* Moose XS Attribute object */
	10	enum mouse_xa_ix_t{
	11	MOUSE_XA_ATTRIBUTE,
	12	MOUSE_XA_TC,
	13	MOUSE_XA_TC_CODE,
	14
	15	MOUSE_XA_last
	16	};
	17
	18	#define MOUSE_xa_attribute(m) MOUSE_av_at(m, MOUSE_XA_ATTRIBUTE)
	19	#define MOUSE_xa_tc(m) MOUSE_av_at(m, MOUSE_XA_TC)
	20	#define MOUSE_xa_tc_code(m) MOUSE_av_at(m, MOUSE_XA_TC_CODE)
	21
	22	#define MOUSE_mg_attribute(mg) MOUSE_xa_attribute(MOUSE_mg_xa(mg))
	23
	24	enum mouse_xa_flags_t{
	25	MOUSEf_ATTR_HAS_TC = 0x0001,
	26	MOUSEf_ATTR_HAS_DEFAULT = 0x0002,
	27	MOUSEf_ATTR_HAS_BUILDER = 0x0004,
	28	MOUSEf_ATTR_HAS_INITIALIZER = 0x0008, /* not used in Mouse */
	29	MOUSEf_ATTR_HAS_TRIGGER = 0x0010,
	30
	31	MOUSEf_ATTR_IS_LAZY = 0x0020,
	32	MOUSEf_ATTR_IS_WEAK_REF = 0x0040,
	33	MOUSEf_ATTR_IS_REQUIRED = 0x0080,
	34
	35	MOUSEf_ATTR_SHOULD_COERCE = 0x0100,
	36
	37	MOUSEf_ATTR_SHOULD_AUTO_DEREF
	38	= 0x0200,
	39	MOUSEf_TC_IS_ARRAYREF = 0x0400,
	40	MOUSEf_TC_IS_HASHREF = 0x0800,
	41
	42	MOUSEf_OTHER1 = 0x1000,
	43	MOUSEf_OTHER2 = 0x2000,
	44	MOUSEf_OTHER3 = 0x4000,
	45	MOUSEf_OTHER4 = 0x8000,
	46
	47	MOUSEf_MOUSE_MASK = 0xFFFF /* not used */
	48	};
	49
	50	static MGVTBL mouse_accessor_vtbl; /* MAGIC identity */
	51
	52
	53	SV*
	54	mouse_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) {
646c0371	55	if(items < 1){
	56	croak("Too few arguments for %s", GvNAME(CvGV(cv)));
	57	}
	58
	59	/* NOTE: If self has GETMAGIC, $self->accessor will invoke GETMAGIC
	60	* before calling methods, so SvGETMAGIC(self) is not necessarily needed here.
	61	*/
	62
76770976	63	return ST(0);
646c0371	64	}
	65
	66
	67	CV*
	68	mouse_instantiate_xs_accessor(pTHX_ SV* const attr, XSUBADDR_t const accessor_impl){
	69	SV* const slot = mcall0(attr, mouse_name);
	70	AV* const xa = newAV();
	71	CV* xsub;
	72	MAGIC* mg;
	73	U16 flags = 0;
	74
	75	sv_2mortal((SV*)xa);
	76
	77	xsub = newXS(NULL, accessor_impl, __FILE__);
	78	sv_2mortal((SV*)xsub);
	79
	80	mg = sv_magicext((SV)xsub, slot, PERL_MAGIC_ext, &mouse_accessor_vtbl, (char)xa, HEf_SVKEY);
	81
	82	/* NOTE:
	83	* although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx)
	84	*/
	85	CvXSUBANY(xsub).any_ptr = (void*)mg;
	86
	87	av_extend(xa, MOUSE_XA_last - 1);
	88
	89	av_store(xa, MOUSE_XA_ATTRIBUTE, newSVsv(attr));
	90
	91	/* prepare attribute status */
	92	/* XXX: making it lazy is a good way? */
	93
	94	if(SvTRUEx(mcall0s(attr, "has_type_constraint"))){
	95	SV* tc;
	96	flags \|= MOUSEf_ATTR_HAS_TC;
	97
	98	ENTER;
	99	SAVETMPS;
	100
	101	tc = mcall0s(attr, "type_constraint");
	102	av_store(xa, MOUSE_XA_TC, newSVsv(tc));
	103
	104	if(SvTRUEx(mcall0s(attr, "should_auto_deref"))){
	105	flags \|= MOUSEf_ATTR_SHOULD_AUTO_DEREF;
	106	if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("ArrayRef", SVs_TEMP))) ){
	107	flags \|= MOUSEf_TC_IS_ARRAYREF;
	108	}
	109	else if( SvTRUEx(mcall1s(tc, "is_a_type_of", newSVpvs_flags("HashRef", SVs_TEMP))) ){
	110	flags \|= MOUSEf_TC_IS_HASHREF;
	111	}
	112	else{
	113	mouse_throw_error(attr, tc,
	114	"Can not auto de-reference the type constraint '%"SVf"'",
	115	mcall0(tc, mouse_name));
	116	}
	117	}
	118
	119	if(SvTRUEx(mcall0s(attr, "should_coerce"))){
	120	flags \|= MOUSEf_ATTR_SHOULD_COERCE;
	121	}
	122
	123	FREETMPS;
	124	LEAVE;
	125	}
	126
	127	if(SvTRUEx(mcall0s(attr, "has_trigger"))){
128	flags \|= MOUSEf_ATTR_HAS_TRIGGER;
129	}
130
131	if(SvTRUEx(mcall0s(attr, "is_lazy"))){
132	flags \|= MOUSEf_ATTR_IS_LAZY;
133
134	if(SvTRUEx(mcall0s(attr, "has_builder"))){
135	flags \|= MOUSEf_ATTR_HAS_BUILDER;
136	}
137	else if(SvTRUEx(mcall0s(attr, "has_default"))){
138	flags \|= MOUSEf_ATTR_HAS_DEFAULT;
139	}
140	}
141
142	if(SvTRUEx(mcall0s(attr, "is_weak_ref"))){
143	flags \|= MOUSEf_ATTR_IS_WEAK_REF;
144	}
145
146	if(SvTRUEx(mcall0s(attr, "is_required"))){
147	flags \|= MOUSEf_ATTR_IS_REQUIRED;
148	}
149
150	MOUSE_mg_flags(mg) = flags;
151
152	return xsub;
153	}
154
155	static SV*
156	mouse_apply_type_constraint(pTHX_ AV* const xa, SV* value, U16 const flags){
157	SV* const tc = MOUSE_xa_tc(xa);
158	SV* tc_code;
159
160	if(flags & MOUSEf_ATTR_SHOULD_COERCE){
161	value = mcall1s(tc, "coerce", value);
162	}
163
164	if(!SvOK(MOUSE_xa_tc_code(xa))){
165	XS(XS_Mouse__Util__TypeConstraints_Item); /* prototype defined in Mouse.xs */
166
167	tc_code = mcall0s(tc, "_compiled_type_constraint");
168
169	if(SvROK(tc_code) && SvTYPE(SvRV(tc_code))
170	&& CvXSUB((CV*)SvRV(tc_code)) == XS_Mouse__Util__TypeConstraints_Item){
171	/* built-in type constraints */
172	mouse_tc const id = CvXSUBANY((CV*)SvRV(tc_code)).any_i32;
173	av_store(xa, MOUSE_XA_TC_CODE, newSViv(id));
174	}
175	else{
176	av_store(xa, MOUSE_XA_TC_CODE, newSVsv(tc_code));
177	}
178	}
179	else{
180	tc_code = MOUSE_xa_tc_code(xa);
181	}
182
183	if(!mouse_tc_check(aTHX_ tc_code, value)){
184	mouse_throw_error(MOUSE_xa_attribute(xa), value,
185	"Attribute (%"SVf") does not pass the type constraint because: %"SVf,
186	mcall0(MOUSE_xa_attribute(xa), mouse_name),
187	mcall1s(tc, "get_message", value));
188	}
189
190	return value;
191	}
192
208ffaeb	193	#define PUSH_VALUE(value, flags) STMT_START { \
	194	if((flags) & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY){ \
	195	mouse_push_values(aTHX_ value, (flags)); \
	196	} \
	197	else{ \
	198	dSP; \
	199	XPUSHs(value ? value : &PL_sv_undef); \
	200	PUTBACK; \
	201	} \
	202	} STMT_END \
646c0371	203
	204	/* pushes return values, does auto-deref if needed */
	205	static void
	206	mouse_push_values(pTHX_ SV* const value, U16 const flags){
	207	dSP;
	208
208ffaeb	209	assert( flags & MOUSEf_ATTR_SHOULD_AUTO_DEREF && GIMME_V == G_ARRAY );
646c0371	210
208ffaeb	211	if(!(value && SvOK(value))){
	212	return;
	213	}
646c0371	214
208ffaeb	215	if(flags & MOUSEf_TC_IS_ARRAYREF){
	216	AV* const av = (AV*)SvRV(value);
	217	I32 len;
	218	I32 i;
646c0371	219
208ffaeb	220	if(SvTYPE(av) != SVt_PVAV){
208ffaeb	221	croak("Mouse-panic: Not an ARRAY reference");
646c0371	222	}
646c0371	223
208ffaeb	224	len = av_len(av) + 1;
	225	EXTEND(SP, len);
	226	for(i = 0; i < len; i++){
	227	SV** const svp = av_fetch(av, i, FALSE);
	228	PUSHs(svp ? *svp : &PL_sv_undef);
646c0371	229	}
646c0371	230	}
208ffaeb	231	else if(flags & MOUSEf_TC_IS_HASHREF){
	232	HV* const hv = (HV*)SvRV(value);
	233	HE* he;
	234
	235	if(SvTYPE(hv) != SVt_PVHV){
	236	croak("Mouse-panic: Not a HASH reference");
	237	}
	238
	239	hv_iterinit(hv);
	240	while((he = hv_iternext(hv))){
	241	EXTEND(SP, 2);
	242	PUSHs(hv_iterkeysv(he));
	243	PUSHs(hv_iterval(hv, he));
	244	}
646c0371	245	}
	246
	247	PUTBACK;
	248	}
	249
	250	static void
	251	mouse_attr_get(pTHX_ SV* const self, MAGIC* const mg){
	252	U16 const flags = MOUSE_mg_flags(mg);
	253	SV* const slot = MOUSE_mg_slot(mg);
	254	SV* value;
	255
	256	value = mouse_instance_get_slot(aTHX_ self, slot);
	257
	258	/* check_lazy */
	259	if( !value && flags & MOUSEf_ATTR_IS_LAZY ){
	260	AV* const xa = MOUSE_mg_xa(mg);
	261	SV* const attr = MOUSE_xa_attribute(xa);
	262
	263	/* get default value by $attr->default or $attr->builder */
	264	if(flags & MOUSEf_ATTR_HAS_DEFAULT){
	265	value = mcall0s(attr, "default");
	266
	267	if(SvROK(value) && SvTYPE(SvRV(value)) == SVt_PVCV){
	268	value = mcall0(self, value);
	269	}
	270	}
	271	else if(flags & MOUSEf_ATTR_HAS_BUILDER){
	272	SV* const builder = mcall0s(attr, "builder");
	273	value = mcall0(self, builder);
	274	}
	275
	276	if(!value){
	277	value = sv_newmortal();
	278	}
	279
	280	/* apply coerce and type constraint */
	281	if(flags & MOUSEf_ATTR_HAS_TC){
	282	value = mouse_apply_type_constraint(aTHX_ xa, value, flags);
	283	}
	284
	285	/* store value to slot */
	286	value = mouse_instance_set_slot(aTHX_ self, slot, value);
	287	}
	288
208ffaeb	289	PUSH_VALUE(value, flags);
646c0371	290	}
	291
	292	static void
	293	mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){
	294	U16 const flags = MOUSE_mg_flags(mg);
	295	SV* const slot = MOUSE_mg_slot(mg);
	296
	297	if(flags & MOUSEf_ATTR_HAS_TC){
	298	value = mouse_apply_type_constraint(aTHX_ MOUSE_mg_xa(mg), value, flags);
	299	}
	300
	301	mouse_instance_set_slot(aTHX_ self, slot, value);
	302
	303	if(flags & MOUSEf_ATTR_IS_WEAK_REF){
	304	mouse_instance_weaken_slot(aTHX_ self, slot);
	305	}
	306
	307	if(flags & MOUSEf_ATTR_HAS_TRIGGER){
	308	SV* const trigger = mcall0s(MOUSE_mg_attribute(mg), "trigger");
	309	dSP;
	310
	311	PUSHMARK(SP);
	312	EXTEND(SP, 2);
	313	PUSHs(self);
	314	PUSHs(value);
	315
	316	PUTBACK;
	317	call_sv(trigger, G_VOID \| G_DISCARD);
	318	/* need not SPAGAIN */
	319	}
	320
208ffaeb	321	PUSH_VALUE(value, flags);
646c0371	322	}
	323
	324	XS(mouse_xs_accessor)
	325	{
	326	dVAR; dXSARGS;
	327	dMOUSE_self;
	328	MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
	329
	330	SP -= items; /* PPCODE */
	331	PUTBACK;
	332
	333	if(items == 1){ /* reader */
	334	mouse_attr_get(aTHX_ self, mg);
	335	}
	336	else if (items == 2){ /* writer */
	337	mouse_attr_set(aTHX_ self, mg, ST(1));
	338	}
	339	else{
	340	mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
	341	"Expected exactly one or two argument for an accessor");
	342	}
	343	}
	344
	345
	346	XS(mouse_xs_reader)
	347	{
	348	dVAR; dXSARGS;
	349	dMOUSE_self;
	350	MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
	351
	352	if (items != 1) {
	353	mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
	354	"Cannot assign a value to a read-only accessor");
	355	}
	356
	357	SP -= items; /* PPCODE */
	358	PUTBACK;
	359
	360	mouse_attr_get(aTHX_ self, mg);
	361	}
	362
	363	XS(mouse_xs_writer)
	364	{
	365	dVAR; dXSARGS;
	366	dMOUSE_self;
	367	MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
	368
	369	if (items != 2) {
	370	mouse_throw_error(MOUSE_mg_attribute(mg), NULL,
	371	"Too few arguments for a write-only accessor");
	372	}
	373
	374	SP -= items; /* PPCODE */
	375	PUTBACK;
	376
	377	mouse_attr_set(aTHX_ self, mg, ST(1));
	378	}
	379
	380	/* simple accessors */
	381
	382	/*
	383	static MAGIC*
	384	mouse_accessor_get_mg(pTHX_ CV* const xsub){
	385	return moose_mg_find(aTHX_ (SV*)xsub, &mouse_simple_accessor_vtbl, MOOSEf_DIE_ON_FAIL);
386	}
387	*/
388
389	CV*
390	mouse_install_simple_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl){
391	CV* const xsub = newXS((char*)fq_name, accessor_impl, __FILE__);
392	SV* const slot = newSVpvn_share(key, keylen, 0U);
393	MAGIC* mg;
394
395	if(!fq_name){
396	/* anonymous xsubs need sv_2mortal */
397	sv_2mortal((SV*)xsub);
398	}
399
400	mg = sv_magicext((SV*)xsub, slot, PERL_MAGIC_ext, &mouse_accessor_vtbl, NULL, 0);
401	SvREFCNT_dec(slot); /* sv_magicext() increases refcnt in mg_obj */
402
403	/* NOTE:
404	* although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx)
405	*/
406	CvXSUBANY(xsub).any_ptr = (void*)mg;
407
408	return xsub;
409	}
410
411	XS(mouse_xs_simple_reader)
412	{
413	dVAR; dXSARGS;
414	dMOUSE_self;
415	SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
416	SV* value;
417
418	if (items != 1) {
419	croak("Expected exactly one argument for a reader for '%"SVf"'", slot);
420	}
421
422	value = mouse_instance_get_slot(aTHX_ self, slot);
423	ST(0) = value ? value : &PL_sv_undef;
424	XSRETURN(1);
425	}
426
427
428	XS(mouse_xs_simple_writer)
429	{
430	dVAR; dXSARGS;
431	dMOUSE_self;
432	SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
433
434	if (items != 2) {
435	croak("Expected exactly two argument for a writer for '%"SVf"'", slot);
436	}
437
438	ST(0) = mouse_instance_set_slot(aTHX_ self, slot, ST(1));
439	XSRETURN(1);
440	}
441
442	XS(mouse_xs_simple_clearer)
443	{
444	dVAR; dXSARGS;
445	dMOUSE_self;
446	SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
447	SV* value;
448
449	if (items != 1) {
450	croak("Expected exactly one argument for a clearer for '%"SVf"'", slot);
451	}
452
453	value = mouse_instance_delete_slot(aTHX_ self, slot);
454	ST(0) = value ? value : &PL_sv_undef;
455	XSRETURN(1);
456	}
457
458	XS(mouse_xs_simple_predicate)
459	{
460	dVAR; dXSARGS;
461	dMOUSE_self;
462	SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
463
464	if (items != 1) {
465	croak("Expected exactly one argument for a predicate for '%"SVf"'", slot);
466	}
467
468	ST(0) = boolSV( mouse_instance_has_slot(aTHX_ self, slot) );
469	XSRETURN(1);
470	}
471
76770976	472	/* simple instance slot accessor (or Mouse::Meta::Instance) */
646c0371	473
	474	SV*
	475	mouse_instance_create(pTHX_ HV* const stash) {
	476	assert(stash);
	477	return sv_bless( newRV_noinc((SV*)newHV()), stash );
	478	}
	479
	480	SV*
	481	mouse_instance_clone(pTHX_ SV* const instance) {
	482	HV* proto;
	483	assert(instance);
	484
	485	CHECK_INSTANCE(instance);
	486	proto = newHVhv((HV*)SvRV(instance));
	487	return sv_bless( newRV_noinc((SV*)proto), SvSTASH(SvRV(instance)) );
	488	}
	489
	490	bool
	491	mouse_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
	492	assert(instance);
	493	assert(slot);
	494	CHECK_INSTANCE(instance);
	495	return hv_exists_ent((HV*)SvRV(instance), slot, 0U);
	496	}
	497
	498	SV*
	499	mouse_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
	500	HE* he;
	501	assert(instance);
	502	assert(slot);
	503	CHECK_INSTANCE(instance);
	504	he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
	505	return he ? HeVAL(he) : NULL;
	506	}
	507
	508	SV*
	509	mouse_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value) {
	510	HE* he;
	511	SV* sv;
	512	assert(instance);
	513	assert(slot);
	514	assert(value);
	515	CHECK_INSTANCE(instance);
	516	he = hv_fetch_ent((HV*)SvRV(instance), slot, TRUE, 0U);
	517	sv = HeVAL(he);
	518	sv_setsv_mg(sv, value);
	519	return sv;
	520	}
	521
	522	SV*
	523	mouse_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
	524	assert(instance);
	525	assert(slot);
	526	CHECK_INSTANCE(instance);
	527	return hv_delete_ent((HV*)SvRV(instance), slot, 0, 0U);
	528	}
	529
	530	void
	531	mouse_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
	532	HE* he;
	533	assert(instance);
	534	assert(slot);
	535	CHECK_INSTANCE(instance);
	536	he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
537	if(he){
538	sv_rvweaken(HeVAL(he));
539	}
540	}
541	\r
542	MODULE = Mouse::Meta::Method::Accessor::XS PACKAGE = Mouse::Meta::Method::Accessor::XS
543
544	PROTOTYPES: DISABLE
545	VERSIONCHECK: DISABLE
546
547	CV*
548	_generate_accessor(klass, SV* attr, metaclass)
549	CODE:
550	{
551	RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_accessor);
552	}
553	OUTPUT:
554	RETVAL
555
556	CV*
557	_generate_reader(klass, SV* attr, metaclass)
558	CODE:
559	{
560	RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_reader);
561	}
562	OUTPUT:
563	RETVAL
564
565	CV*
566	_generate_writer(klass, SV* attr, metaclass)
567	CODE:
568	{
569	RETVAL = mouse_instantiate_xs_accessor(aTHX_ attr, mouse_xs_writer);
570	}
571	OUTPUT:
572	RETVAL
573
574	CV*
575	_generate_clearer(klass, SV* attr, metaclass)
576	CODE:
577	{
578	SV* const slot = mcall0s(attr, "name");
579	STRLEN len;
580	const char* const pv = SvPV_const(slot, len);
581	RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, mouse_xs_simple_clearer);
582	}
583	OUTPUT:
584	RETVAL
585
586	CV*
587	_generate_predicate(klass, SV* attr, metaclass)
588	CODE:
589	{
590	SV* const slot = mcall0s(attr, "name");
591	STRLEN len;
592	const char* const pv = SvPV_const(slot, len);
593	RETVAL = mouse_install_simple_accessor(aTHX_ NULL, pv, len, mouse_xs_simple_predicate);
594	}
595	OUTPUT:
596	RETVAL
597