Moose.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #define NEED_newRV_noinc
   6 #define NEED_newSVpvn_share
   7 #define NEED_sv_2pv_flags
   8 #include "ppport.h"
   9
  10 #ifndef XSPROTO
  11 #define XSPROTO(name) void name(pTHX_ CV* cv)
  12 #endif
  13
  14 #ifndef gv_stashpvs
  15 #define gv_stashpvs(x, y) gv_stashpvn(STR_WITH_LEN(x), y)
  16 #endif
  17
  18 /* FIXME
  19  * type constraints are already implemented by konobi
  20  * should be trivial to do coercions for the core types, too
  21  *
  22  * TypeConstraint::Class can compare SvSTASH by ptr, and if it's neq *then*
  23  * call ->isa (should handle vast majority of cases)
  24  *
  25  * base parametrized types are also trivial
  26  *
  27  * ClassName is get_stathpvn
  28  */
  29
  30 /* FIXME
  31  * for a constructor we have ATTR *attrs, and iterate that, removing init_arg
  32  * we can preallocate the structure to the right size (maybe even with the
  33  * right HEs?), and do various other prehashing hacks to gain speed
  34  * */
  35
  36 /* FIXME
  37  * delegations and attribute helpers:
  38  *
  39  * typedef struct {
  40  *      ATTR *attr;
  41  *      pv *method;
  42  * } delegation;
  43  *
  44  * typedef struct {
  45  *      ATTR *attr;
  46  *      I32 *type; // hash, array, whatever + vtable for operation
  47  * } attributehelper;
  48  */
  49
  50
  51 STATIC MGVTBL null_mg_vtbl = {
  52     NULL, /* get */
  53     NULL, /* set */
  54     NULL, /* len */
  55     NULL, /* clear */
  56     NULL, /* free */
  57 #if MGf_COPY
  58     NULL, /* copy */
  59 #endif /* MGf_COPY */
  60 #if MGf_DUP
  61     NULL, /* dup */
  62 #endif /* MGf_DUP */
  63 #if MGf_LOCAL
  64     NULL, /* local */
  65 #endif /* MGf_LOCAL */
  66 };
  67
  68 STATIC MAGIC *stash_in_mg (pTHX_ SV *sv, SV *obj) {
  69     MAGIC *mg = sv_magicext(sv, obj, PERL_MAGIC_ext, &null_mg_vtbl, NULL, 0 );
  70     mg->mg_flags |= MGf_REFCOUNTED;
  71
  72     return mg;
  73 }
  74
  75 STATIC SV *get_stashed_in_mg(pTHX_ SV *sv) {
  76     MAGIC *mg, *moremagic;
  77
  78     if (SvTYPE(sv) >= SVt_PVMG) {
  79         for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  80             if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_virtual == &null_mg_vtbl))
  81                 break;
  82         }
  83         if (mg)
  84             return mg->mg_obj;
  85     }
  86
  87     return NULL;
  88 }
  89
  90 /* this is a enum of checks */
  91 typedef enum {
  92     Any, /* or item, or bool */
  93     Undef,
  94     Defined,
  95     Str, /* or value */
  96     Num,
  97     Int,
  98     GlobRef, /* SVt_PVGV */
  99     ArrayRef, /* SVt_PVAV */
 100     HashRef, /* SVt_PVHV */
 101     CodeRef, /* SVt_PVCV */
 102     Ref,
 103     ScalarRef,
 104     FileHandle,
 105     RegexpRef,
 106     Object,
 107     /* complex checks */
 108     Role,
 109     ClassName,
 110     Enum,
 111 } TC;
 112
 113 typedef enum {
 114     tc_none = 0,
 115     tc_type,
 116     tc_cv,
 117     tc_op,
 118     tc_stash,
 119     tc_classname,
 120     tc_fptr,
 121 } tc_kind;
 122
 123 typedef union {
 124     TC type;
 125     CV *cv;
 126     OP *op;
 127     HV *stash;
 128     char *classname;
 129     bool (*fptr)(pTHX_ SV *type_constraint, SV *sv);
 130 } TC_CHECK;
 131
 132 typedef union {
 133     char *builder;
 134     SV *value;
 135     CV *sub;
 136     OP *op;
 137     U32 type;
 138 } DEFAULT;
 139
 140 typedef enum {
 141     default_none = 0,
 142     default_type,
 143     default_builder,
 144     default_value,
 145     default_sub,
 146     default_op,
 147 } default_kind;
 148
 149 typedef struct {
 150     /* the meta instance struct */
 151     struct mi *mi;
 152
 153     U32 flags; /* slot type, TC behavior, coerce, weaken, (no default | default, builder + lazy), auto_deref */
 154
 155     /* slot access fields */
 156     SV *slot_sv; /* value of the slot (slot name presumably) */
 157     U32 slot_u32; /* for optimized access (precomputed hash or otherr) */
 158
 159     DEFAULT def; /* cv, value or other, depending on flags */
 160
 161     TC_CHECK tc_check; /* cv, value or other, dependidng on flags */
 162     SV *type_constraint; /* meta attr */
 163
 164     CV *initializer;
 165     CV *trigger;
 166
 167     SV *meta_attr; /* the meta attr object */
 168     AV *cvs; /* CVs which use this attr */
 169 } ATTR;
 170
 171 /* slot flags:
 172  * instance           reading  writing
 173  * 00000000 00000000 00000000 00000000
 174  *                              ^      trigger
 175  *                               ^     weak
 176  *                                 ^^^ tc_kind
 177  *                                ^    coerce
 178  *                        ^^^          default_kind
 179  *                       ^             lazy
 180  *                 ^                   required
 181  * ^^^^^^^                             if 0 then nothing special (just hash)? FIXME TBD
 182  */
 183
 184 #define ATTR_INSTANCE_MASK 0xff000000
 185 #define ATTR_READING_MASK  0x0000ff00
 186 #define ATTR_WRITING_MASK  0x000000ff
 187
 188 #define ATTR_MASK_TYPE 0x7
 189
 190 #define ATTR_MASK_DEFAULT 0x700
 191 #define ATTR_SHIFT_DEAFULT 8
 192
 193 #define ATTR_LAZY 0x800
 194
 195 #define ATTR_COERCE 0x08
 196 #define ATTR_WEAK 0x10
 197 #define ATTR_TRIGGER 0x10
 198
 199 #define ATTR_ISWEAK(attr) ( attr->flags & ATTR_WEAK )
 200 #define ATTR_ISLAZY(attr) ( attr->flags & ATTR_LAZY )
 201 #define ATTR_ISCOERCE(attr) ( attr->flags & ATTR_COERCE )
 202
 203 #define ATTR_TYPE(f) ( attr->flags & 0x7 )
 204 #define ATTR_DEFAULT(f) ( ( attr->flags & ATTR_MASK_DEFAULT ) >> ATTR_SHIFT_DEFAULT )
 205
 206 #define ATTR_DUMB_READER(attr) !ATTR_IS_LAZY(attr)
 207 #define ATTR_DUMB_WRITER(attr) ( ( attr->flags & ATTR_WRITING_MASK ) == 0 )
 208 #define ATTR_DUMB_INSTANCE(attr) ( ( attr->flags & ATTR_INSTANCE_MASK ) == 0 )
 209
 210 #define dATTR ATTR *attr = (XSANY.any_i32 ? INT2PTR(ATTR *, (XSANY.any_i32)) : define_attr(aTHX_ cv))
 211
 212
 213 /* FIXME define a vtable that does call_sv */
 214 typedef struct {
 215     SV * (*get)(pTHX_ SV *self, ATTR *attr);
 216     void (*set)(pTHX_ SV *self, ATTR *attr, SV *value);
 217     bool * (*has)(pTHX_ SV *self, ATTR *attr);
 218     SV * (*delete)(pTHX_ SV *self, ATTR *attr);
 219 } instance_vtbl;
 220
 221
 222 typedef enum {
 223     hash = 0,
 224
 225     /* these are not yet implemented */
 226     array,
 227     fptr,
 228     cv,
 229     judy,
 230 } instance_types;
 231
 232 typedef struct mi {
 233     HV *stash;
 234
 235     /* slot access method */
 236     instance_types type;
 237     instance_vtbl *vtbl;
 238
 239     /* attr descriptors */
 240     I32 num_attrs;
 241     ATTR *attrs;
 242 } MI;
 243
 244
 245
 246
 247 STATIC bool check_is_scalar_ref(SV *sv) {
 248     if( SvROK(sv) ) {
 249         switch (SvTYPE(SvRV(sv))) {
 250             case SVt_IV:
 251             case SVt_NV:
 252             case SVt_PV:
 253             case SVt_NULL:
 254                 return 1;
 255                 break;
 256             default:
 257                 return 0;
 258         }
 259     }
 260     return 0;
 261 }
 262
 263 STATIC bool check_reftype(TC type, SV *sv) {
 264     int svt;
 265
 266     if ( !SvROK(sv) )
 267         return 0;
 268
 269     switch (type) {
 270         case GlobRef:
 271             svt = SVt_PVGV;
 272             break;
 273         case ArrayRef:
 274             svt = SVt_PVAV;
 275             break;
 276         case HashRef:
 277             svt = SVt_PVHV;
 278             break;
 279         case CodeRef:
 280             svt = SVt_PVCV;
 281             break;
 282     }
 283
 284     return SvTYPE(sv) == svt;
 285 }
 286
 287 STATIC bool check_sv_class (pTHX_ HV *stash, SV *sv) {
 288     dSP;
 289     bool ret;
 290
 291     if (!sv)
 292         return 0;
 293     SvGETMAGIC(sv);
 294     if (!SvROK(sv))
 295         return 0;
 296     sv = (SV*)SvRV(sv);
 297     if (!SvOBJECT(sv))
 298         return 0;
 299     if (SvSTASH(sv) == stash)
 300         return 1;
 301
 302     ENTER;
 303     SAVETMPS;
 304     PUSHMARK(SP);
 305     XPUSHs(sv);
 306     XPUSHs(newSVpv(HvNAME_get(SvSTASH(sv)), 0));
 307     PUTBACK;
 308
 309     call_method("isa", G_SCALAR);
 310
 311     SPAGAIN;
 312     ret = SvTRUE(TOPs);
 313
 314     FREETMPS;
 315     LEAVE;
 316
 317     return ret;
 318 }
 319
 320 STATIC bool check_sv_type (TC type, SV *sv) {
 321     if (!sv)
 322         return 0;
 323     switch (type) {
 324         case Any:
 325             return 1;
 326             break;
 327         case Undef:
 328             return !SvOK(sv);
 329             break;
 330         case Defined:
 331             return SvOK(sv);
 332             break;
 333         case Str:
 334             return (SvOK(sv) && !SvROK(sv));
 335         case Ref:
 336             return SvROK(sv);
 337             break;
 338         case ScalarRef:
 339             return check_is_scalar_ref(sv);
 340             break;
 341         case ArrayRef:
 342         case HashRef:
 343         case CodeRef:
 344         case GlobRef:
 345             return check_reftype(type, sv);
 346             break;
 347         case Object:
 348             return sv_isobject(sv);
 349             break;
 350         case RegexpRef:
 351             return sv_isa(sv, "Regexp");
 352             break;
 353         case FileHandle:
 354             croak("todo");
 355             break;
 356         default:
 357             croak("todo");
 358     }
 359
 360     return 0;
 361 }
 362
 363 STATIC bool check_sv_type_constraint(pTHX_ tc_kind kind, TC_CHECK tc_check, SV *type_constraint, SV *sv) {
 364     switch (kind) {
 365         case tc_none:
 366             return 1;
 367             break;
 368         case tc_type:
 369             return check_sv_type(tc_check.type, sv);
 370             break;
 371         case tc_stash:
 372             return check_class(aTHX_ tc_check.stash, sv);
 373             break;
 374         case tc_classname:
 375             return ( gv_stashpv(tc_check.classname, 0) != NULL );
 376             break;
 377         case tc_fptr:
 378             return tc_check.fptr(aTHX_ type_constraint, sv);
 379             break;
 380         case tc_cv:
 381         case tc_op:
 382             croak("todo");
 383             break;
 384     }
 385
 386     croak("todo");
 387     return 0;
 388 }
 389
 390
 391 STATIC void init_attr (MI *mi, ATTR *attr, HV *desc) {
 392     U32 hash;
 393     STRLEN len;
 394     SV **key = hv_fetchs(desc, "key", 0);
 395     SV **meta_attr = hv_fetchs(desc, "meta", 0);
 396     char *pv;
 397
 398     if ( !meta_attr ) croak("'meta' is required");
 399
 400     attr->meta_attr = newSVsv(*meta_attr);
 401
 402     attr->mi = mi;
 403
 404     attr->flags = 0;
 405
 406
 407     /* if type == hash */
 408     /* prehash the key */
 409     if ( !key ) croak("'key' is required");
 410
 411     pv = SvPV(*key, len);
 412
 413     PERL_HASH(hash, pv, len);
 414
 415     attr->slot_sv = newSVpvn_share(pv, len, hash);
 416     attr->slot_u32 = hash;
 417
 418     attr->def.type = 0;
 419
 420     attr->tc_check.type = 0;
 421     attr->type_constraint = NULL;
 422
 423
 424     attr->initializer = NULL;
 425     attr->trigger = NULL;
 426
 427     /* cross refs to CVs which use this struct */
 428     attr->cvs = newAV();
 429 }
 430
 431 STATIC MI *new_mi (pTHX_ HV *stash, AV *attrs) {
 432     MI *mi;
 433     I32 ix;
 434     const I32 num = av_len(attrs) + 1;
 435
 436     Newx(mi, 1, MI);
 437
 438     SvREFCNT_inc_simple(stash);
 439     mi->stash = stash;
 440
 441     mi->type = 0; /* nothing else implemented yet */
 442
 443     /* initialize attributes */
 444     mi->num_attrs = num;
 445     Newx(mi->attrs, num, ATTR);
 446     for ( ix = 0; ix < num; ix++ ) {
 447         SV **desc = av_fetch(attrs, ix, 0);
 448
 449         if ( !desc || !*desc || !SvROK(*desc) || !(SvTYPE(SvRV(*desc)) == SVt_PVHV) ) {
 450             croak("Attribute descriptor has to be a hash reference");
 451         }
 452
 453         init_attr(mi, &mi->attrs[ix], (HV *)SvRV(*desc));
 454     }
 455
 456     return mi;
 457 }
 458
 459 STATIC SV *new_mi_obj (pTHX_ MI *mi) {
 460     HV *stash = gv_stashpvs("Moose::XS::Meta::Instance",0);
 461     SV *obj = newRV_noinc(newSViv(PTR2IV(mi)));
 462     sv_bless( obj, stash );
 463     return obj;
 464 }
 465
 466 STATIC SV *attr_to_meta_instance(pTHX_ SV *meta_attr) {
 467     dSP;
 468     I32 count;
 469     SV *mi;
 470
 471     if ( !meta_attr )
 472         croak("No attr found in magic!");
 473
 474     ENTER;
 475     SAVETMPS;
 476     PUSHMARK(SP);
 477     XPUSHs(meta_attr);
 478     PUTBACK;
 479     count = call_pv("Moose::XS::attr_to_meta_instance", G_SCALAR);
 480
 481     if ( count != 1 )
 482         croak("attr_to_meta_instance borked (%d args returned, expecting 1)", count);
 483
 484     SPAGAIN;
 485     mi = POPs;
 486
 487     SvREFCNT_inc(mi);
 488
 489     PUTBACK;
 490     FREETMPS;
 491     LEAVE;
 492
 493     return mi;
 494 }
 495
 496 STATIC SV *perl_mi_to_c_mi(pTHX_ SV *perl_mi) {
 497     dSP;
 498     I32 count;
 499     MI *mi = NULL;
 500     SV *class;
 501     SV *attrs;
 502     HV *stash;
 503
 504     ENTER;
 505     SAVETMPS;
 506     PUSHMARK(SP);
 507     XPUSHs(perl_mi);
 508     PUTBACK;
 509     count = call_pv("Moose::XS::meta_instance_to_attr_descs", G_ARRAY);
 510
 511     if ( count != 2 )
 512         croak("meta_instance_to_attr_descs borked (%d args returned, expecting 2)", count);
 513
 514     SPAGAIN;
 515     attrs = POPs;
 516     class = POPs;
 517
 518     PUTBACK;
 519
 520     stash = gv_stashsv(class, 0);
 521
 522     mi = new_mi(aTHX_ stash, (AV *)SvRV(attrs));
 523
 524     FREETMPS;
 525     LEAVE;
 526
 527     return new_mi_obj(aTHX_ mi);
 528 }
 529
 530 STATIC ATTR *mi_find_attr(MI *mi, SV *meta_attr) {
 531     I32 ix;
 532
 533     for ( ix = 0; ix < mi->num_attrs; ix++ ) {
 534         if ( SvRV(mi->attrs[ix].meta_attr) == SvRV(meta_attr) ) {
 535             return &mi->attrs[ix];
 536         }
 537     }
 538
 539     sv_dump(meta_attr);
 540     croak("Attr not found");
 541     return NULL;
 542 }
 543
 544 STATIC ATTR *get_attr(pTHX_ CV *cv) {
 545     SV *meta_attr = get_stashed_in_mg(aTHX_ (SV *)cv);
 546     SV *perl_mi = attr_to_meta_instance(aTHX_ meta_attr);
 547     SV *c_mi = get_stashed_in_mg(aTHX_ SvRV(perl_mi));
 548     MI *mi;
 549
 550     if (!c_mi) {
 551         c_mi = perl_mi_to_c_mi(aTHX_ perl_mi);
 552         stash_in_mg(aTHX_ perl_mi, c_mi);
 553     }
 554
 555     sv_2mortal(perl_mi);
 556
 557     mi = INT2PTR(MI *, SvIV(SvRV(c_mi)));
 558
 559     return mi_find_attr(mi, meta_attr);
 560 }
 561
 562 STATIC ATTR *define_attr (pTHX_ CV *cv) {
 563     ATTR *attr = get_attr(aTHX_ cv);
 564     assert(attr);
 565
 566     XSANY.any_i32 = PTR2IV(attr);
 567
 568     av_push( attr->cvs, (SV *)cv );
 569
 570     return attr;
 571 }
 572
 573 STATIC void weaken(pTHX_ SV *sv) {
 574 #ifdef SvWEAKREF
 575         sv_rvweaken(sv); /* FIXME i think this might warn when weakening an already weak ref */
 576 #else
 577         croak("weak references are not implemented in this release of perl");
 578 #endif
 579 }
 580
 581
 582 /* meta instance protocol */
 583
 584 STATIC SV *get_slot_value(pTHX_ SV *self, ATTR *attr) {
 585     HE *he;
 586
 587     assert(self);
 588     assert(SvROK(self));
 589     assert(SvTYPE(SvRV(self)) == SVt_PVHV);
 590
 591     assert( ATTR_DUMB_INSTANCE(attr) );
 592
 593     if ((he = hv_fetch_ent((HV *)SvRV(self), attr->slot_sv, 0, attr->slot_u32)))
 594         return HeVAL(he);
 595     else
 596         return NULL;
 597 }
 598
 599 STATIC void set_slot_value(pTHX_ SV *self, ATTR *attr, SV *value) {
 600     HE *he;
 601     SV *copy;
 602
 603     assert(self);
 604     assert(SvROK(self));
 605     assert(SvTYPE(SvRV(self)) == SVt_PVHV);
 606
 607     assert( ATTR_DUMB_INSTANCE(attr) );
 608
 609     copy = newSVsv(value);
 610
 611     he = hv_store_ent((HV*)SvRV(self), attr->slot_sv, copy, attr->slot_u32);
 612
 613     if (he != NULL) {
 614         if ( ATTR_ISWEAK(attr) )
 615             weaken(aTHX_ HeVAL(he));
 616     } else {
 617         SvREFCNT_dec(copy);
 618         croak("Hash store failed.");
 619     }
 620 }
 621
 622 STATIC bool has_slot_value(pTHX_ SV *self, ATTR *attr) {
 623     assert(self);
 624     assert(SvROK(self));
 625     assert(SvTYPE(SvRV(self)) == SVt_PVHV);
 626
 627     assert( ATTR_DUMB_INSTANCE(attr) );
 628
 629     return hv_exists_ent((HV *)SvRV(self), attr->slot_sv, attr->slot_u32);
 630 }
 631
 632 STATIC SV *deinitialize_slot(pTHX_ SV *self, ATTR *attr) {
 633     assert(self);
 634     assert(SvROK(self));
 635     assert(SvTYPE(SvRV(self)) == SVt_PVHV);
 636
 637     assert( ATTR_DUMB_INSTANCE(attr) );
 638
 639     return hv_delete_ent((HV *)SvRV(self), attr->slot_sv, 0, attr->slot_u32);
 640 }
 641
 642
 643 /* simple high level api */
 644
 645 STATIC XS(getter);
 646 STATIC XS(getter)
 647 {
 648 #ifdef dVAR
 649     dVAR;
 650 #endif
 651     dXSARGS;
 652     dATTR;
 653     SV *value;
 654
 655     if (items != 1)
 656         Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "self");
 657
 658     SP -= items;
 659
 660     assert( ATTR_DUMB_READER(attr) );
 661
 662     value = get_slot_value(aTHX_ ST(0), attr);
 663
 664     if (value) {
 665         ST(0) = sv_mortalcopy(value); /* mortalcopy because $_ .= "blah" for $foo->bar */
 666         XSRETURN(1);
 667     } else {
 668         XSRETURN_UNDEF;
 669     }
 670 }
 671
 672 STATIC XS(setter);
 673 STATIC XS(setter)
 674 {
 675 #ifdef dVAR
 676     dVAR;
 677 #endif
 678     dXSARGS;
 679     dATTR;
 680
 681     if (items != 2)
 682         Perl_croak(aTHX_ "Usage: %s(%s, %s)", GvNAME(CvGV(cv)), "self", "value");
 683
 684     SP -= items;
 685
 686     assert( ATTR_DUMB_WRITER(attr) );
 687
 688     set_slot_value(aTHX_ ST(0), attr, ST(1));
 689
 690     ST(0) = ST(1); /* return value */
 691     XSRETURN(1);
 692 }
 693
 694 STATIC XS(accessor);
 695 STATIC XS(accessor)
 696 {
 697 #ifdef dVAR
 698     dVAR;
 699 #endif
 700     dXSARGS;
 701     dATTR;
 702
 703     if (items < 1)
 704         Perl_croak(aTHX_ "Usage: %s(%s, [ %s ])", GvNAME(CvGV(cv)), "self", "value");
 705
 706     SP -= items;
 707
 708     if (items > 1) {
 709         assert( ATTR_DUMB_READER(attr) );
 710         set_slot_value(aTHX_ ST(0), attr, ST(1));
 711         ST(0) = ST(1); /* return value */
 712     } else {
 713         SV *value;
 714         assert( ATTR_DUMB_WRITER(attr) );
 715         value = get_slot_value(aTHX_ ST(0), attr);
 716         if ( value ) {
 717             ST(0) = value;
 718         } else {
 719             XSRETURN_UNDEF;
 720         }
 721     }
 722
 723     XSRETURN(1);
 724 }
 725
 726 STATIC XS(predicate);
 727 STATIC XS(predicate)
 728 {
 729 #ifdef dVAR
 730     dVAR;
 731 #endif
 732     dXSARGS;
 733     dATTR;
 734
 735     if (items != 1)
 736         Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "self");
 737
 738     SP -= items;
 739
 740     if ( has_slot_value(aTHX_ ST(0), attr) )
 741         XSRETURN_YES;
 742     else
 743         XSRETURN_NO;
 744 }
 745
 746 enum xs_body {
 747     xs_body_getter = 0,
 748     xs_body_setter,
 749     xs_body_accessor,
 750     xs_body_predicate,
 751     max_xs_body
 752 };
 753
 754 STATIC XSPROTO ((*xs_bodies[])) = {
 755     getter,
 756     setter,
 757     accessor,
 758     predicate,
 759 };
 760
 761 MODULE = Moose PACKAGE = Moose::XS
 762
 763 CV *
 764 new_sub(attr, name)
 765     INPUT:
 766         SV *attr;
 767         SV *name;
 768     ALIAS:
 769         new_getter    = xs_body_getter
 770         new_setter    = xs_body_setter
 771         new_accessor  = xs_body_accessor
 772         new_predicate = xs_body_predicate
 773     PREINIT:
 774         CV * cv;
 775     CODE:
 776         if ( ix >= max_xs_body )
 777             croak("Unknown Moose::XS body type");
 778
 779         if ( !sv_isobject(attr) )
 780             croak("'attr' must be a Moose::Meta::Attribute");
 781
 782         cv = newXS(SvOK(name) ? SvPV_nolen(name) : NULL, xs_bodies[ix], __FILE__);
 783
 784         if (cv == NULL)
 785             croak("Oi vey!");
 786
 787         /* associate CV with meta attr */
 788         stash_in_mg(aTHX_ (SV *)cv, attr);
 789
 790         /* this will be set on first call */
 791         XSANY.any_i32 = 0;
 792
 793         RETVAL = cv;
 794     OUTPUT:
 795         RETVAL
 796
 797
 798 MODULE = Moose  PACKAGE = Moose::XS::Meta::Instance
 799
 800 void
 801 DESTROY(self)
 802     INPUT:
 803         SV *self;
 804     PREINIT:
 805         MI *mi = INT2PTR(MI *, SvIV(SvRV(self)));
 806     CODE:
 807         /* foreach attr ( delete cvs XSANY ), free attrs free mi */