Refactor tc parametarization
[gitmo/Mouse.git] / xs-src / MouseTypeConstraints.xs
index 08e49af..6c84858 100644 (file)
 #define SvRXOK(sv) (SvROK(sv) && SvMAGICAL(SvRV(sv)) && mg_find(SvRV(sv), PERL_MAGIC_qr))
 #endif
 
+typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv);
+
 int
 mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) {
-    if(SvIOK(tc_code)){ /* built-in type constraints */
-        return mouse_builtin_tc_check(aTHX_ SvIVX(tc_code), sv);
+    CV* const cv = (CV*)SvRV(tc_code);
+    assert(SvTYPE(cv) == Svt_PVCV);
+
+    if(CvISXSUB(cv)){ /* can be built-in tc */
+        if(CvXSUB(cv) == XS_Mouse__Util__TypeConstraints_Item){
+            assert(CvXSUBANY(cv).any_iv > 0);
+
+            return mouse_builtin_tc_check(aTHX_ CvXSUBANY(cv).any_iv, sv);
+        }
+        else if(CvXSUB(cv) == XS_Mouse_parameterized_check){
+            MAGIC* const mg = (MAGIC*)CvXSUBANY(cv).any_ptr;
+
+            assert(CvXSUBANY(cv).any_ptr != NULL);
+
+            /* call the check function directly, skipping call_sv() */
+            return CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv);
+        }
     }
-    else {
+
+    /* user-defined type constraints */
+    {
         int ok;
         dSP;
 
@@ -67,11 +86,10 @@ mouse_builtin_tc_check(pTHX_ mouse_tc const tc, SV* const sv) {
     case MOUSE_TC_CLASS_NAME: return mouse_tc_ClassName(aTHX_ sv);
     case MOUSE_TC_ROLE_NAME:  return mouse_tc_RoleName(aTHX_ sv);
     default:
-        /* custom type constraints */
         NOOP;
     }
 
-    croak("Custom type constraint is not yet implemented");
+    croak("Mouse-panic: unrecognized type constraint id: %d", (int)tc);
     return FALSE; /* not reached */
 }
 
@@ -90,22 +108,23 @@ mouse_tc_Any(pTHX_ SV* const sv PERL_UNUSED_DECL) {
 int
 mouse_tc_Bool(pTHX_ SV* const sv) {
     assert(sv);
-    if(SvOK(sv)){
+
+    if(SvTRUE(sv)){
         if(SvIOKp(sv)){
-            return SvIVX(sv) == 1 || SvIVX(sv) == 0;
+            return SvIVX(sv) == 1;
         }
         else if(SvNOKp(sv)){
-            return SvNVX(sv) == 1.0 || SvNVX(sv) == 0.0;
+            return SvNVX(sv) == 1.0;
         }
-        else if(SvPOKp(sv)){ /* "" or "1" or "0" */
-            return SvCUR(sv) == 0
-                || ( SvCUR(sv) == 1 && ( SvPVX(sv)[0] == '1' || SvPVX(sv)[0] == '0' ) );
+        else if(SvPOKp(sv)){ /* "1" */
+            return SvCUR(sv) == 1 && SvPVX(sv)[0] == '1';
         }
         else{
             return FALSE;
         }
     }
     else{
+        /* false must be boolean */
         return TRUE;
     }
 }
@@ -362,48 +381,51 @@ mouse_is_an_instance_of_universal(pTHX_ SV* const data, SV* const sv){
 static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */
 
 CV*
+mouse_tc_parameterize(pTHX_ const char* const name, check_fptr_t const fptr, SV* const param) {
+    CV* const xsub = newXS(name, XS_Mouse_parameterized_check, __FILE__);
+
+    CvXSUBANY(xsub).any_ptr = sv_magicext(
+        (SV*)xsub,
+        param,       /* mg_obj: refcnt will be increased */
+        PERL_MAGIC_ext,
+        &mouse_util_type_constraints_vtbl,
+        (void*)fptr, /* mg_ptr */
+        0            /* mg_len: 0 for static data */
+    );
+
+    if(!name){
+        sv_2mortal((SV*)xsub);
+    }
+
+    return xsub;
+}
+
+CV*
 mouse_generate_isa_predicate_for(pTHX_ SV* const klass, const char* const predicate_name){
     STRLEN klass_len;
     const char* klass_pv = SvPV_const(klass, klass_len);
-    CV* xsub;
-    SV*   mg_obj;
-    void* mg_ptr;
+    SV*   param;
+    void* fptr;
 
     klass_pv = mouse_canonicalize_package_name(klass_pv);
 
     if(strNE(klass_pv, "UNIVERSAL")){
-        mg_obj = (SV*)gv_stashpvn(klass_pv, klass_len, GV_ADD);
-        mg_ptr = (void*)mouse_is_an_instance_of;
+        param = (SV*)gv_stashpvn(klass_pv, klass_len, GV_ADD);
+        fptr = (void*)mouse_is_an_instance_of;
 
     }
     else{
-        mg_obj = NULL;
-        mg_ptr = (void*)mouse_is_an_instance_of_universal;
+        param = NULL;
+        fptr = (void*)mouse_is_an_instance_of_universal;
     }
 
-    xsub = newXS(predicate_name, XS_Mouse_parameterized_check, __FILE__);
-
-    CvXSUBANY(xsub).any_ptr = sv_magicext(
-        (SV*)xsub,
-        mg_obj,
-        PERL_MAGIC_ext,
-        &mouse_util_type_constraints_vtbl,
-        mg_ptr,
-        0   /* indicates static data */
-    );
-
-    if(!predicate_name){
-        sv_2mortal((SV*)xsub);
-    }
-
-    return xsub;
+    return mouse_tc_parameterize(aTHX_ predicate_name, fptr, param);
 }
 
 XS(XS_Mouse_parameterized_check) {
     dVAR;
     dXSARGS;
     MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
-    typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv);
 
     if(items < 1){
         croak("Too few arguments for parameterized check functions");