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