Use aliased method names in Perl callbacks Eliminate CFCMethod_micro_sym on the way.
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/0c2b1bce Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/0c2b1bce Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/0c2b1bce Branch: refs/heads/overridden_aliases Commit: 0c2b1bcef4cad238a9a4e4c57740ffe1cf1f7aef Parents: 7744424 Author: Nick Wellnhofer <[email protected]> Authored: Sat Jul 26 20:36:17 2014 +0200 Committer: Nick Wellnhofer <[email protected]> Committed: Tue Jul 29 00:21:20 2014 +0200 ---------------------------------------------------------------------- compiler/perl/lib/Clownfish/CFC.xs | 5 ++- compiler/src/CFCMethod.c | 5 --- compiler/src/CFCMethod.h | 3 -- compiler/src/CFCPerlClass.c | 8 +---- compiler/src/CFCPerlMethod.c | 64 ++++++++++++++++++++++----------- compiler/src/CFCPerlMethod.h | 13 ++++--- 6 files changed, 55 insertions(+), 43 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/perl/lib/Clownfish/CFC.xs ---------------------------------------------------------------------- diff --git a/compiler/perl/lib/Clownfish/CFC.xs b/compiler/perl/lib/Clownfish/CFC.xs index b5734ce..c1983b7 100644 --- a/compiler/perl/lib/Clownfish/CFC.xs +++ b/compiler/perl/lib/Clownfish/CFC.xs @@ -2155,11 +2155,10 @@ OUTPUT: RETVAL MODULE = Clownfish PACKAGE = Clownfish::CFC::Binding::Perl::Method SV* -_new(method, alias) +_new(method) CFCMethod *method; - const char *alias; CODE: - CFCPerlMethod *self = CFCPerlMethod_new(method, alias); + CFCPerlMethod *self = CFCPerlMethod_new(method); RETVAL = S_cfcbase_to_perlref(self); CFCBase_decref((CFCBase*)self); OUTPUT: RETVAL http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/src/CFCMethod.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCMethod.c b/compiler/src/CFCMethod.c index 0c89f68..2a1bba1 100644 --- a/compiler/src/CFCMethod.c +++ b/compiler/src/CFCMethod.c @@ -357,11 +357,6 @@ CFCMethod_get_macro_sym(CFCMethod *self) { return self->macro_sym; } -const char* -CFCMethod_micro_sym(CFCMethod *self) { - return CFCSymbol_micro_sym((CFCSymbol*)self); -} - char* CFCMethod_short_typedef(CFCMethod *self, CFCClass *invoker) { return S_short_method_sym(self, invoker, "_t"); http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/src/CFCMethod.h ---------------------------------------------------------------------- diff --git a/compiler/src/CFCMethod.h b/compiler/src/CFCMethod.h index dd39203..f6beb94 100644 --- a/compiler/src/CFCMethod.h +++ b/compiler/src/CFCMethod.h @@ -148,9 +148,6 @@ CFCMethod_full_offset_sym(CFCMethod *self, struct CFCClass *invoker); const char* CFCMethod_get_macro_sym(CFCMethod *self); -const char* -CFCMethod_micro_sym(CFCMethod *self); - /** Create the typedef symbol for this method, e.g "Claw_Pinch_t". * @param invoker Class for which the symbol is created. If invoker is NULL, * use the class where the method is defined. http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/src/CFCPerlClass.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlClass.c b/compiler/src/CFCPerlClass.c index db6edfc..ab8c846 100644 --- a/compiler/src/CFCPerlClass.c +++ b/compiler/src/CFCPerlClass.c @@ -270,12 +270,6 @@ CFCPerlClass_method_bindings(CFCClass *klass) { continue; } - // See if the user wants the method to have a specific alias. - const char *alias = CFCMethod_get_host_alias(method); - if (!alias) { - alias = CFCMethod_micro_sym(method); - } - /* Create the binding, add it to the array. * * Also create an XSub binding for each override. Each of these @@ -284,7 +278,7 @@ CFCPerlClass_method_bindings(CFCClass *klass) { * this way allows SUPER:: invocations from Perl-space to work * properly. */ - CFCPerlMethod *meth_binding = CFCPerlMethod_new(method, alias); + CFCPerlMethod *meth_binding = CFCPerlMethod_new(method); size_t size = (num_bound + 2) * sizeof(CFCPerlMethod*); bound = (CFCPerlMethod**)REALLOCATE(bound, size); bound[num_bound] = meth_binding; http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/src/CFCPerlMethod.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlMethod.c b/compiler/src/CFCPerlMethod.c index 8027cb0..9f33065 100644 --- a/compiler/src/CFCPerlMethod.c +++ b/compiler/src/CFCPerlMethod.c @@ -16,6 +16,7 @@ #include <string.h> #include <stdio.h> +#include <ctype.h> #define CFC_NEED_PERLSUB_STRUCT_DEF 1 #include "CFCPerlSub.h" @@ -106,32 +107,24 @@ static const CFCMeta CFCPERLMETHOD_META = { }; CFCPerlMethod* -CFCPerlMethod_new(CFCMethod *method, const char *alias) { +CFCPerlMethod_new(CFCMethod *method) { CFCPerlMethod *self = (CFCPerlMethod*)CFCBase_allocate(&CFCPERLMETHOD_META); - return CFCPerlMethod_init(self, method, alias); + return CFCPerlMethod_init(self, method); } CFCPerlMethod* -CFCPerlMethod_init(CFCPerlMethod *self, CFCMethod *method, - const char *alias) { +CFCPerlMethod_init(CFCPerlMethod *self, CFCMethod *method) { CFCParamList *param_list = CFCMethod_get_param_list(method); const char *class_name = CFCMethod_get_class_name(method); int use_labeled_params = CFCParamList_num_vars(param_list) > 2 ? 1 : 0; - // The Clownfish destructor needs to be spelled DESTROY for Perl. - if (!alias) { - alias = CFCMethod_micro_sym(method); - } - static const char destroy_uppercase[] = "DESTROY"; - if (strcmp(alias, "destroy") == 0) { - alias = destroy_uppercase; - } - - CFCPerlSub_init((CFCPerlSub*)self, param_list, class_name, alias, + char *perl_name = CFCPerlMethod_perl_name(method); + CFCPerlSub_init((CFCPerlSub*)self, param_list, class_name, perl_name, use_labeled_params); self->method = (CFCMethod*)CFCBase_incref((CFCBase*)method); + FREEMEM(perl_name); return self; } @@ -142,6 +135,32 @@ CFCPerlMethod_destroy(CFCPerlMethod *self) { } char* +CFCPerlMethod_perl_name(CFCMethod *method) { + // See if the user wants the method to have a specific alias. + const char *alias = CFCMethod_get_host_alias(method); + if (alias) { + return CFCUtil_strdup(alias); + } + + char *perl_name = NULL; + const char *name = CFCMethod_get_macro_sym(method); + + if (strcmp(name, "Destroy") == 0) { + // The Clownfish destructor needs to be spelled DESTROY for Perl. + perl_name = CFCUtil_strdup("DESTROY"); + } + else { + // Derive Perl name by lowercasing. + perl_name = CFCUtil_strdup(name); + for (size_t i = 0; perl_name[i] != '\0'; i++) { + perl_name[i] = tolower(perl_name[i]); + } + } + + return perl_name; +} + +char* CFCPerlMethod_xsub_def(CFCPerlMethod *self) { if (self->sub.use_labeled_params) { return S_xsub_def_labeled_params(self); @@ -632,7 +651,7 @@ S_void_callback_def(CFCMethod *method, const char *callback_start, const char *refcount_mods) { const char *override_sym = CFCMethod_full_override_sym(method); const char *params = CFCParamList_to_c(CFCMethod_get_param_list(method)); - const char *micro_sym = CFCMethod_micro_sym(method); + char *perl_name = CFCPerlMethod_perl_name(method); const char pattern[] = "void\n" "%s(%s) {\n" @@ -641,8 +660,9 @@ S_void_callback_def(CFCMethod *method, const char *callback_start, "}\n"; char *callback_def = CFCUtil_sprintf(pattern, override_sym, params, callback_start, - micro_sym, refcount_mods); + perl_name, refcount_mods); + FREEMEM(perl_name); return callback_def; } @@ -653,7 +673,6 @@ S_primitive_callback_def(CFCMethod *method, const char *callback_start, const char *params = CFCParamList_to_c(CFCMethod_get_param_list(method)); CFCType *return_type = CFCMethod_get_return_type(method); const char *ret_type_str = CFCType_to_c(return_type); - const char *micro_sym = CFCMethod_micro_sym(method); char callback_func[50]; if (CFCType_is_integer(return_type)) { @@ -671,6 +690,8 @@ S_primitive_callback_def(CFCMethod *method, const char *callback_start, CFCUtil_die("Unexpected type: %s", ret_type_str); } + char *perl_name = CFCPerlMethod_perl_name(method); + char pattern[] = "%s\n" "%s(%s) {\n" @@ -681,8 +702,9 @@ S_primitive_callback_def(CFCMethod *method, const char *callback_start, char *callback_def = CFCUtil_sprintf(pattern, ret_type_str, override_sym, params, callback_start, ret_type_str, ret_type_str, - callback_func, micro_sym, refcount_mods); + callback_func, perl_name, refcount_mods); + FREEMEM(perl_name); return callback_def; } @@ -693,9 +715,10 @@ S_obj_callback_def(CFCMethod *method, const char *callback_start, const char *params = CFCParamList_to_c(CFCMethod_get_param_list(method)); CFCType *return_type = CFCMethod_get_return_type(method); const char *ret_type_str = CFCType_to_c(return_type); - const char *micro_sym = CFCMethod_micro_sym(method); const char *nullable = CFCType_nullable(return_type) ? "true" : "false"; + char *perl_name = CFCPerlMethod_perl_name(method); + char pattern[] = "%s\n" "%s(%s) {\n" @@ -706,8 +729,9 @@ S_obj_callback_def(CFCMethod *method, const char *callback_start, char *callback_def = CFCUtil_sprintf(pattern, ret_type_str, override_sym, params, callback_start, ret_type_str, ret_type_str, - micro_sym, nullable, refcount_mods); + perl_name, nullable, refcount_mods); + FREEMEM(perl_name); return callback_def; } http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/src/CFCPerlMethod.h ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlMethod.h b/compiler/src/CFCPerlMethod.h index dbd19c0..be441c4 100644 --- a/compiler/src/CFCPerlMethod.h +++ b/compiler/src/CFCPerlMethod.h @@ -35,20 +35,23 @@ typedef struct CFCPerlMethod CFCPerlMethod; struct CFCMethod; CFCPerlMethod* -CFCPerlMethod_new(struct CFCMethod *method, const char *alias); +CFCPerlMethod_new(struct CFCMethod *method); /** * @param method A Clownfish::CFC::Model::Method. - * @param alias The perl name for the method. Defaults to the lowercased name - * of the supplied Clownfish Method. */ CFCPerlMethod* -CFCPerlMethod_init(CFCPerlMethod *self, struct CFCMethod *method, - const char *alias); +CFCPerlMethod_init(CFCPerlMethod *self, struct CFCMethod *method); void CFCPerlMethod_destroy(CFCPerlMethod *self); +/** + * Create the Perl name of the method. + */ +char* +CFCPerlMethod_perl_name(struct CFCMethod *method); + /** Generate C code for the XSUB. */ char*
