xs-src/MouseTypeConstraints.xs

   1 /*
   2  * TypeConstraint stuff
   3  *  - Mouse::Util::TypeConstraints (including OptimizedConstraionts)
   4  *  - Mouse::Meta::TypeConstraint
   5  */
   6
   7 #include "mouse.h"
   8
   9 #ifndef SvRXOK
  10 #define SvRXOK(sv) (SvROK(sv) && SvMAGICAL(SvRV(sv)) && mg_find(SvRV(sv), PERL_MAGIC_qr))
  11 #endif
  12
  13 #define MY_CXT_KEY "Mouse::Util::TypeConstraints::_guts" XS_VERSION
  14 typedef struct sui_cxt{
  15     GV* universal_isa;
  16     GV* universal_can;
  17     AV* tc_extra_args;
  18 } my_cxt_t;
  19 START_MY_CXT
  20
  21 typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv);
  22
  23 static
  24 XSPROTO(XS_Mouse_constraint_check);
  25
  26 /*
  27     NOTE: mouse_tc_check() handles GETMAGIC
  28 */
  29 int
  30 mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) {
  31     CV* const cv = (CV*)SvRV(tc_code);
  32     assert(SvTYPE(cv) == SVt_PVCV);
  33
  34     if(CvXSUB(cv) == XS_Mouse_constraint_check){ /* built-in type constraints */
  35         MAGIC* const mg = (MAGIC*)CvXSUBANY(cv).any_ptr;
  36
  37         assert(CvXSUBANY(cv).any_ptr != NULL);
  38         assert(mg->mg_ptr            != NULL);
  39
  40         SvGETMAGIC(sv);
  41         /* call the check function directly, skipping call_sv() */
  42         return CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv);
  43     }
  44     else { /* custom */
  45         int ok;
  46         dSP;
  47         dMY_CXT;
  48
  49         ENTER;
  50         SAVETMPS;
  51
  52         PUSHMARK(SP);
  53         XPUSHs(sv);
  54         if( MY_CXT.tc_extra_args ) {
  55             AV* const av  = MY_CXT.tc_extra_args;
  56             I32 const len = AvFILLp(av) + 1;
  57             int i;
  58             for(i = 0; i < len; i++) {
  59                 XPUSHs( AvARRAY(av)[i] );
  60             }
  61         }
  62         PUTBACK;
  63
  64         call_sv(tc_code, G_SCALAR);
  65
  66         SPAGAIN;
  67         ok = sv_true(POPs);
  68         PUTBACK;
  69
  70         FREETMPS;
  71         LEAVE;
  72
  73         return ok;
  74     }
  75 }
  76
  77 /*
  78     The following type check functions return an integer, not a bool, to keep
  79     the code simple,
  80     so if you assign these return value to a bool variable, you must use
  81     "expr ? TRUE : FALSE".
  82 */
  83
  84 int
  85 mouse_tc_Any(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv PERL_UNUSED_DECL) {
  86     assert(sv);
  87     return TRUE;
  88 }
  89
  90 int
  91 mouse_tc_Bool(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
  92     assert(sv);
  93
  94     if(sv_true(sv)){
  95         if(SvPOKp(sv)){ /* "1" */
  96             return SvCUR(sv) == 1 && SvPVX(sv)[0] == '1';
  97         }
  98         else if(SvIOKp(sv)){
  99             return SvIVX(sv) == 1;
 100         }
 101         else if(SvNOKp(sv)){
 102             return SvNVX(sv) == 1.0;
 103         }
 104         else{
 105             return FALSE;
 106         }
 107     }
 108     else{
 109         /* any false value is a boolean */
 110         return TRUE;
 111     }
 112 }
 113
 114 int
 115 mouse_tc_Undef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 116     assert(sv);
 117     return !SvOK(sv);
 118 }
 119
 120 int
 121 mouse_tc_Defined(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 122     assert(sv);
 123     return SvOK(sv);
 124 }
 125
 126 int
 127 mouse_tc_Value(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 128     assert(sv);
 129     return SvOK(sv) && !SvROK(sv);
 130 }
 131
 132 int
 133 mouse_tc_Num(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 134     assert(sv);
 135     return LooksLikeNumber(sv);
 136 }
 137
 138 static int
 139 S_nv_is_integer(pTHX_ NV const nv) {
 140     if(nv == (NV)(IV)nv){
 141         return TRUE;
 142     }
 143     else {
 144         char buf[64];  /* Must fit sprintf/Gconvert of longest NV */
 145         const char* p;
 146         (void)Gconvert(nv, NV_DIG, 0, buf);
 147         p = &buf[0];
 148
 149         /* -?[0-9]+ */
 150         if(*p == '-') p++;
 151
 152         while(*p){
 153             if(!isDIGIT(*p)){
 154                 return FALSE;
 155             }
 156             p++;
 157         }
 158         return TRUE;
 159     }
 160 }
 161
 162 int
 163 mouse_tc_Int(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 164     assert(sv);
 165     if(SvPOKp(sv)){
 166         int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL);
 167         return num_type && !(num_type & IS_NUMBER_NOT_INT);
 168     }
 169     else if(SvIOKp(sv)){
 170         return TRUE;
 171     }
 172     else if(SvNOKp(sv)) {
 173         return S_nv_is_integer(aTHX_ SvNVX(sv));
 174     }
 175     return FALSE;
 176 }
 177
 178 int
 179 mouse_tc_Str(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 180     assert(sv);
 181     return SvOK(sv) && !SvROK(sv) && !isGV(sv);
 182 }
 183
 184 int
 185 mouse_tc_ClassName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv){
 186     assert(sv);
 187     return is_class_loaded(sv);
 188 }
 189
 190 int
 191 mouse_tc_RoleName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 192     assert(sv);
 193     if(is_class_loaded(sv)){
 194         int ok;
 195
 196         ENTER;
 197         SAVETMPS;
 198
 199         ok = is_an_instance_of("Mouse::Meta::Role", get_metaclass(sv));
 200
 201         FREETMPS;
 202         LEAVE;
 203
 204         return ok;
 205     }
 206     return FALSE;
 207 }
 208
 209 int
 210 mouse_tc_Ref(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 211     assert(sv);
 212     return SvROK(sv);
 213 }
 214
 215 int
 216 mouse_tc_ScalarRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* sv) {
 217     assert(sv);
 218     if(SvROK(sv)){
 219          sv = SvRV(sv);
 220          return !SvOBJECT(sv) && (SvTYPE(sv) <= SVt_PVLV && !isGV(sv));
 221     }
 222     return FALSE;
 223 }
 224
 225 int
 226 mouse_tc_ArrayRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 227     assert(sv);
 228     return IsArrayRef(sv);
 229 }
 230
 231 int
 232 mouse_tc_HashRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 233     assert(sv);
 234     return IsHashRef(sv);
 235 }
 236
 237 int
 238 mouse_tc_CodeRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 239     assert(sv);
 240     return IsCodeRef(sv);
 241 }
 242
 243 int
 244 mouse_tc_RegexpRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 245     assert(sv);
 246     return SvRXOK(sv);
 247 }
 248
 249 int
 250 mouse_tc_GlobRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 251     assert(sv);
 252     return SvROK(sv) && !SvOBJECT(SvRV(sv)) && isGV(SvRV(sv));
 253 }
 254
 255 int
 256 mouse_tc_FileHandle(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 257     GV* gv;
 258     assert(sv);
 259
 260     /* see pp_fileno() in pp_sys.c and Scalar::Util::openhandle() */
 261
 262     gv = (GV*)(SvROK(sv) ? SvRV(sv) : sv);
 263     if(isGV(gv) || SvTYPE(gv) == SVt_PVIO){
 264         IO* const io = isGV(gv) ? GvIO(gv) : (IO*)gv;
 265
 266         if(io && ( IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar) )){
 267             return TRUE;
 268         }
 269     }
 270
 271     return is_an_instance_of("IO::Handle", sv);
 272 }
 273
 274 int
 275 mouse_tc_Object(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
 276     assert(sv);
 277     return SvROK(sv) && SvOBJECT(SvRV(sv)) && !SvRXOK(sv);
 278 }
 279
 280 /* Parameterized type constraints */
 281
 282 static int
 283 mouse_parameterized_ArrayRef(pTHX_ SV* const param, SV* const sv) {
 284     if(IsArrayRef(sv)){
 285         AV* const av  = (AV*)SvRV(sv);
 286         I32 const len = av_len(av) + 1;
 287         I32 i;
 288         for(i = 0; i < len; i++){
 289             SV* const value = *av_fetch(av, i, TRUE);
 290             if(!mouse_tc_check(aTHX_ param, value)){
 291                 return FALSE;
 292             }
 293         }
 294         return TRUE;
 295     }
 296     return FALSE;
 297 }
 298
 299 static int
 300 mouse_parameterized_HashRef(pTHX_ SV* const param, SV* const sv) {
 301     if(IsHashRef(sv)){
 302         HV* const hv  = (HV*)SvRV(sv);
 303         HE* he;
 304
 305         hv_iterinit(hv);
 306         while((he = hv_iternext(hv))){
 307             SV* const value = hv_iterval(hv, he);
 308             if(!mouse_tc_check(aTHX_ param, value)){
 309                 hv_iterinit(hv); /* reset */
 310                 return FALSE;
 311             }
 312         }
 313         return TRUE;
 314     }
 315     return FALSE;
 316 }
 317
 318 static int
 319 mouse_parameterized_Maybe(pTHX_ SV* const param, SV* const sv) {
 320     if(SvOK(sv)){
 321         return mouse_tc_check(aTHX_ param, sv);
 322     }
 323     return TRUE;
 324 }
 325
 326 static int
 327 mouse_types_union_check(pTHX_ AV* const types, SV* const sv) {
 328     I32 const len = AvFILLp(types) + 1;
 329     I32 i;
 330
 331     for(i = 0; i < len; i++){
 332         if(mouse_tc_check(aTHX_ AvARRAY(types)[i], sv)){
 333             return TRUE;
 334         }
 335     }
 336
 337     return FALSE;
 338 }
 339
 340 static int
 341 mouse_types_check(pTHX_ AV* const types, SV* const sv) {
 342     I32 const len = AvFILLp(types) + 1;
 343     I32 i;
 344
 345     ENTER;
 346     SAVE_DEFSV;
 347     DEFSV_set(sv);
 348
 349     for(i = 0; i < len; i++){
 350         if(!mouse_tc_check(aTHX_ AvARRAY(types)[i], sv)){
 351             LEAVE;
 352             return FALSE;
 353         }
 354     }
 355
 356     LEAVE;
 357
 358     return TRUE;
 359 }
 360
 361 /*
 362  *  This class_type generator is taken from Scalar::Util::Instance
 363  */
 364
 365
 366 #define MG_klass_stash(mg) ((HV*)(mg)->mg_obj)
 367 #define MG_klass_pv(mg)    ((mg)->mg_ptr)
 368 #define MG_klass_len(mg)   ((mg)->mg_len)
 369
 370 static const char*
 371 mouse_canonicalize_package_name(const char* name){
 372
 373     /* "::Foo" -> "Foo" */
 374     if(name[0] == ':' && name[1] == ':'){
 375         name += 2;
 376     }
 377
 378     /* "main::main::main::Foo" -> "Foo" */
 379     while(strnEQ(name, "main::", sizeof("main::")-1)){
 380         name += sizeof("main::")-1;
 381     }
 382
 383     return name;
 384 }
 385
 386 static int
 387 mouse_lookup_isa(pTHX_ HV* const instance_stash, const char* const klass_pv){
 388     AV*  const linearized_isa = mro_get_linear_isa(instance_stash);
 389     SV**       svp            = AvARRAY(linearized_isa);
 390     SV** const end            = svp + AvFILLp(linearized_isa) + 1;
 391
 392     while(svp != end){
 393         assert(SvPVX(*svp));
 394         if(strEQ(klass_pv, mouse_canonicalize_package_name(SvPVX(*svp)))){
 395             return TRUE;
 396         }
 397         svp++;
 398     }
 399     return FALSE;
 400 }
 401
 402 #define find_method_pvn(a, b, c) mouse_stash_find_method(aTHX_ a, b, c)
 403 #define find_method_pvs(a, b)    mouse_stash_find_method(aTHX_ a, STR_WITH_LEN(b))
 404
 405 STATIC_INLINE GV*
 406 mouse_stash_find_method(pTHX_ HV* const stash, const char* const name, I32 const namelen){
 407     GV** const gvp = (GV**)hv_fetch(stash, name, namelen, FALSE);
 408     if(gvp && isGV(*gvp) && GvCV(*gvp)){ /* shortcut */
 409         return *gvp;
 410     }
 411
 412     return gv_fetchmeth_autoload(stash, name, namelen, 0);
 413 }
 414
 415 int
 416 mouse_is_an_instance_of(pTHX_ HV* const stash, SV* const instance){
 417     assert(stash);
 418     assert(SvTYPE(stash) == SVt_PVHV);
 419
 420     if(IsObject(instance)){
 421         dMY_CXT;
 422         HV* const instance_stash = SvSTASH(SvRV(instance));
 423         GV* const myisa          = find_method_pvs(instance_stash, "isa");
 424
 425         /* the instance has no own isa method */
 426         if(myisa == NULL || GvCV(myisa) == GvCV(MY_CXT.universal_isa)){
 427             return stash == instance_stash
 428                 || mouse_lookup_isa(aTHX_ instance_stash, HvNAME_get(stash));
 429         }
 430         /* the instance has its own isa method */
 431         else {
 432             SV* package;
 433             int ok;
 434
 435             ENTER;
 436             SAVETMPS;
 437
 438             package = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
 439             ok = sv_true(mcall1s(instance, "isa", sv_2mortal(package)));
 440
 441             FREETMPS;
 442             LEAVE;
 443
 444             return ok;
 445         }
 446     }
 447     return FALSE;
 448 }
 449
 450 static int
 451 mouse_is_an_instance_of_universal(pTHX_ SV* const data, SV* const sv){
 452     PERL_UNUSED_ARG(data);
 453     return SvROK(sv) && SvOBJECT(SvRV(sv));
 454 }
 455
 456 static int
 457 mouse_can_methods(pTHX_ AV* const methods, SV* const instance){
 458     if(IsObject(instance)){
 459         dMY_CXT;
 460         HV* const mystash      = SvSTASH(SvRV(instance));
 461         GV* const mycan        = find_method_pvs(mystash, "can");
 462         bool const use_builtin = (mycan == NULL || GvCV(mycan) == GvCV(MY_CXT.universal_can)) ? TRUE : FALSE;
 463         I32 const len           = AvFILLp(methods) + 1;
 464         I32 i;
 465         for(i = 0; i < len; i++){
 466             SV* const name = MOUSE_av_at(methods, i);
 467
 468             if(use_builtin){
 469                 if(!find_method_pvn(mystash, SvPVX(name), SvCUR(name))){
 470                     return FALSE;
 471                 }
 472             }
 473             else{
 474                 bool ok;
 475
 476                 ENTER;
 477                 SAVETMPS;
 478
 479                 ok = sv_true(mcall1s(instance, "can", sv_mortalcopy(name)));
 480
 481                 FREETMPS;
 482                 LEAVE;
 483
 484                 if(!ok){
 485                     return FALSE;
 486                 }
 487             }
 488         }
 489         return TRUE;
 490     }
 491     return FALSE;
 492 }
 493
 494 static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */
 495
 496 static CV*
 497 mouse_tc_generate(pTHX_ const char* const name, check_fptr_t const fptr, SV* const param) {
 498     CV* xsub;
 499
 500     xsub = newXS(name, XS_Mouse_constraint_check, __FILE__);
 501     CvXSUBANY(xsub).any_ptr = sv_magicext(
 502         (SV*)xsub,
 503         param,       /* mg_obj: refcnt will be increased */
 504         PERL_MAGIC_ext,
 505         &mouse_util_type_constraints_vtbl,
 506         (char*)fptr, /* mg_ptr */
 507         0            /* mg_len: 0 for static data */
 508     );
 509
 510     if(!name){
 511         sv_2mortal((SV*)xsub);
 512     }
 513
 514     return xsub;
 515 }
 516
 517 CV*
 518 mouse_generate_isa_predicate_for(pTHX_ SV* const klass, const char* const predicate_name){
 519     STRLEN klass_len;
 520     const char* klass_pv = SvPV_const(klass, klass_len);
 521     SV*   param;
 522     check_fptr_t fptr;
 523
 524     klass_pv = mouse_canonicalize_package_name(klass_pv);
 525
 526     if(strNE(klass_pv, "UNIVERSAL")){
 527         param = (SV*)gv_stashpvn(klass_pv, klass_len, GV_ADD);
 528         fptr = (check_fptr_t)mouse_is_an_instance_of;
 529
 530     }
 531     else{
 532         param = NULL;
 533         fptr = (check_fptr_t)mouse_is_an_instance_of_universal;
 534     }
 535
 536     return mouse_tc_generate(aTHX_ predicate_name, fptr, param);
 537 }
 538
 539 CV*
 540 mouse_generate_can_predicate_for(pTHX_ SV* const methods, const char* const predicate_name){
 541     AV* av;
 542     AV* const param = newAV_mortal();
 543     I32 len;
 544     I32 i;
 545
 546     must_ref(methods, "an ARRAY ref for method names", SVt_PVAV);
 547     av = (AV*)SvRV(methods);
 548
 549     len = av_len(av) + 1;
 550     for(i = 0; i < len; i++){
 551         SV* const name = *av_fetch(av, i, TRUE);
 552         STRLEN pvlen;
 553         const char* const pv = SvPV_const(name, pvlen);
 554
 555         av_push(param, newSVpvn_share(pv, pvlen, 0U));
 556     }
 557
 558     return mouse_tc_generate(aTHX_ predicate_name, (check_fptr_t)mouse_can_methods, (SV*)param);
 559 }
 560
 561 static
 562 XSPROTO(XS_Mouse_constraint_check) {
 563     dVAR;
 564     dXSARGS;
 565     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 566     SV* sv;
 567
 568     if(items < 1){
 569         croak("Too few arguments for type constraint check functions");
 570     }
 571
 572     sv = ST(0);
 573     SvGETMAGIC(sv);
 574     ST(0) = boolSV( CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv) );
 575     XSRETURN(1);
 576 }
 577
 578 static
 579 XSPROTO(XS_Mouse_TypeConstraint_fallback) {
 580     dXSARGS;
 581     PERL_UNUSED_VAR(cv);
 582     PERL_UNUSED_VAR(items);
 583     XSRETURN_EMPTY;
 584 }
 585
 586 static void
 587 setup_my_cxt(pTHX_ pMY_CXT){
 588     MY_CXT.universal_isa = gv_fetchpvs("UNIVERSAL::isa", GV_ADD, SVt_PVCV);
 589     SvREFCNT_inc_simple_void_NN(MY_CXT.universal_isa);
 590
 591     MY_CXT.universal_can = gv_fetchpvs("UNIVERSAL::can", GV_ADD, SVt_PVCV);
 592     SvREFCNT_inc_simple_void_NN(MY_CXT.universal_can);
 593
 594     MY_CXT.tc_extra_args = NULL;
 595 }
 596
 597 #define DEFINE_TC(name) mouse_tc_generate(aTHX_ "Mouse::Util::TypeConstraints::" STRINGIFY(name), CAT2(mouse_tc_, name), NULL)
 598
 599 #define MTC_CLASS "Mouse::Meta::TypeConstraint"
 600
 601 MODULE = Mouse::Util::TypeConstraints    PACKAGE = Mouse::Util::TypeConstraints
 602
 603 PROTOTYPES:   DISABLE
 604 VERSIONCHECK: DISABLE
 605
 606 BOOT:
 607 {
 608     MY_CXT_INIT;
 609     setup_my_cxt(aTHX_ aMY_CXT);
 610
 611     /* setup built-in type constraints */
 612     DEFINE_TC(Any);
 613     DEFINE_TC(Undef);
 614     DEFINE_TC(Defined);
 615     DEFINE_TC(Bool);
 616     DEFINE_TC(Value);
 617     DEFINE_TC(Ref);
 618     DEFINE_TC(Str);
 619     DEFINE_TC(Num);
 620     DEFINE_TC(Int);
 621     DEFINE_TC(ScalarRef);
 622     DEFINE_TC(ArrayRef);
 623     DEFINE_TC(HashRef);
 624     DEFINE_TC(CodeRef);
 625     DEFINE_TC(GlobRef);
 626     DEFINE_TC(FileHandle);
 627     DEFINE_TC(RegexpRef);
 628     DEFINE_TC(Object);
 629     DEFINE_TC(ClassName);
 630     DEFINE_TC(RoleName);
 631 }
 632
 633 #ifdef USE_ITHREADS
 634
 635 void
 636 CLONE(...)
 637 CODE:
 638 {
 639     MY_CXT_CLONE;
 640     setup_my_cxt(aTHX_ aMY_CXT);
 641     PERL_UNUSED_VAR(items);
 642 }
 643
 644 #endif /* !USE_ITHREADS */
 645
 646 #define MOUSE_TC_MAYBE     0
 647 #define MOUSE_TC_ARRAY_REF 1
 648 #define MOUSE_TC_HASH_REF  2
 649
 650 CV*
 651 _parameterize_ArrayRef_for(SV* param)
 652 ALIAS:
 653     _parameterize_ArrayRef_for = MOUSE_TC_ARRAY_REF
 654     _parameterize_HashRef_for  = MOUSE_TC_HASH_REF
 655     _parameterize_Maybe_for    = MOUSE_TC_MAYBE
 656 CODE:
 657 {
 658     check_fptr_t fptr;
 659     SV* const tc_code = mcall0s(param, "_compiled_type_constraint");
 660     if(!IsCodeRef(tc_code)){
 661         croak("_compiled_type_constraint didn't return a CODE reference");
 662     }
 663
 664     switch(ix){
 665     case MOUSE_TC_ARRAY_REF:
 666         fptr = mouse_parameterized_ArrayRef;
 667         break;
 668     case MOUSE_TC_HASH_REF:
 669         fptr = mouse_parameterized_HashRef;
 670         break;
 671     default: /* Maybe type */
 672         fptr = mouse_parameterized_Maybe;
 673     }
 674     RETVAL = mouse_tc_generate(aTHX_ NULL, fptr, tc_code);
 675 }
 676 OUTPUT:
 677     RETVAL
 678
 679 MODULE = Mouse::Util::TypeConstraints    PACKAGE = Mouse::Meta::TypeConstraint
 680
 681 BOOT:
 682     INSTALL_SIMPLE_READER(TypeConstraint, name);
 683     INSTALL_SIMPLE_READER(TypeConstraint, parent);
 684     INSTALL_SIMPLE_READER(TypeConstraint, message);
 685
 686     INSTALL_SIMPLE_READER(TypeConstraint, type_parameter);
 687
 688     INSTALL_SIMPLE_READER_WITH_KEY(TypeConstraint, _compiled_type_constraint, compiled_type_constraint);
 689
 690     INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion);
 691     INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, __is_parameterized, type_parameter); /* Mouse specific */
 692
 693     /* overload stuff */
 694     PL_amagic_generation++;
 695     (void)newXS( MTC_CLASS "::()",
 696         XS_Mouse_TypeConstraint_fallback, file);
 697
 698     /* fallback => 1 */
 699     sv_setsv(
 700         get_sv( MTC_CLASS "::()", GV_ADD ),
 701         &PL_sv_yes
 702     );
 703
 704     /* '""' => '_as_string' */
 705     {
 706         SV* const code_ref = sv_2mortal(newRV_inc(
 707             (SV*)get_cv( MTC_CLASS "::_as_string", GV_ADD )));
 708         sv_setsv_mg(
 709             (SV*)gv_fetchpvs( MTC_CLASS "::(\"\"", GV_ADDMULTI, SVt_PVCV ),
 710             code_ref );
 711     }
 712
 713     /* '0+' => '_identity' */
 714     {
 715         SV* const code_ref = sv_2mortal(newRV_inc(
 716             (SV*)get_cv( MTC_CLASS "::_identity", GV_ADD )));
 717         sv_setsv_mg(
 718             (SV*)gv_fetchpvs( MTC_CLASS "::(0+", GV_ADDMULTI, SVt_PVCV ),
 719             code_ref );
 720     }
 721
 722     /* '|' => '_unite' */
 723     {
 724         SV* const code_ref = sv_2mortal(newRV_inc(
 725             (SV*)get_cv( MTC_CLASS "::_unite", GV_ADD )));
 726         sv_setsv_mg(
 727             (SV*)gv_fetchpvs( MTC_CLASS "::(|", GV_ADDMULTI, SVt_PVCV ),
 728             code_ref );
 729     }
 730
 731 UV
 732 _identity(SV* self, ...)
 733 CODE:
 734 {
 735     if(!SvROK(self)) {
 736         croak("Invalid object instance: '%"SVf"'", self);
 737     }
 738     RETVAL = PTR2UV(SvRV(self));
 739 }
 740 OUTPUT:
 741     RETVAL
 742
 743 void
 744 compile_type_constraint(SV* self)
 745 CODE:
 746 {
 747     AV* const checks = newAV_mortal();
 748     SV* check; /* check function */
 749     SV* parent;
 750     SV* types_ref;
 751
 752     for(parent = get_slots(self, "parent"); parent; parent = get_slots(parent, "parent")){
 753         check = get_slots(parent, "hand_optimized_type_constraint");
 754         if(check && SvOK(check)){
 755             if(!IsCodeRef(check)){
 756                 croak("Not a CODE reference");
 757             }
 758             av_unshift(checks, 1);
 759             av_store(checks, 0, newSVsv(check));
 760             break; /* a hand optimized constraint must include all the parent */
 761         }
 762
 763         check = get_slots(parent, "constraint");
 764         if(check && SvOK(check)){
 765             if(!mouse_tc_CodeRef(aTHX_ NULL, check)){
 766                 croak("Not a CODE reference");
 767             }
 768             av_unshift(checks, 1);
 769             av_store(checks, 0, newSVsv(check));
 770         }
 771     }
 772
 773     check = get_slots(self, "constraint");
 774     if(check && SvOK(check)){
 775         if(!mouse_tc_CodeRef(aTHX_ NULL, check)){
 776             croak("Not a CODE reference");
 777         }
 778         av_push(checks, newSVsv(check));
 779     }
 780
 781     types_ref = get_slots(self, "type_constraints");
 782     if(types_ref && SvOK(types_ref)){ /* union type */
 783         AV* types;
 784         AV* union_checks;
 785         CV* union_check;
 786         I32 len;
 787         I32 i;
 788
 789         if(!IsArrayRef(types_ref)){
 790             croak("Not an ARRAY reference");
 791         }
 792         types = (AV*)SvRV(types_ref);
 793         len = av_len(types) + 1;
 794
 795         union_checks = newAV_mortal();
 796
 797         for(i = 0; i < len; i++){
 798             SV* const tc = *av_fetch(types, i, TRUE);
 799             SV* const c  = get_slots(tc, "compiled_type_constraint");
 800             if(!(c && mouse_tc_CodeRef(aTHX_ NULL, c))){
 801                 mouse_throw_error(self, c, "'%"SVf"' has no compiled type constraint", self);
 802             }
 803             av_push(union_checks, newSVsv(c));
 804         }
 805
 806         union_check = mouse_tc_generate(aTHX_ NULL, (check_fptr_t)mouse_types_union_check, (SV*)union_checks);
 807         av_push(checks, newRV_inc((SV*)union_check));
 808     }
 809
 810     if(AvFILLp(checks) < 0){
 811         check = newRV_inc((SV*)get_cv("Mouse::Util::TypeConstraints::Any", TRUE));
 812     }
 813     else{
 814         check = newRV_inc((SV*)mouse_tc_generate(aTHX_ NULL, (check_fptr_t)mouse_types_check, (SV*)checks));
 815     }
 816     (void)set_slots(self, "compiled_type_constraint", check);
 817 }
 818
 819 bool
 820 check(SV* self, SV* sv, ...)
 821 CODE:
 822 {
 823     SV* const check = get_slots(self, "compiled_type_constraint");
 824     if(!(check && IsCodeRef(check))){
 825         mouse_throw_error(self, check,
 826             "'%"SVf"' has no compiled type constraint", self);
 827     }
 828     if( items > 2 ) {
 829         int i;
 830         AV* av;
 831         dMY_CXT;
 832         SAVESPTR(MY_CXT.tc_extra_args);
 833         av = MY_CXT.tc_extra_args = newAV_mortal();
 834         av_extend(av, items - 3);
 835         for(i = 2; i < items; i++) {
 836             av_push(av, SvREFCNT_inc_NN( ST(i) ) );
 837         }
 838     }
 839     RETVAL = mouse_tc_check(aTHX_ check, sv) ? TRUE : FALSE;
 840 }
 841 OUTPUT:
 842     RETVAL
 843