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