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