xs-src/MouseTypeConstraints.xs

   1 /*
   2  *   full definition of built-in type constraints (ware in Moose::Util::TypeConstraints::OptimizedConstraints)
   3  */
   4
   5 #include "mouse.h"
   6
   7 #if PERL_BCDVERSION >= 0x5008005
   8 #define LooksLikeNumber(sv) looks_like_number(sv)
   9 #else
  10 #define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : SvNIOKp(sv) )
  11 #endif
  12
  13 #ifndef SvRXOK
  14 #define SvRXOK(sv) (SvROK(sv) && SvMAGICAL(SvRV(sv)) && mg_find(SvRV(sv), PERL_MAGIC_qr))
  15 #endif
  16
  17 typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv);
  18
  19 int
  20 mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) {
  21     CV* const cv = (CV*)SvRV(tc_code);
  22     assert(SvTYPE(cv) == Svt_PVCV);
  23
  24     if(CvISXSUB(cv)){ /* can be built-in tc */
  25         if(CvXSUB(cv) == XS_Mouse__Util__TypeConstraints_Item){
  26             assert(CvXSUBANY(cv).any_iv > 0);
  27
  28             return mouse_builtin_tc_check(aTHX_ CvXSUBANY(cv).any_iv, sv);
  29         }
  30         else if(CvXSUB(cv) == XS_Mouse_parameterized_check){
  31             MAGIC* const mg = (MAGIC*)CvXSUBANY(cv).any_ptr;
  32
  33             assert(CvXSUBANY(cv).any_ptr != NULL);
  34
  35             /* call the check function directly, skipping call_sv() */
  36             return CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv);
  37         }
  38     }
  39
  40     /* user-defined type constraints */
  41     {
  42         int ok;
  43         dSP;
  44
  45         ENTER;
  46         SAVETMPS;
  47
  48         PUSHMARK(SP);
  49         XPUSHs(sv);
  50         PUTBACK;
  51
  52         call_sv(tc_code, G_SCALAR);
  53
  54         SPAGAIN;
  55         ok = SvTRUEx(POPs);
  56         PUTBACK;
  57
  58         FREETMPS;
  59         LEAVE;
  60
  61         return ok;
  62     }
  63 }
  64
  65 int
  66 mouse_builtin_tc_check(pTHX_ mouse_tc const tc, SV* const sv) {
  67     switch(tc){
  68     case MOUSE_TC_ANY:        return mouse_tc_Any(aTHX_ sv);
  69     case MOUSE_TC_ITEM:       return mouse_tc_Any(aTHX_ sv);
  70     case MOUSE_TC_UNDEF:      return mouse_tc_Undef(aTHX_ sv);
  71     case MOUSE_TC_DEFINED:    return mouse_tc_Defined(aTHX_ sv);
  72     case MOUSE_TC_BOOL:       return mouse_tc_Bool(aTHX_ sv);
  73     case MOUSE_TC_VALUE:      return mouse_tc_Value(aTHX_ sv);
  74     case MOUSE_TC_REF:        return mouse_tc_Ref(aTHX_ sv);
  75     case MOUSE_TC_STR:        return mouse_tc_Str(aTHX_ sv);
  76     case MOUSE_TC_NUM:        return mouse_tc_Num(aTHX_ sv);
  77     case MOUSE_TC_INT:        return mouse_tc_Int(aTHX_ sv);
  78     case MOUSE_TC_SCALAR_REF: return mouse_tc_ScalarRef(aTHX_ sv);
  79     case MOUSE_TC_ARRAY_REF:  return mouse_tc_ArrayRef(aTHX_ sv);
  80     case MOUSE_TC_HASH_REF:   return mouse_tc_HashRef(aTHX_ sv);
  81     case MOUSE_TC_CODE_REF:   return mouse_tc_CodeRef(aTHX_ sv);
  82     case MOUSE_TC_GLOB_REF:   return mouse_tc_GlobRef(aTHX_ sv);
  83     case MOUSE_TC_FILEHANDLE: return mouse_tc_FileHandle(aTHX_ sv);
  84     case MOUSE_TC_REGEXP_REF: return mouse_tc_RegexpRef(aTHX_ sv);
  85     case MOUSE_TC_OBJECT:     return mouse_tc_Object(aTHX_ sv);
  86     case MOUSE_TC_CLASS_NAME: return mouse_tc_ClassName(aTHX_ sv);
  87     case MOUSE_TC_ROLE_NAME:  return mouse_tc_RoleName(aTHX_ sv);
  88     default:
  89         NOOP;
  90     }
  91
  92     croak("Mouse-panic: unrecognized type constraint id: %d", (int)tc);
  93     return FALSE; /* not reached */
  94 }
  95
  96
  97 /*
  98     The following type check functions return an integer, not a bool, to keep them simple,
  99     so if you assign these return value to bool variable, you must use "expr ? TRUE : FALSE".
 100 */
 101
 102 int
 103 mouse_tc_Any(pTHX_ SV* const sv PERL_UNUSED_DECL) {
 104     assert(sv);
 105     return TRUE;
 106 }
 107
 108 int
 109 mouse_tc_Bool(pTHX_ SV* const sv) {
 110     assert(sv);
 111
 112     if(SvTRUE(sv)){
 113         if(SvIOKp(sv)){
 114             return SvIVX(sv) == 1;
 115         }
 116         else if(SvNOKp(sv)){
 117             return SvNVX(sv) == 1.0;
 118         }
 119         else if(SvPOKp(sv)){ /* "1" */
 120             return SvCUR(sv) == 1 && SvPVX(sv)[0] == '1';
 121         }
 122         else{
 123             return FALSE;
 124         }
 125     }
 126     else{
 127         /* false must be boolean */
 128         return TRUE;
 129     }
 130 }
 131
 132 int
 133 mouse_tc_Undef(pTHX_ SV* const sv) {
 134     assert(sv);
 135     return !SvOK(sv);
 136 }
 137
 138 int
 139 mouse_tc_Defined(pTHX_ SV* const sv) {
 140     assert(sv);
 141     return SvOK(sv);
 142 }
 143
 144 int
 145 mouse_tc_Value(pTHX_ SV* const sv) {
 146     assert(sv);
 147     return SvOK(sv) && !SvROK(sv);
 148 }
 149
 150 int
 151 mouse_tc_Num(pTHX_ SV* const sv) {
 152     assert(sv);
 153     return LooksLikeNumber(sv);
 154 }
 155
 156 int
 157 mouse_tc_Int(pTHX_ SV* const sv) {
 158     assert(sv);
 159     if(SvIOKp(sv)){
 160         return TRUE;
 161     }
 162     else if(SvNOKp(sv)){
 163         NV const nv = SvNVX(sv);
 164         return nv > 0 ? (nv == (NV)(UV)nv) : (nv == (NV)(IV)nv);
 165     }
 166     else if(SvPOKp(sv)){
 167         int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL);
 168         if(num_type){
 169             return !(num_type & IS_NUMBER_NOT_INT);
 170         }
 171     }
 172     return FALSE;
 173 }
 174
 175 int
 176 mouse_tc_Str(pTHX_ SV* const sv) {
 177     assert(sv);
 178     return SvOK(sv) && !SvROK(sv) && !isGV(sv);
 179 }
 180
 181 int
 182 mouse_tc_ClassName(pTHX_ SV* const sv){
 183     assert(sv);
 184     return is_class_loaded(sv);
 185 }
 186
 187 int
 188 mouse_tc_RoleName(pTHX_ SV* const sv) {
 189     assert(sv);
 190     if(is_class_loaded(sv)){
 191         int ok;
 192         SV* meta;
 193         dSP;
 194
 195         ENTER;
 196         SAVETMPS;
 197
 198         PUSHMARK(SP);
 199         XPUSHs(sv);
 200         PUTBACK;
 201         call_pv("Mouse::Util::get_metaclass_by_name", G_SCALAR);
 202         SPAGAIN;
 203         meta = POPs;
 204         PUTBACK;
 205
 206         ok =  is_an_instance_of("Mouse::Meta::Role", meta);
 207
 208         FREETMPS;
 209         LEAVE;
 210
 211         return ok;
 212     }
 213     return FALSE;
 214 }
 215
 216 int
 217 mouse_tc_Ref(pTHX_ SV* const sv) {
 218     assert(sv);
 219     return SvROK(sv);
 220 }
 221
 222 int
 223 mouse_tc_ScalarRef(pTHX_ SV* const sv) {
 224     assert(sv);
 225     return SvROK(sv) && !SvOBJECT(SvRV(sv)) && (SvTYPE(SvRV(sv)) <= SVt_PVLV && !isGV(SvRV(sv)));
 226 }
 227
 228 int
 229 mouse_tc_ArrayRef(pTHX_ SV* const sv) {
 230     assert(sv);
 231     return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVAV;
 232 }
 233
 234 int
 235 mouse_tc_HashRef(pTHX_ SV* const sv) {
 236     assert(sv);
 237     return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVHV;
 238 }
 239
 240 int
 241 mouse_tc_CodeRef(pTHX_ SV* const sv) {
 242     assert(sv);
 243     return SvROK(sv)  && !SvOBJECT(SvRV(sv))&& SvTYPE(SvRV(sv)) == SVt_PVCV;
 244 }
 245
 246 int
 247 mouse_tc_RegexpRef(pTHX_ SV* const sv) {
 248     assert(sv);
 249     return SvRXOK(sv);
 250 }
 251
 252 int
 253 mouse_tc_GlobRef(pTHX_ SV* const sv) {
 254     assert(sv);
 255     return SvROK(sv) && !SvOBJECT(SvRV(sv)) && isGV(SvRV(sv));
 256 }
 257
 258 int
 259 mouse_tc_FileHandle(pTHX_ SV* const sv) {
 260     GV* gv;
 261     assert(sv);
 262
 263     /* see pp_fileno() in pp_sys.c and Scalar::Util::openhandle() */
 264
 265     gv = (GV*)(SvROK(sv) ? SvRV(sv) : sv);
 266     if(isGV(gv) || SvTYPE(gv) == SVt_PVIO){
 267         IO* const io = isGV(gv) ? GvIO(gv) : (IO*)gv;
 268
 269         if(io && ( IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar) )){
 270             return TRUE;
 271         }
 272     }
 273
 274     return is_an_instance_of("IO::Handle", sv);
 275 }
 276
 277 int
 278 mouse_tc_Object(pTHX_ SV* const sv) {
 279     assert(sv);
 280     return SvROK(sv) && SvOBJECT(SvRV(sv)) && !SvRXOK(sv);
 281 }
 282
 283 /* Parameterized type constraints */
 284
 285 int
 286 mouse_parameterized_ArrayRef(pTHX_ SV* const param, SV* const sv) {
 287     if(mouse_tc_ArrayRef(aTHX_ sv)){
 288         AV* const av  = (AV*)SvRV(sv);
 289         I32 const len = av_len(av) + 1;
 290         I32 i;
 291         for(i = 0; i < len; i++){
 292             SV* const value = *av_fetch(av, i, TRUE);
 293             SvGETMAGIC(value);
 294             if(!mouse_tc_check(aTHX_ param, value)){
 295                 return FALSE;
 296             }
 297         }
 298         return TRUE;
 299     }
 300     return FALSE;
 301 }
 302
 303 int
 304 mouse_parameterized_HashRef(pTHX_ SV* const param, SV* const sv) {
 305     if(mouse_tc_HashRef(aTHX_ sv)){
 306         HV* const hv  = (HV*)SvRV(sv);
 307         HE* he;
 308
 309         hv_iterinit(hv);
 310         while((he = hv_iternext(hv))){
 311             SV* const value = hv_iterval(hv, he);
 312             SvGETMAGIC(value);
 313             if(!mouse_tc_check(aTHX_ param, value)){
 314                 return FALSE;
 315             }
 316         }
 317         return TRUE;
 318     }
 319     return FALSE;
 320 }
 321
 322 int
 323 mouse_parameterized_Maybe(pTHX_ SV* const param, SV* const sv) {
 324     if(SvOK(sv)){
 325         return mouse_tc_check(aTHX_ param, sv);
 326     }
 327     return TRUE;
 328 }
 329
 330 /*
 331  *  This class_type generator is taken from Scalar::Util::Instance
 332  */
 333
 334 #define MY_CXT_KEY "Mouse::Util::TypeConstraints::_guts" XS_VERSION
 335 typedef struct sui_cxt{
 336     GV* universal_isa;
 337 } my_cxt_t;
 338 START_MY_CXT
 339
 340 #define MG_klass_stash(mg) ((HV*)(mg)->mg_obj)
 341 #define MG_klass_pv(mg)    ((mg)->mg_ptr)
 342 #define MG_klass_len(mg)   ((mg)->mg_len)
 343
 344 static const char*
 345 mouse_canonicalize_package_name(const char* name){
 346
 347     /* "::Foo" -> "Foo" */
 348     if(name[0] == ':' && name[1] == ':'){
 349         name += 2;
 350     }
 351
 352     /* "main::main::main::Foo" -> "Foo" */
 353     while(strnEQ(name, "main::", sizeof("main::")-1)){
 354         name += sizeof("main::")-1;
 355     }
 356
 357     return name;
 358 }
 359
 360 static int
 361 mouse_lookup_isa(pTHX_ HV* const instance_stash, const char* const klass_pv){
 362     AV*  const linearized_isa = mro_get_linear_isa(instance_stash);
 363     SV**       svp            = AvARRAY(linearized_isa);
 364     SV** const end            = svp + AvFILLp(linearized_isa) + 1;
 365
 366     while(svp != end){
 367         assert(SvPVX(*svp));
 368         if(strEQ(klass_pv, mouse_canonicalize_package_name(SvPVX(*svp)))){
 369             return TRUE;
 370         }
 371         svp++;
 372     }
 373     return FALSE;
 374 }
 375
 376 int
 377 mouse_is_an_instance_of(pTHX_ HV* const stash, SV* const instance){
 378     assert(stash);
 379     assert(SvTYPE(stash) == SVt_PVHV);
 380
 381     if(IsObject(instance)){
 382         dMY_CXT;
 383         HV* const instance_stash = SvSTASH(SvRV(instance));
 384         GV* const instance_isa   = gv_fetchmeth_autoload(instance_stash, "isa", sizeof("isa")-1, 0);
 385
 386         /* the instance has no own isa method */
 387         if(instance_isa == NULL || GvCV(instance_isa) == GvCV(MY_CXT.universal_isa)){
 388             return stash == instance_stash
 389                 || mouse_lookup_isa(aTHX_ instance_stash, HvNAME_get(stash));
 390         }
 391         /* the instance has its own isa method */
 392         else {
 393             int retval;
 394             dSP;
 395
 396             ENTER;
 397             SAVETMPS;
 398
 399             PUSHMARK(SP);
 400             EXTEND(SP, 2);
 401             PUSHs(instance);
 402             mPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash));
 403             PUTBACK;
 404
 405             call_sv((SV*)instance_isa, G_SCALAR);
 406
 407             SPAGAIN;
 408
 409             retval = SvTRUEx(POPs);
 410
 411             PUTBACK;
 412
 413             FREETMPS;
 414             LEAVE;
 415
 416             return retval;
 417         }
 418     }
 419     return FALSE;
 420 }
 421
 422 static int
 423 mouse_is_an_instance_of_universal(pTHX_ SV* const data, SV* const sv){
 424     PERL_UNUSED_ARG(data);
 425     return SvROK(sv) && SvOBJECT(SvRV(sv));
 426 }
 427
 428 static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */
 429
 430 static CV*
 431 mouse_tc_parameterize(pTHX_ const char* const name, check_fptr_t const fptr, SV* const param) {
 432     CV* xsub;
 433
 434     xsub = newXS(name, XS_Mouse_parameterized_check, __FILE__);
 435     CvXSUBANY(xsub).any_ptr = sv_magicext(
 436         (SV*)xsub,
 437         param,       /* mg_obj: refcnt will be increased */
 438         PERL_MAGIC_ext,
 439         &mouse_util_type_constraints_vtbl,
 440         (void*)fptr, /* mg_ptr */
 441         0            /* mg_len: 0 for static data */
 442     );
 443
 444     if(!name){
 445         sv_2mortal((SV*)xsub);
 446     }
 447
 448     return xsub;
 449 }
 450
 451 CV*
 452 mouse_generate_isa_predicate_for(pTHX_ SV* const klass, const char* const predicate_name){
 453     STRLEN klass_len;
 454     const char* klass_pv = SvPV_const(klass, klass_len);
 455     SV*   param;
 456     void* fptr;
 457
 458     klass_pv = mouse_canonicalize_package_name(klass_pv);
 459
 460     if(strNE(klass_pv, "UNIVERSAL")){
 461         param = (SV*)gv_stashpvn(klass_pv, klass_len, GV_ADD);
 462         fptr = (void*)mouse_is_an_instance_of;
 463
 464     }
 465     else{
 466         param = NULL;
 467         fptr = (void*)mouse_is_an_instance_of_universal;
 468     }
 469
 470     return mouse_tc_parameterize(aTHX_ predicate_name, fptr, param);
 471 }
 472
 473 XS(XS_Mouse_parameterized_check) {
 474     dVAR;
 475     dXSARGS;
 476     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 477
 478     if(items < 1){
 479         croak("Too few arguments for parameterized check functions");
 480     }
 481
 482     SvGETMAGIC( ST(0) );
 483     ST(0) = boolSV( CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, ST(0)) );
 484     XSRETURN(1);
 485 }
 486
 487 static void
 488 setup_my_cxt(pTHX_ pMY_CXT){
 489     MY_CXT.universal_isa = gv_fetchpvs("UNIVERSAL::isa", GV_ADD, SVt_PVCV);
 490     SvREFCNT_inc_simple_void_NN(MY_CXT.universal_isa);
 491 }
 492
 493 MODULE = Mouse::Util::TypeConstraints    PACKAGE = Mouse::Util::TypeConstraints
 494
 495 PROTOTYPES:   DISABLE
 496 VERSIONCHECK: DISABLE
 497
 498 BOOT:
 499 {
 500     MY_CXT_INIT;
 501     setup_my_cxt(aTHX_ aMY_CXT);
 502 }
 503
 504 #ifdef USE_ITHREADS
 505
 506 void
 507 CLONE(...)
 508 CODE:
 509 {
 510     MY_CXT_CLONE;
 511     setup_my_cxt(aTHX_ aMY_CXT);
 512     PERL_UNUSED_VAR(items);
 513 }
 514
 515 #endif /* !USE_ITHREADS */
 516
 517 void
 518 Item(SV* sv = &PL_sv_undef)
 519 ALIAS:
 520     Any        = MOUSE_TC_ANY
 521     Item       = MOUSE_TC_ITEM
 522     Undef      = MOUSE_TC_UNDEF
 523     Defined    = MOUSE_TC_DEFINED
 524     Bool       = MOUSE_TC_BOOL
 525     Value      = MOUSE_TC_VALUE
 526     Ref        = MOUSE_TC_REF
 527     Str        = MOUSE_TC_STR
 528     Num        = MOUSE_TC_NUM
 529     Int        = MOUSE_TC_INT
 530     ScalarRef  = MOUSE_TC_SCALAR_REF
 531     ArrayRef   = MOUSE_TC_ARRAY_REF
 532     HashRef    = MOUSE_TC_HASH_REF
 533     CodeRef    = MOUSE_TC_CODE_REF
 534     GlobRef    = MOUSE_TC_GLOB_REF
 535     FileHandle = MOUSE_TC_FILEHANDLE
 536     RegexpRef  = MOUSE_TC_REGEXP_REF
 537     Object     = MOUSE_TC_OBJECT
 538     ClassName  = MOUSE_TC_CLASS_NAME
 539     RoleName   = MOUSE_TC_ROLE_NAME
 540 CODE:
 541     SvGETMAGIC(sv);
 542     ST(0) = boolSV( mouse_builtin_tc_check(aTHX_ ix, sv) );
 543     XSRETURN(1);
 544
 545
 546 CV*
 547 _parameterize_ArrayRef_for(SV* param)
 548 ALIAS:
 549     _parameterize_ArrayRef_for = MOUSE_TC_ARRAY_REF
 550     _parameterize_HashRef_for  = MOUSE_TC_HASH_REF
 551     _parameterize_Maybe_for    = MOUSE_TC_MAYBE
 552 CODE:
 553 {
 554     check_fptr_t fptr;
 555     SV* const tc_code = mcall0s(param, "_compiled_type_constraint");
 556     if(!(SvROK(tc_code) && SvTYPE(SvRV(tc_code)) == SVt_PVCV)){
 557         croak("_compiled_type_constraint didn't return a CODE reference");
 558     }
 559
 560     switch(ix){
 561     case MOUSE_TC_ARRAY_REF:
 562         fptr = mouse_parameterized_ArrayRef;
 563         break;
 564     case MOUSE_TC_HASH_REF:
 565         fptr = mouse_parameterized_HashRef;
 566         break;
 567     default: /* Maybe type */
 568         fptr = mouse_parameterized_Maybe;
 569     }
 570     RETVAL = mouse_tc_parameterize(aTHX_ NULL, fptr, tc_code);
 571 }
 572 OUTPUT:
 573     RETVAL
 574