Rework Perl SV to Clownfish object conversion Consolidate the main code paths of the two previous conversion functions XSBind_sv_to_cfish_obj and XSBind_perl_to_cfish, removing subtle differences.
One major effect is that hashrefs or arrayrefs passed to Clownfish functions taking a Clownfish::Obj will now be converted to a Hash or Vector, not a String. Only convert unblessed arrayrefs or hashrefs to Vector or Hash. Non-Clownfish objects will always be stringified. Remove support for passing AVs or HVs directly. Callers must pass a arrayref or hashref. Make XSBind_perl_to_cfish take a Class argument and guarantee that the returned object is of this class. Make XSBind_perl_to_cfish throw on undefined SVs. Add XSBind_perl_to_cfish_nullable that allows undef to NULL conversion. Rename XSBind_sv_to_cfish_obj to XSBind_perl_to_cfish_noinc. Remove XSBind_maybe_sv_to_cfish_obj. Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/8875d01e Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/8875d01e Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/8875d01e Branch: refs/heads/master Commit: 8875d01edb4f77dc95c85f59925389f9a3fc0e10 Parents: 2330790 Author: Nick Wellnhofer <wellnho...@aevum.de> Authored: Wed Aug 5 20:55:08 2015 +0200 Committer: Nick Wellnhofer <wellnho...@aevum.de> Committed: Sun Aug 23 13:16:48 2015 +0200 ---------------------------------------------------------------------- compiler/src/CFCPerl.c | 3 +- compiler/src/CFCPerlMethod.c | 2 +- compiler/src/CFCPerlTypeMap.c | 7 +- .../perl/buildlib/Clownfish/Build/Binding.pm | 9 +- runtime/perl/xs/XSBind.c | 204 ++++++++++--------- runtime/perl/xs/XSBind.h | 57 +++--- 6 files changed, 151 insertions(+), 131 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/8875d01e/compiler/src/CFCPerl.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerl.c b/compiler/src/CFCPerl.c index 2766da8..0b9f7b8 100644 --- a/compiler/src/CFCPerl.c +++ b/compiler/src/CFCPerl.c @@ -697,7 +697,8 @@ S_write_callbacks_c(CFCPerl *self) { "S_finish_callback_obj(pTHX_ void *vself, const char *meth_name,\n" " int nullable) {\n" " SV *return_sv = SI_do_callback_sv(aTHX_ meth_name);\n" - " cfish_Obj *retval = XSBind_perl_to_cfish(aTHX_ return_sv);\n" + " cfish_Obj *retval\n" + " = XSBind_perl_to_cfish_nullable(aTHX_ return_sv, CFISH_OBJ);\n" " FREETMPS;\n" " LEAVE;\n" " if (!nullable && !retval) {\n" http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/8875d01e/compiler/src/CFCPerlMethod.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlMethod.c b/compiler/src/CFCPerlMethod.c index 01db539..9e3704f 100644 --- a/compiler/src/CFCPerlMethod.c +++ b/compiler/src/CFCPerlMethod.c @@ -218,7 +218,7 @@ S_self_assign_statement(CFCPerlMethod *self) { CFCUtil_die("Not an object type: %s", type_c); } const char *class_var = CFCType_get_class_var(type); - char pattern[] = "arg_%s = (%s)XSBind_sv_to_cfish_obj(" + char pattern[] = "arg_%s = (%s)XSBind_perl_to_cfish_noinc(" "aTHX_ ST(0), %s, NULL);"; char *statement = CFCUtil_sprintf(pattern, self_name, type_c, class_var); http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/8875d01e/compiler/src/CFCPerlTypeMap.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlTypeMap.c b/compiler/src/CFCPerlTypeMap.c index 795fdde..ef76755 100644 --- a/compiler/src/CFCPerlTypeMap.c +++ b/compiler/src/CFCPerlTypeMap.c @@ -52,7 +52,8 @@ CFCPerlTypeMap_from_perl(CFCType *type, const char *xs_var) { else { allocation = "NULL"; } - const char pattern[] = "(%s*)XSBind_sv_to_cfish_obj(aTHX_ %s, %s, %s)"; + const char pattern[] + = "(%s*)XSBind_perl_to_cfish_noinc(aTHX_ %s, %s, %s)"; result = CFCUtil_sprintf(pattern, struct_sym, xs_var, class_var, allocation); } @@ -271,8 +272,8 @@ CFCPerlTypeMap_write_xs_typemap(CFCHierarchy *hierarchy) { } input = CFCUtil_cat(input, class_var, "_\n" " $var = (", full_struct_sym, - "*)XSBind_sv_to_cfish_obj(aTHX_ $arg, ", class_var, - ", ", allocation, ");\n\n", NULL); + "*)XSBind_perl_to_cfish_noinc(aTHX_ $arg, ", + class_var, ", ", allocation, ");\n\n", NULL); output = CFCUtil_cat(output, class_var, "_\n" " $arg = (SV*)CFISH_Obj_To_Host((cfish_Obj*)$var);\n" http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/8875d01e/runtime/perl/buildlib/Clownfish/Build/Binding.pm ---------------------------------------------------------------------- diff --git a/runtime/perl/buildlib/Clownfish/Build/Binding.pm b/runtime/perl/buildlib/Clownfish/Build/Binding.pm index 2cbf62f..2b07aee 100644 --- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm +++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm @@ -52,7 +52,7 @@ to_clownfish(sv) SV *sv; CODE: { - cfish_Obj *obj = XSBind_perl_to_cfish(aTHX_ sv); + cfish_Obj *obj = XSBind_perl_to_cfish_nullable(aTHX_ sv, CFISH_OBJ); RETVAL = CFISH_OBJ_TO_SV_NOINC(obj); } OUTPUT: RETVAL @@ -107,9 +107,10 @@ void invoke_to_string(sv) SV *sv; PPCODE: - cfish_Obj *obj = XSBind_sv_to_cfish_obj(aTHX_ sv, CFISH_OBJ, NULL); + cfish_Obj *obj = XSBind_perl_to_cfish(aTHX_ sv, CFISH_OBJ); cfish_String *str = CFISH_Obj_To_String(obj); CFISH_DECREF(str); + CFISH_DECREF(obj); int refcount(obj) @@ -309,9 +310,7 @@ store(self, key, value_sv); PPCODE: { cfish_Obj *value - = (cfish_Obj*)XSBind_maybe_sv_to_cfish_obj(aTHX_ value_sv, CFISH_OBJ, - CFISH_ALLOCA_OBJ(CFISH_STRING)); - if (value) { value = CFISH_INCREF(value); } + = (cfish_Obj*)XSBind_perl_to_cfish_nullable(aTHX_ value_sv, CFISH_OBJ); CFISH_Hash_Store_IMP(self, key, value); } END_XS_CODE http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/8875d01e/runtime/perl/xs/XSBind.c ---------------------------------------------------------------------- diff --git a/runtime/perl/xs/XSBind.c b/runtime/perl/xs/XSBind.c index f426bc0..a4ec829 100644 --- a/runtime/perl/xs/XSBind.c +++ b/runtime/perl/xs/XSBind.c @@ -38,6 +38,10 @@ #define XSBIND_REFCOUNT_FLAG 1 #define XSBIND_REFCOUNT_SHIFT 1 +static bool +S_maybe_perl_to_cfish(pTHX_ SV *sv, cfish_Class *klass, bool increment, + void *allocation, cfish_Obj **obj_ptr); + // Convert a Perl hash into a Clownfish Hash. Caller takes responsibility for // a refcount. static cfish_Hash* @@ -74,119 +78,124 @@ XSBind_new_blank_obj(pTHX_ SV *either_sv) { } cfish_Obj* -XSBind_sv_to_cfish_obj(pTHX_ SV *sv, cfish_Class *klass, void *allocation) { - cfish_Obj *retval - = XSBind_maybe_sv_to_cfish_obj(aTHX_ sv, klass, allocation); - if (!retval) { - THROW(CFISH_ERR, "Not a %o", CFISH_Class_Get_Name(klass)); +XSBind_perl_to_cfish(pTHX_ SV *sv, cfish_Class *klass) { + cfish_Obj *retval = NULL; + if (!S_maybe_perl_to_cfish(aTHX_ sv, klass, true, NULL, &retval)) { + THROW(CFISH_ERR, "Can't convert to %o", CFISH_Class_Get_Name(klass)); + } + else if (!retval) { + THROW(CFISH_ERR, "%o must not be undef", CFISH_Class_Get_Name(klass)); } return retval; } cfish_Obj* -XSBind_maybe_sv_to_cfish_obj(pTHX_ SV *sv, cfish_Class *klass, - void *allocation) { +XSBind_perl_to_cfish_nullable(pTHX_ SV *sv, cfish_Class *klass) { cfish_Obj *retval = NULL; - if (XSBind_sv_defined(aTHX_ sv)) { + if (!S_maybe_perl_to_cfish(aTHX_ sv, klass, true, NULL, &retval)) { + THROW(CFISH_ERR, "Can't convert to %o", CFISH_Class_Get_Name(klass)); + } + return retval; +} + +cfish_Obj* +XSBind_perl_to_cfish_noinc(pTHX_ SV *sv, cfish_Class *klass, void *allocation) { + cfish_Obj *retval = NULL; + if (!S_maybe_perl_to_cfish(aTHX_ sv, klass, false, allocation, &retval)) { + THROW(CFISH_ERR, "Can't convert to %o", CFISH_Class_Get_Name(klass)); + } + else if (!retval) { + THROW(CFISH_ERR, "%o must not be undef", CFISH_Class_Get_Name(klass)); + } + return retval; +} + +static bool +S_maybe_perl_to_cfish(pTHX_ SV *sv, cfish_Class *klass, bool increment, + void *allocation, cfish_Obj **obj_ptr) { + if (sv_isobject(sv)) { + cfish_String *class_name = CFISH_Class_Get_Name(klass); // Assume that the class name is always NULL-terminated. Somewhat // dangerous but should be safe. - if (sv_isobject(sv) - && sv_derived_from(sv, CFISH_Str_Get_Ptr8(CFISH_Class_Get_Name(klass))) - ) { + if (sv_derived_from(sv, CFISH_Str_Get_Ptr8(class_name))) { // Unwrap a real Clownfish object. IV tmp = SvIV(SvRV(sv)); - retval = INT2PTR(cfish_Obj*, tmp); - } - else if (allocation && - (klass == CFISH_STRING - || klass == CFISH_OBJ) - ) { - // Wrap the string from an ordinary Perl scalar inside a - // stack String. - STRLEN size; - char *ptr = SvPVutf8(sv, size); - retval = (cfish_Obj*)cfish_Str_new_stack_string( - allocation, ptr, size); + cfish_Obj *obj = INT2PTR(cfish_Obj*, tmp); + if (increment) { + obj = CFISH_INCREF(obj); + } + *obj_ptr = obj; + return true; } - else if (SvROK(sv)) { - // Attempt to convert Perl hashes and arrays into their Clownfish - // analogues. - SV *inner = SvRV(sv); - if (SvTYPE(inner) == SVt_PVAV && klass == CFISH_VECTOR) { - retval = (cfish_Obj*) + } + else if (SvROK(sv)) { + cfish_Obj *obj = NULL; + SV *inner = SvRV(sv); + svtype inner_type = SvTYPE(inner); + + // Attempt to convert Perl hashes and arrays into their Clownfish + // analogues. + if (inner_type == SVt_PVAV) { + if (klass == CFISH_VECTOR || klass == CFISH_OBJ) { + obj = (cfish_Obj*) S_perl_array_to_cfish_array(aTHX_ (AV*)inner); } - else if (SvTYPE(inner) == SVt_PVHV && klass == CFISH_HASH) { - retval = (cfish_Obj*) + } + else if (inner_type == SVt_PVHV) { + if (klass == CFISH_HASH || klass == CFISH_OBJ) { + obj = (cfish_Obj*) S_perl_hash_to_cfish_hash(aTHX_ (HV*)inner); } + } + else if (inner_type < SVt_PVAV && !SvOK(inner)) { + // Reference to undef. After cloning a Perl interpeter, + // most Clownfish objects look like this after they're + // CLONE_SKIPped. + *obj_ptr = NULL; + return true; + } - if (retval) { + if (obj) { + if (!increment) { // Mortalize the converted object -- which is somewhat // dangerous, but is the only way to avoid requiring that the // caller take responsibility for a refcount. - SV *mortal = XSBind_cfish_obj_to_sv(aTHX_ retval); - CFISH_DECREF(retval); + SV *mortal = XSBind_cfish_obj_to_sv(aTHX_ obj); + CFISH_DECREF(obj); sv_2mortal(mortal); } + + *obj_ptr = obj; + return true; } } + else if (!XSBind_sv_defined(aTHX_ sv)) { + *obj_ptr = NULL; + return true; + } - return retval; -} - -cfish_Obj* -XSBind_perl_to_cfish(pTHX_ SV *sv) { - cfish_Obj *retval = NULL; - - if (XSBind_sv_defined(aTHX_ sv)) { - bool is_undef = false; + // Stringify as last resort. + if (klass == CFISH_STRING || klass == CFISH_OBJ) { + STRLEN size; + char *ptr = SvPVutf8(sv, size); - if (SvROK(sv)) { - // Deep conversion of references. - SV *inner = SvRV(sv); - if (SvTYPE(inner) == SVt_PVAV) { - retval = (cfish_Obj*) - S_perl_array_to_cfish_array(aTHX_ (AV*)inner); - } - else if (SvTYPE(inner) == SVt_PVHV) { - retval = (cfish_Obj*) - S_perl_hash_to_cfish_hash(aTHX_ (HV*)inner); - } - else if (sv_isobject(sv) - && sv_derived_from(sv, "Clownfish::Obj") - ) { - IV tmp = SvIV(inner); - retval = INT2PTR(cfish_Obj*, tmp); - (void)CFISH_INCREF(retval); - } - else if (!XSBind_sv_defined(aTHX_ inner)) { - // Reference to undef. After cloning a Perl interpeter, - // most Clownfish objects look like this after they're - // CLONE_SKIPped. - is_undef = true; - } - } - - // It's either a plain scalar or a non-Clownfish Perl object, so - // stringify. - if (!retval && !is_undef) { - STRLEN len; - char *ptr = SvPVutf8(sv, len); - retval = (cfish_Obj*)cfish_Str_new_from_trusted_utf8(ptr, len); + if (increment) { + *obj_ptr = (cfish_Obj*)cfish_Str_new_from_trusted_utf8(ptr, size); + return true; } - } - else if (sv) { - // Deep conversion of raw AVs and HVs. - if (SvTYPE(sv) == SVt_PVAV) { - retval = (cfish_Obj*)S_perl_array_to_cfish_array(aTHX_ (AV*)sv); - } - else if (SvTYPE(sv) == SVt_PVHV) { - retval = (cfish_Obj*)S_perl_hash_to_cfish_hash(aTHX_ (HV*)sv); + else { + // Wrap the string from an ordinary Perl scalar inside a + // stack String. + if (!allocation) { + CFISH_THROW(CFISH_ERR, "Allocation for stack string missing"); + } + *obj_ptr = (cfish_Obj*)cfish_Str_new_stack_string( + allocation, ptr, size); + return true; } } - return retval; + return false; } const char* @@ -231,7 +240,8 @@ S_perl_hash_to_cfish_hash(pTHX_ HV *phash) { SV *value_sv = HeVAL(entry); // Recurse. - cfish_Obj *value = XSBind_perl_to_cfish(aTHX_ value_sv); + cfish_Obj *value + = XSBind_perl_to_cfish_nullable(aTHX_ value_sv, CFISH_OBJ); CFISH_Hash_Store_Utf8(retval, key_str, key_len, value); } @@ -248,7 +258,8 @@ S_perl_array_to_cfish_array(pTHX_ AV *parray) { for (uint32_t i = 0; i < size; i++) { SV **elem_sv = av_fetch(parray, i, false); if (elem_sv) { - cfish_Obj *elem = XSBind_perl_to_cfish(aTHX_ *elem_sv); + cfish_Obj *elem + = XSBind_perl_to_cfish_nullable(aTHX_ *elem_sv, CFISH_OBJ); if (elem) { CFISH_Vec_Store(retval, i, elem); } } } @@ -350,10 +361,11 @@ S_extract_from_sv(pTHX_ SV *value, void *target, const char *label, valid_assignment = true; break; case XSBIND_WANT_OBJ: { - cfish_Obj *object - = XSBind_maybe_sv_to_cfish_obj(aTHX_ value, klass, - allocation); - if (object) { + cfish_Obj *object = NULL; + bool success + = S_maybe_perl_to_cfish(aTHX_ value, klass, false, + allocation, &object); + if (success && object) { *((cfish_Obj**)target) = object; valid_assignment = true; } @@ -729,7 +741,8 @@ cfish_Class_fresh_host_methods(cfish_String *class_name) { PUTBACK; call_pv("Clownfish::Class::_fresh_host_methods", G_SCALAR); SPAGAIN; - cfish_Vector *methods = (cfish_Vector*)XSBind_perl_to_cfish(aTHX_ POPs); + cfish_Vector *methods + = (cfish_Vector*)XSBind_perl_to_cfish(aTHX_ POPs, CFISH_VECTOR); PUTBACK; FREETMPS; LEAVE; @@ -748,10 +761,9 @@ cfish_Class_find_parent_class(cfish_String *class_name) { PUTBACK; call_pv("Clownfish::Class::_find_parent_class", G_SCALAR); SPAGAIN; - SV *parent_class_sv = POPs; + cfish_String *parent_class = (cfish_String*) + XSBind_perl_to_cfish_nullable(aTHX_ POPs, CFISH_STRING); PUTBACK; - cfish_String *parent_class - = (cfish_String*)XSBind_perl_to_cfish(aTHX_ parent_class_sv); FREETMPS; LEAVE; return parent_class; @@ -824,8 +836,8 @@ cfish_Err_get_error() { PUTBACK; call_pv("Clownfish::Err::get_error", G_SCALAR); SPAGAIN; - cfish_Err *error = (cfish_Err*)XSBind_perl_to_cfish(aTHX_ POPs); - if (error) { CFISH_CERTIFY(error, CFISH_ERR); } + cfish_Err *error + = (cfish_Err*)XSBind_perl_to_cfish_nullable(aTHX_ POPs, CFISH_ERR); PUTBACK; FREETMPS; LEAVE; http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/8875d01e/runtime/perl/xs/XSBind.h ---------------------------------------------------------------------- diff --git a/runtime/perl/xs/XSBind.h b/runtime/perl/xs/XSBind.h index 5fabb32..609c5bb 100644 --- a/runtime/perl/xs/XSBind.h +++ b/runtime/perl/xs/XSBind.h @@ -60,25 +60,6 @@ cfish_XSBind_sv_defined(pTHX_ SV *sv) { return !!SvOK(sv); } -/** If the SV contains a Clownfish object which passes an "isa" test against the - * passed-in Class, return a pointer to it. If not, but - * `allocation` is non-NULL and a String would satisfy the - * "isa" test, stringify the SV, create a stack String using - * `allocation`, assign the SV's string to it, and return that - * instead. If all else fails, throw an exception. - */ -CFISH_VISIBLE cfish_Obj* -cfish_XSBind_sv_to_cfish_obj(pTHX_ SV *sv, cfish_Class *klass, - void *allocation); - -/** As XSBind_sv_to_cfish_obj above, but returns NULL instead of throwing an - * exception. - */ -CFISH_VISIBLE cfish_Obj* -cfish_XSBind_maybe_sv_to_cfish_obj(pTHX_ SV *sv, cfish_Class *klass, - void *allocation); - - /** Derive an SV from a Clownfish object. If the Clownfish object is NULL, the SV * will be undef. Doesn't invoke To_Host and always returns a reference to a * Clownfish::Obj. @@ -123,12 +104,38 @@ cfish_XSBind_cfish_to_perl(pTHX_ cfish_Obj *obj) { return obj ? (SV*)CFISH_Obj_To_Host(obj) : newSV(0); } -/** Deep conversion of Perl data structures to Clownfish objects -- Perl hash - * to Hash, Perl array to Vector, Clownfish objects stripped of their - * wrappers, and everything else stringified and turned to a String. +/** Convert a Perl SV to a Clownfish object of class `klass`. + * + * - If the SV contains a Clownfish object which passes an "isa" test against + * `klass`, return a pointer to it. + * - If the SV contains an arrayref and `klass` is VECTOR or OBJ, perform a + * deep conversion of the Perl array to a Vector. + * - If the SV contains a hashref and `klass` is HASH or OBJ, perform a + * deep conversion of the Perl hash to a Hash. + * - If `klass` is STRING or OBJ, stringify and return a String. + * - If all else fails, throw an exception. + * + * Returns an non-NULL, "incremented" object that must be decref'd at some + * point. + */ +CFISH_VISIBLE cfish_Obj* +cfish_XSBind_perl_to_cfish(pTHX_ SV *sv, cfish_Class *klass); + +/** As XSBind_perl_to_cfish above, but returns NULL if the SV is undefined + * or a reference to an undef. + */ +CFISH_VISIBLE cfish_Obj* +cfish_XSBind_perl_to_cfish_nullable(pTHX_ SV *sv, cfish_Class *klass); + +/** As XSBind_perl_to_cfish above, but returns an object that can be used for + * a while with no need to decref. + * + * If `klass` is STRING or OBJ, `allocation` must point to stack-allocated + * memory that can hold a String. Otherwise, `allocation` should be NULL. */ CFISH_VISIBLE cfish_Obj* -cfish_XSBind_perl_to_cfish(pTHX_ SV *sv); +cfish_XSBind_perl_to_cfish_noinc(pTHX_ SV *sv, cfish_Class *klass, + void *allocation); /** Return the contents of the hash entry's key as UTF-8. */ @@ -301,12 +308,12 @@ cfish_XSBind_allot_params(pTHX_ SV** stack, int32_t start, */ #define XSBind_new_blank_obj cfish_XSBind_new_blank_obj #define XSBind_sv_defined cfish_XSBind_sv_defined -#define XSBind_sv_to_cfish_obj cfish_XSBind_sv_to_cfish_obj -#define XSBind_maybe_sv_to_cfish_obj cfish_XSBind_maybe_sv_to_cfish_obj #define XSBind_cfish_obj_to_sv cfish_XSBind_cfish_obj_to_sv #define XSBind_cfish_obj_to_sv_noinc cfish_XSBind_cfish_obj_to_sv_noinc #define XSBind_cfish_to_perl cfish_XSBind_cfish_to_perl #define XSBind_perl_to_cfish cfish_XSBind_perl_to_cfish +#define XSBind_perl_to_cfish_nullable cfish_XSBind_perl_to_cfish_nullable +#define XSBind_perl_to_cfish_noinc cfish_XSBind_perl_to_cfish_noinc #define XSBind_hash_key_to_utf8 cfish_XSBind_hash_key_to_utf8 #define XSBind_trap cfish_XSBind_trap #define XSBind_allot_params cfish_XSBind_allot_params