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