xs/Instance.xs

   1 #include "mop.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 SV*
  10 mop_instance_create(pTHX_ HV* const stash) {
  11     assert(stash);
  12     return sv_bless( newRV_noinc((SV*)newHV()), stash );
  13 }
  14
  15 bool
  16 mop_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
  17     assert(instance);
  18     assert(slot);
  19     CHECK_INSTANCE(instance);
  20     return hv_exists_ent((HV*)SvRV(instance), slot, 0U);
  21 }
  22
  23 SV*
  24 mop_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
  25     HE* he;
  26     assert(instance);
  27     assert(slot);
  28     CHECK_INSTANCE(instance);
  29     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
  30     return he ? HeVAL(he) : NULL;
  31 }
  32
  33 SV*
  34 mop_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value) {
  35     HE* he;
  36     SV* sv;
  37     assert(instance);
  38     assert(slot);
  39     assert(value);
  40     CHECK_INSTANCE(instance);
  41     he = hv_fetch_ent((HV*)SvRV(instance), slot, TRUE, 0U);
  42     sv = HeVAL(he);
  43     sv_setsv_mg(sv, value);
  44     return sv;
  45 }
  46
  47 SV*
  48 mop_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
  49     assert(instance);
  50     assert(slot);
  51     CHECK_INSTANCE(instance);
  52     return hv_delete_ent((HV*)SvRV(instance), slot, 0, 0U);
  53 }
  54
  55 void
  56 mop_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
  57     HE* he;
  58     assert(instance);
  59     assert(slot);
  60     CHECK_INSTANCE(instance);
  61     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
  62     if(he){
  63         sv_rvweaken(HeVAL(he));
  64     }
  65 }
  66
  67 static const mop_instance_vtbl mop_default_instance = {
  68     mop_instance_create,
  69     mop_instance_has_slot,
  70     mop_instance_get_slot,
  71     mop_instance_set_slot,
  72     mop_instance_delete_slot,
  73     mop_instance_weaken_slot,
  74 };
  75
  76
  77 const mop_instance_vtbl*
  78 mop_get_default_instance_vtbl(pTHX){
  79     return &mop_default_instance;
  80 }
  81
  82 MODULE = Class::MOP::Instance  PACKAGE = Class::MOP::Instance
  83
  84 PROTOTYPES: DISABLE
  85
  86 VERSIONCHECK: DISABLE
  87
  88 BOOT:
  89     INSTALL_SIMPLE_READER(Instance, associated_metaclass);
  90
  91 void*
  92 can_xs(SV* self)
  93 PREINIT:
  94     CV* const default_method  = get_cv("Class::MOP::Instance::get_slot_value", FALSE);
  95     SV* const method          = newSVpvs_flags("get_slot_value", SVs_TEMP);
  96     SV* code_ref;
  97 CODE:
  98     /* $self->can("get_slot_value") == \&Class::MOP::Instance::get_slot_value */
  99     code_ref = mop_call1(aTHX_ self, mop_can, method);
 100     if(SvROK(code_ref) && SvRV(code_ref) == (SV*)default_method){
 101         RETVAL = (void*)&mop_default_instance;
 102     }
 103     else{
 104         RETVAL = NULL;
 105     }
 106 OUTPUT:
 107     RETVAL
 108
 109 SV*
 110 create_instance(SV* self)
 111 PREINIT:
 112     SV* class_name;
 113 CODE:
 114     class_name = mop_call0_pvs(self, "_class_name");
 115     RETVAL = mop_instance_create(aTHX_ gv_stashsv(class_name, TRUE));
 116 OUTPUT:
 117     RETVAL
 118
 119 bool
 120 is_slot_initialized(SV* self, SV* instance, SV* slot)
 121 CODE:
 122     PERL_UNUSED_VAR(self);
 123     RETVAL = mop_instance_has_slot(aTHX_ instance, slot);
 124 OUTPUT:
 125     RETVAL
 126
 127 SV*
 128 get_slot_value(SV* self, SV* instance, SV* slot)
 129 CODE:
 130     PERL_UNUSED_VAR(self);
 131     RETVAL = mop_instance_get_slot(aTHX_ instance, slot);
 132     RETVAL = RETVAL ? newSVsv(RETVAL) : &PL_sv_undef;
 133 OUTPUT:
 134     RETVAL
 135
 136 SV*
 137 set_slot_value(SV* self, SV* instance, SV* slot, SV* value)
 138 CODE:
 139     PERL_UNUSED_VAR(self);
 140     RETVAL = mop_instance_set_slot(aTHX_ instance, slot, value);
 141     SvREFCNT_inc_simple_void_NN(RETVAL);
 142 OUTPUT:
 143     RETVAL
 144
 145 SV*
 146 deinitialize_slot(SV* self, SV* instance, SV* slot)
 147 CODE:
 148     PERL_UNUSED_VAR(self);
 149     RETVAL = mop_instance_delete_slot(aTHX_ instance, slot);
 150     if(RETVAL){
 151         SvREFCNT_inc_simple_void_NN(RETVAL);
 152     }
 153     else{
 154         RETVAL = &PL_sv_undef;
 155     }
 156 OUTPUT:
 157     RETVAL
 158
 159 void
 160 weaken_slot_value(SV* self, SV* instance, SV* slot)
 161 CODE:
 162     PERL_UNUSED_VAR(self);
 163     mop_instance_weaken_slot(aTHX_ instance, slot);