Implement XS accessor generators
gfx [Sun, 25 Oct 2009 08:44:15 +0000 (17:44 +0900)]
lib/Mouse/Meta/Attribute.pm
lib/Mouse/Meta/TypeConstraint.pm
lib/Mouse/PurePerl.pm
mouse.h
xs-src/Mouse.xs
xs-src/mouse_accessor.xs [new file with mode: 0644]
xs-src/mouse_simple_accessor.xs
xs-src/mouse_util.xs

index 764abbb..2eb2b6b 100644 (file)
@@ -360,19 +360,16 @@ sub _canonicalize_handles {
     }
 }
 
-
 sub associate_method{
     my ($attribute, $method) = @_;
     $attribute->{associated_methods}++;
     return;
 }
 
-sub accessor_metaclass(){ 'Mouse::Meta::Method::Accessor' }
-
 sub install_accessors{
     my($attribute) = @_;
 
-    my $metaclass      = $attribute->{associated_class};
+    my $metaclass      = $attribute->associated_class;
     my $accessor_class = $attribute->accessor_metaclass;
 
     foreach my $type(qw(accessor reader writer predicate clearer)){
index 9b1acc7..3eb6eb6 100644 (file)
@@ -2,7 +2,7 @@ package Mouse::Meta::TypeConstraint;
 use Mouse::Util qw(:meta); # enables strict and warnings
 
 use overload
-    '""'     => sub { shift->{name} },   # stringify to tc name
+    '""'     => sub { $_[0]->name },   # stringify to tc name
     fallback => 1;
 
 use Carp qw(confess);
@@ -183,13 +183,11 @@ sub check {
 
 sub coerce {
     my $self = shift;
-    if(!$self->{_compiled_type_coercion}){
-        confess("Cannot coerce without a type coercion ($self)");
-    }
 
     return $_[0] if $self->_compiled_type_constraint->(@_);
 
-    return $self->{_compiled_type_coercion}->(@_);
+    my $coercion = $self->_compiled_type_coercion;
+    return $coercion ? $coercion->(@_) : $_[0];
 }
 
 sub get_message {
index 2faf498..8644c93 100644 (file)
@@ -186,6 +186,8 @@ sub has_builder          { exists $_[0]->{builder}         }
 
 sub has_documentation    { exists $_[0]->{documentation}   }
 
+sub accessor_metaclass(){ 'Mouse::Meta::Method::Accessor' }
+
 package
     Mouse::Meta::TypeConstraint;
 
@@ -195,10 +197,10 @@ sub message { $_[0]->{message} }
 
 sub _compiled_type_constraint{ $_[0]->{compiled_type_constraint} }
 
-sub has_coercion{ exists $_[0]->{_compiled_type_coercion} }
+sub _compiled_type_coercion  { $_[0]->{_compiled_type_coercion}  }
 
-package
-    Mouse::Meta::Method::Accessor;
+
+sub has_coercion{ exists $_[0]->{_compiled_type_coercion} }
 
 1;
 __END__
diff --git a/mouse.h b/mouse.h
index 0ebe38c..21e45c3 100644 (file)
--- a/mouse.h
+++ b/mouse.h
@@ -35,6 +35,14 @@ AV* mouse_mro_get_linear_isa(pTHX_ HV* const stash)
 extern SV* mouse_package;
 extern SV* mouse_namespace;
 
+void
+mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const char* const fmt, ...)
+#ifdef __attribute__format__
+    __attribute__format__(__printf__, 3, 4);
+#else
+    ;
+#endif
+
 #define is_class_loaded(sv) mouse_is_class_loaded(aTHX_ sv)
 bool mouse_is_class_loaded(pTHX_ SV*);
 
@@ -54,7 +62,25 @@ SV* mouse_call1(pTHX_ SV *const self, SV *const method, SV* const arg1);
 #define MOUSEf_DIE_ON_FAIL 0x01
 MAGIC* mouse_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl, I32 const flags);
 
-#define dMOUSE_self      SV* const self = mouse_accessor_get_self(aTHX_ ax, items, cv)
+/* MOUSE_av_at(av, ix) is the safer version of AvARRAY(av)[ix] if perl is compiled with -DDEBUGGING */
+#ifdef DEBUGGING
+#define MOUSE_av_at(av, ix)  *mouse_av_at_safe(aTHX_ (av) , (ix))
+SV** mouse_av_at_safe(pTHX_ AV* const mi, I32 const ix);
+#else
+#define MOUSE_av_at(av, ix)  AvARRAY(av)[ix]
+#endif
+
+#define dMOUSE_self  SV* const self = mouse_accessor_get_self(aTHX_ ax, items, cv)
+SV* mouse_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv);
+
+#define MOUSE_mg_obj(mg)     ((mg)->mg_obj)
+#define MOUSE_mg_ptr(mg)     ((mg)->mg_ptr)
+#define MOUSE_mg_flags(mg)   ((mg)->mg_private)
+#define MOUSE_mg_virtual(mg) ((mg)->mg_virtual)
+
+#define MOUSE_mg_slot(mg)   MOUSE_mg_obj(mg)
+#define MOUSE_mg_xa(mg)    ((AV*)MOUSE_mg_ptr(mg))
+
 
 /* mouse_instance.xs stuff */
 SV*  mouse_instance_create     (pTHX_ HV* const stash);
@@ -80,8 +106,15 @@ CV* mouse_install_simple_accessor(pTHX_ const char* const fq_name, const char* c
 
 XS(mouse_xs_simple_reader);
 XS(mouse_xs_simple_writer);
+XS(mouse_xs_simple_clearer);
 XS(mouse_xs_simple_predicate);
 
+CV* mouse_instantiate_xs_accessor(pTHX_ SV* const attr, XSUBADDR_t const accessor_impl);
+
+XS(mouse_xs_accessor);
+XS(mouse_xs_reader);
+XS(mouse_xs_writer);
+
 typedef enum mouse_tc{
      MOUSE_TC_ANY,
      MOUSE_TC_ITEM,
index 12bcf89..ed97592 100644 (file)
@@ -204,6 +204,9 @@ BOOT:
     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_builder, builder);
     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Attribute, has_documentation, documentation);
 
+    newCONSTSUB(gv_stashpvs("Mouse::Meta::Attribute", TRUE), "accessor_metaclass",
+        newSVpvs("Mouse::Meta::Method::Accessor::XS"));
+
 MODULE = Mouse  PACKAGE = Mouse::Meta::TypeConstraint
 
 BOOT:
@@ -215,3 +218,64 @@ BOOT:
     INSTALL_SIMPLE_READER(TypeConstraint, _compiled_type_coercion); /* Mouse specific */
 
     INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion);
+
+
+MODULE = Mouse  PACKAGE = Mouse::Meta::Method::Accessor::XS
+
+BOOT:
+{
+    AV* const isa = get_av("Mouse::Meta::Method::Accessor::XS::ISA", TRUE);
+    av_push(isa, newSVpvs("Mouse::Meta::Method::Accessor"));
+}
+
+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_accessor.xs b/xs-src/mouse_accessor.xs
new file mode 100644 (file)
index 0000000..54c2db6
--- /dev/null
@@ -0,0 +1,375 @@
+#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 = mcall0s(attr,  "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"'",
+                        mcall0s(tc, "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;
+    int ok;
+
+    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(SvIOK(tc_code)){ /* built-in type constraints */
+        ok = mouse_tc_check(aTHX_ SvIVX(tc_code), value);
+    }
+    else {
+        dSP;
+
+        ENTER;
+        SAVETMPS;
+
+        PUSHMARK(SP);
+        XPUSHs(value);
+        PUTBACK;
+
+        call_sv(tc_code, G_SCALAR);
+
+        SPAGAIN;
+        ok = SvTRUEx(POPs);
+        PUTBACK;
+
+        FREETMPS;
+        LEAVE;
+    }
+
+    if(!ok){
+        mouse_throw_error(MOUSE_xa_attribute(xa), value,
+            "Attribute (%"SVf") does not pass the type constraint because: %"SVf,
+                mcall0s(MOUSE_xa_attribute(xa), "name"),
+                mcall1s(tc, "get_message", value));
+    }
+
+    return value;
+}
+
+
+/* pushes return values, does auto-deref if needed */
+static void
+mouse_push_values(pTHX_ AV* const xa, SV* const value, U16 const flags){
+    dSP;
+    PERL_UNUSED_ARG(xa);
+
+    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){
+    AV* const xa    = MOUSE_mg_xa(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 ){
+        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_ xa, value, flags);
+}
+
+static void
+mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){
+    AV* const xa    = MOUSE_mg_xa(mg);
+    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_ xa, 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_xa_attribute(xa), "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_ xa, 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));
+}
index cf835fb..285f3cb 100644 (file)
@@ -1,14 +1,14 @@
-#include "mouse.h"\r
-\r
+#include "mouse.h"
+
 static MGVTBL mouse_simple_accessor_vtbl;
-\r\r
+
 /*
 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);
-}\r
-*/\r
-\r
+}
+*/
+
 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__);
@@ -24,13 +24,13 @@ mouse_install_simple_accessor(pTHX_ const char* const fq_name, const char* const
     SvREFCNT_dec(slot); /* sv_magicext() increases refcnt in mg_obj */
 
     /* NOTE:
-     * although we use MAGIC for gc, we also store slot to CvXSUBANY slot for efficiency (gfx)
+     * although we use MAGIC for gc, we also store mg to CvXSUBANY for efficiency (gfx)
      */
-    CvXSUBANY(xsub).any_ptr = (void*)slot;
+    CvXSUBANY(xsub).any_ptr = (void*)mg;
 
     return xsub;
 }
-\r
+
 SV*
 mouse_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) {
     SV* self;
@@ -48,18 +48,18 @@ mouse_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) {
         croak("Cant call %s as a class method", GvNAME(CvGV(cv)));
     }
     return self;
-}\r
+}
 
 
 XS(mouse_xs_simple_reader)
 {
-    dVAR; dXSARGS;\r
+    dVAR; dXSARGS;
     dMOUSE_self;
-    SV* const slot = (SV*)XSANY.any_ptr;
+    SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
     SV* value;
 
     if (items != 1) {
-        croak("Expected exactly one argument");
+        croak("Expected exactly one argument for a reader for '%"SVf"'", slot);
     }
 
     value = mouse_instance_get_slot(self, slot);
@@ -72,27 +72,42 @@ XS(mouse_xs_simple_writer)
 {
     dVAR; dXSARGS;
     dMOUSE_self;
-    SV* const slot = (SV*)XSANY.any_ptr;
-\r
+    SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
+
     if (items != 2) {
-        croak("Expected exactly two argument");
+        croak("Expected exactly two argument for a writer for '%"SVf"'", slot);
     }
 
     ST(0) = mouse_instance_set_slot(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 = (SV*)XSANY.any_ptr;
-\r
+    SV* const slot = MOUSE_mg_slot((MAGIC*)XSANY.any_ptr);
+
     if (items != 1) {
-        croak("Expected exactly one argument");
+        croak("Expected exactly one argument for a predicate for '%"SVf"'", slot);
     }
 
     ST(0) = boolSV( mouse_instance_has_slot(self, slot) );
     XSRETURN(1);
-}\r
+}
index 9df1f65..f041951 100644 (file)
@@ -69,6 +69,49 @@ mouse_mro_get_linear_isa(pTHX_ HV* const stash){
 }
 #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