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