From: gfx <gfuji@cpan.org>
Date: Sat, 31 Oct 2009 06:53:52 +0000 (+0900)
Subject: Refactor tc parametarization
X-Git-Tag: 0.40_04~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=916eb82f3c42778bdb39cf0d9b1922ca1a264723;p=gitmo%2FMouse.git

Refactor tc parametarization
---

diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs
index 43800a2..6c84858 100644
--- a/xs-src/MouseTypeConstraints.xs
+++ b/xs-src/MouseTypeConstraints.xs
@@ -381,41 +381,45 @@ 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;
-    }
-
-    xsub = newXS(predicate_name, XS_Mouse_parameterized_check, __FILE__);
-
-    CvXSUBANY(xsub).any_ptr = sv_magicext(
-        (SV*)xsub,
-        mg_obj, /* refcnt will be increased */
-        PERL_MAGIC_ext,
-        &mouse_util_type_constraints_vtbl,
-        mg_ptr,
-        0   /* indicates static data */
-    );
-
-    if(!predicate_name){
-        sv_2mortal((SV*)xsub);
+        param = NULL;
+        fptr = (void*)mouse_is_an_instance_of_universal;
     }
 
-    return xsub;
+    return mouse_tc_parameterize(aTHX_ predicate_name, fptr, param);
 }
 
 XS(XS_Mouse_parameterized_check) {