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* cv;
  22     assert(SvROK(tc_code) && SvTYPE(SvRV(tc_code)));
  23
  24     cv = (CV*)SvRV(tc_code);
  25
  26     if(CvISXSUB(cv)){ /* can be built-in tc */
  27         if(CvXSUB(cv) == XS_Mouse__Util__TypeConstraints_Item){
  28             assert(CvXSUBANY(cv).any_iv > 0);
  29
  30             return mouse_builtin_tc_check(aTHX_ CvXSUBANY(cv).any_iv, sv);
  31         }
  32         else if(CvXSUB(cv) == XS_Mouse_parameterized_check){
  33             MAGIC* const mg = (MAGIC*)CvXSUBANY(cv).any_ptr;
  34
  35             assert(CvXSUBANY(cv).any_ptr != NULL);
  36             return CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj /* stash */, 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 /*
 284  *  This class_type generator is taken from Scalar::Util::Instance
 285  */
 286
 287 #define MY_CXT_KEY "Mouse::Util::TypeConstraints::_guts" XS_VERSION
 288 typedef struct sui_cxt{
 289     GV* universal_isa;
 290 } my_cxt_t;
 291 START_MY_CXT
 292
 293 #define MG_klass_stash(mg) ((HV*)(mg)->mg_obj)
 294 #define MG_klass_pv(mg)    ((mg)->mg_ptr)
 295 #define MG_klass_len(mg)   ((mg)->mg_len)
 296
 297 static const char*
 298 mouse_canonicalize_package_name(const char* name){
 299
 300     /* "::Foo" -> "Foo" */
 301     if(name[0] == ':' && name[1] == ':'){
 302         name += 2;
 303     }
 304
 305     /* "main::main::main::Foo" -> "Foo" */
 306     while(strnEQ(name, "main::", sizeof("main::")-1)){
 307         name += sizeof("main::")-1;
 308     }
 309
 310     return name;
 311 }
 312
 313 static int
 314 mouse_lookup_isa(pTHX_ HV* const instance_stash, const char* const klass_pv){
 315     AV*  const linearized_isa = mro_get_linear_isa(instance_stash);
 316     SV**       svp            = AvARRAY(linearized_isa);
 317     SV** const end            = svp + AvFILLp(linearized_isa) + 1;
 318
 319     while(svp != end){
 320         assert(SvPVX(*svp));
 321         if(strEQ(klass_pv, mouse_canonicalize_package_name(SvPVX(*svp)))){
 322             return TRUE;
 323         }
 324         svp++;
 325     }
 326     return FALSE;
 327 }
 328
 329 int
 330 mouse_is_an_instance_of(pTHX_ HV* const stash, SV* const instance){
 331     assert(stash);
 332     assert(SvTYPE(stash) == SVt_PVHV);
 333
 334     if(IsObject(instance)){
 335         dMY_CXT;
 336         HV* const instance_stash = SvSTASH(SvRV(instance));
 337         GV* const instance_isa   = gv_fetchmeth_autoload(instance_stash, "isa", sizeof("isa")-1, 0);
 338
 339         /* the instance has no own isa method */
 340         if(instance_isa == NULL || GvCV(instance_isa) == GvCV(MY_CXT.universal_isa)){
 341             return stash == instance_stash
 342                 || mouse_lookup_isa(aTHX_ instance_stash, HvNAME_get(stash));
 343         }
 344         /* the instance has its own isa method */
 345         else {
 346             int retval;
 347             dSP;
 348
 349             ENTER;
 350             SAVETMPS;
 351
 352             PUSHMARK(SP);
 353             EXTEND(SP, 2);
 354             PUSHs(instance);
 355             mPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash));
 356             PUTBACK;
 357
 358             call_sv((SV*)instance_isa, G_SCALAR);
 359
 360             SPAGAIN;
 361
 362             retval = SvTRUEx(POPs);
 363
 364             PUTBACK;
 365
 366             FREETMPS;
 367             LEAVE;
 368
 369             return retval;
 370         }
 371     }
 372     return FALSE;
 373 }
 374
 375 static int
 376 mouse_is_an_instance_of_universal(pTHX_ SV* const data, SV* const sv){
 377     PERL_UNUSED_ARG(data);
 378     return SvROK(sv) && SvOBJECT(SvRV(sv));
 379 }
 380
 381 static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */
 382
 383 CV*
 384 mouse_generate_isa_predicate_for(pTHX_ SV* const klass, const char* const predicate_name){
 385     STRLEN klass_len;
 386     const char* klass_pv = SvPV_const(klass, klass_len);
 387     CV* xsub;
 388     SV*   mg_obj;
 389     void* mg_ptr;
 390
 391     klass_pv = mouse_canonicalize_package_name(klass_pv);
 392
 393     if(strNE(klass_pv, "UNIVERSAL")){
 394         mg_obj = (SV*)gv_stashpvn(klass_pv, klass_len, GV_ADD);
 395         mg_ptr = (void*)mouse_is_an_instance_of;
 396
 397     }
 398     else{
 399         mg_obj = NULL;
 400         mg_ptr = (void*)mouse_is_an_instance_of_universal;
 401     }
 402
 403     xsub = newXS(predicate_name, XS_Mouse_parameterized_check, __FILE__);
 404
 405     CvXSUBANY(xsub).any_ptr = sv_magicext(
 406         (SV*)xsub,
 407         mg_obj,
 408         PERL_MAGIC_ext,
 409         &mouse_util_type_constraints_vtbl,
 410         mg_ptr,
 411         0   /* indicates static data */
 412     );
 413
 414     if(!predicate_name){
 415         sv_2mortal((SV*)xsub);
 416     }
 417
 418     return xsub;
 419 }
 420
 421 XS(XS_Mouse_parameterized_check) {
 422     dVAR;
 423     dXSARGS;
 424     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
 425
 426     if(items < 1){
 427         croak("Too few arguments for parameterized check functions");
 428     }
 429
 430     SvGETMAGIC( ST(0) );
 431     ST(0) = boolSV( CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, ST(0)) );
 432     XSRETURN(1);
 433 }
 434
 435 static void
 436 setup_my_cxt(pTHX_ pMY_CXT){
 437     MY_CXT.universal_isa = gv_fetchpvs("UNIVERSAL::isa", GV_ADD, SVt_PVCV);
 438     SvREFCNT_inc_simple_void_NN(MY_CXT.universal_isa);
 439 }
 440
 441 MODULE = Mouse::Util::TypeConstraints    PACKAGE = Mouse::Util::TypeConstraints
 442
 443 PROTOTYPES:   DISABLE
 444 VERSIONCHECK: DISABLE
 445
 446 BOOT:
 447 {
 448     MY_CXT_INIT;
 449     setup_my_cxt(aTHX_ aMY_CXT);
 450 }
 451
 452 #ifdef USE_ITHREADS
 453
 454 void
 455 CLONE(...)
 456 CODE:
 457 {
 458     MY_CXT_CLONE;
 459     setup_my_cxt(aTHX_ aMY_CXT);
 460     PERL_UNUSED_VAR(items);
 461 }
 462
 463 #endif /* !USE_ITHREADS */
 464
 465 void
 466 Item(SV* sv = &PL_sv_undef)
 467 ALIAS:
 468     Any        = MOUSE_TC_ANY
 469     Item       = MOUSE_TC_ITEM
 470     Undef      = MOUSE_TC_UNDEF
 471     Defined    = MOUSE_TC_DEFINED
 472     Bool       = MOUSE_TC_BOOL
 473     Value      = MOUSE_TC_VALUE
 474     Ref        = MOUSE_TC_REF
 475     Str        = MOUSE_TC_STR
 476     Num        = MOUSE_TC_NUM
 477     Int        = MOUSE_TC_INT
 478     ScalarRef  = MOUSE_TC_SCALAR_REF
 479     ArrayRef   = MOUSE_TC_ARRAY_REF
 480     HashRef    = MOUSE_TC_HASH_REF
 481     CodeRef    = MOUSE_TC_CODE_REF
 482     GlobRef    = MOUSE_TC_GLOB_REF
 483     FileHandle = MOUSE_TC_FILEHANDLE
 484     RegexpRef  = MOUSE_TC_REGEXP_REF
 485     Object     = MOUSE_TC_OBJECT
 486     ClassName  = MOUSE_TC_CLASS_NAME
 487     RoleName   = MOUSE_TC_ROLE_NAME
 488 CODE:
 489     SvGETMAGIC(sv);
 490     ST(0) = boolSV( mouse_builtin_tc_check(aTHX_ ix, sv) );
 491     XSRETURN(1);
 492
 493