lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From mar...@apache.org
Subject [lucy-commits] [12/27] Remove bundled Clownfish.
Date Sat, 12 Apr 2014 06:49:47 GMT
http://git-wip-us.apache.org/repos/asf/lucy/blob/1704c275/clownfish/compiler/src/CFCPerlConstructor.c
----------------------------------------------------------------------
diff --git a/clownfish/compiler/src/CFCPerlConstructor.c b/clownfish/compiler/src/CFCPerlConstructor.c
deleted file mode 100644
index eeaec24..0000000
--- a/clownfish/compiler/src/CFCPerlConstructor.c
+++ /dev/null
@@ -1,148 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements.  See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License.  You may obtain a copy of the License at
- *
- *     http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#include <string.h>
-#include <stdio.h>
-
-#ifndef true
-  #define true 1
-  #define false 0
-#endif
-
-#define CFC_NEED_PERLSUB_STRUCT_DEF 1
-#include "CFCPerlSub.h"
-#include "CFCPerlConstructor.h"
-#include "CFCClass.h"
-#include "CFCFunction.h"
-#include "CFCParamList.h"
-#include "CFCType.h"
-#include "CFCVariable.h"
-#include "CFCUtil.h"
-#include "CFCPerlTypeMap.h"
-
-struct CFCPerlConstructor {
-    CFCPerlSub   sub;
-    CFCFunction *init_func;
-};
-
-static const CFCMeta CFCPERLCONSTRUCTOR_META = {
-    "Clownfish::CFC::Binding::Perl::Constructor",
-    sizeof(CFCPerlConstructor),
-    (CFCBase_destroy_t)CFCPerlConstructor_destroy
-};
-
-CFCPerlConstructor*
-CFCPerlConstructor_new(CFCClass *klass, const char *alias,
-                       const char *initializer) {
-    CFCPerlConstructor *self
-        = (CFCPerlConstructor*)CFCBase_allocate(&CFCPERLCONSTRUCTOR_META);
-    return CFCPerlConstructor_init(self, klass, alias, initializer);
-}
-
-CFCPerlConstructor*
-CFCPerlConstructor_init(CFCPerlConstructor *self, CFCClass *klass,
-                        const char *alias, const char *initializer) {
-    CFCUTIL_NULL_CHECK(alias);
-    CFCUTIL_NULL_CHECK(klass);
-    const char *class_name = CFCClass_get_class_name(klass);
-    initializer = initializer ? initializer : "init";
-
-    // Find the implementing function.
-    self->init_func = NULL;
-    CFCFunction **funcs = CFCClass_functions(klass);
-    for (size_t i = 0; funcs[i] != NULL; i++) {
-        CFCFunction *func = funcs[i];
-        const char *func_name = CFCFunction_micro_sym(func);
-        if (strcmp(initializer, func_name) == 0) {
-            self->init_func = (CFCFunction*)CFCBase_incref((CFCBase*)func);
-            break;
-        }
-    }
-    if (!self->init_func) {
-        CFCUtil_die("Missing or invalid '%s' function for '%s'",
-                    initializer, class_name);
-    }
-    CFCParamList *param_list = CFCFunction_get_param_list(self->init_func);
-    CFCPerlSub_init((CFCPerlSub*)self, param_list, class_name, alias,
-                    true);
-    return self;
-}
-
-void
-CFCPerlConstructor_destroy(CFCPerlConstructor *self) {
-    CFCBase_decref((CFCBase*)self->init_func);
-    CFCPerlSub_destroy((CFCPerlSub*)self);
-}
-
-char*
-CFCPerlConstructor_xsub_def(CFCPerlConstructor *self) {
-    const char *c_name = self->sub.c_name;
-    CFCParamList *param_list = self->sub.param_list;
-    const char   *name_list  = CFCParamList_name_list(param_list);
-    CFCVariable **arg_vars   = CFCParamList_get_variables(param_list);
-    const char   *func_sym   = CFCFunction_full_func_sym(self->init_func);
-    char *allot_params = CFCPerlSub_build_allot_params((CFCPerlSub*)self);
-    CFCVariable *self_var       = arg_vars[0];
-    CFCType     *self_type      = CFCVariable_get_type(self_var);
-    const char  *self_type_str  = CFCType_to_c(self_type);
-
-    // Compensate for swallowed refcounts.
-    char *refcount_mods = CFCUtil_strdup("");
-    for (size_t i = 0; arg_vars[i] != NULL; i++) {
-        CFCVariable *var = arg_vars[i];
-        CFCType *type = CFCVariable_get_type(var);
-        if (CFCType_is_object(type) && CFCType_decremented(type)) {
-            const char *name = CFCVariable_micro_sym(var);
-            refcount_mods = CFCUtil_cat(refcount_mods, "\n    CFISH_INCREF(",
-                                        name, ");", NULL);
-        }
-    }
-
-    const char pattern[] =
-        "XS(%s);\n"
-        "XS(%s) {\n"
-        "    dXSARGS;\n"
-        "    CFISH_UNUSED_VAR(cv);\n"
-        "    if (items < 1) { CFISH_THROW(CFISH_ERR, \"Usage: %%s(class_name, ...)\",  GvNAME(CvGV(cv))); }\n"
-        "    SP -= items;\n"
-        "\n"
-        "    %s\n"
-        // Create "self" last, so that earlier exceptions while fetching
-        // params don't trigger a bad invocation of DESTROY.
-        "    %s self = (%s)XSBind_new_blank_obj(ST(0));%s\n"
-        "\n"
-        "    %s retval = %s(%s);\n"
-        "    if (retval) {\n"
-        "        ST(0) = (SV*)CFISH_Obj_To_Host((cfish_Obj*)retval);\n"
-        "        CFISH_Obj_Dec_RefCount((cfish_Obj*)retval);\n"
-        "    }\n"
-        "    else {\n"
-        "        ST(0) = newSV(0);\n"
-        "    }\n"
-        "    sv_2mortal(ST(0));\n"
-        "    XSRETURN(1);\n"
-        "}\n\n";
-    char *xsub_def
-        = CFCUtil_sprintf(pattern, c_name, c_name, allot_params, self_type_str,
-                          self_type_str, refcount_mods, self_type_str,
-                          func_sym, name_list);
-
-    FREEMEM(refcount_mods);
-    FREEMEM(allot_params);
-
-    return xsub_def;
-}
-

http://git-wip-us.apache.org/repos/asf/lucy/blob/1704c275/clownfish/compiler/src/CFCPerlConstructor.h
----------------------------------------------------------------------
diff --git a/clownfish/compiler/src/CFCPerlConstructor.h b/clownfish/compiler/src/CFCPerlConstructor.h
deleted file mode 100644
index 3de46b5..0000000
--- a/clownfish/compiler/src/CFCPerlConstructor.h
+++ /dev/null
@@ -1,63 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements.  See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License.  You may obtain a copy of the License at
- *
- *     http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#ifndef H_CFCPERLCONSTRUCTOR
-#define H_CFCPERLCONSTRUCTOR
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-typedef struct CFCPerlConstructor CFCPerlConstructor;
-struct CFCClass;
-
-/** Clownfish::CFC::Binding::Perl::Constructor - Binding for an object method.
- *
- * This class isa Clownfish::CFC::Binding::Perl::Subroutine -- see its
- * documentation for various code-generating routines.
- * 
- * Constructors are always bound to accept labeled params, even if there is only
- * a single argument.
- */
-
-/**
- * @param klass A L<Clownfish::CFC::Model::Class>.
- * @param alias The Perl name for the constructor.
- * @param initializer The name of the function which should be bound (default
- * "init").
- */
-CFCPerlConstructor*
-CFCPerlConstructor_new(struct CFCClass *klass, const char *alias,
-                       const char *initializer);
-
-CFCPerlConstructor*
-CFCPerlConstructor_init(CFCPerlConstructor *self, struct CFCClass *klass,
-                        const char *alias, const char *initializer);
-
-void
-CFCPerlConstructor_destroy(CFCPerlConstructor *self);
-
-/** Generate C code for the XSUB.
- */
-char*
-CFCPerlConstructor_xsub_def(CFCPerlConstructor *self);
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* H_CFCPERLCONSTRUCTOR */
-

http://git-wip-us.apache.org/repos/asf/lucy/blob/1704c275/clownfish/compiler/src/CFCPerlMethod.c
----------------------------------------------------------------------
diff --git a/clownfish/compiler/src/CFCPerlMethod.c b/clownfish/compiler/src/CFCPerlMethod.c
deleted file mode 100644
index a5c0bd0..0000000
--- a/clownfish/compiler/src/CFCPerlMethod.c
+++ /dev/null
@@ -1,666 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements.  See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License.  You may obtain a copy of the License at
- *
- *     http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#include <string.h>
-#include <stdio.h>
-
-#define CFC_NEED_PERLSUB_STRUCT_DEF 1
-#include "CFCPerlSub.h"
-#include "CFCPerlMethod.h"
-#include "CFCUtil.h"
-#include "CFCClass.h"
-#include "CFCMethod.h"
-#include "CFCSymbol.h"
-#include "CFCType.h"
-#include "CFCParcel.h"
-#include "CFCParamList.h"
-#include "CFCPerlTypeMap.h"
-#include "CFCVariable.h"
-
-struct CFCPerlMethod {
-    CFCPerlSub  sub;
-    CFCMethod  *method;
-};
-
-// Return the main chunk of the code for the xsub.
-static char*
-S_xsub_body(CFCPerlMethod *self);
-
-// Create an assignment statement for extracting $self from the Perl stack.
-static char*
-S_self_assign_statement(CFCPerlMethod *self, CFCType *type);
-
-// Return code for an xsub which uses labeled params.
-static char*
-S_xsub_def_labeled_params(CFCPerlMethod *self);
-
-// Return code for an xsub which uses positional args.
-static char*
-S_xsub_def_positional_args(CFCPerlMethod *self);
-
-/* Take a NULL-terminated list of CFCVariables and build up a string of
- * directives like:
- *
- *     UNUSED_VAR(var1);
- *     UNUSED_VAR(var2);
- */
-static char*
-S_build_unused_vars(CFCVariable **vars);
-
-/* Create an unreachable return statement if necessary, in order to thwart
- * compiler warnings. */
-static char*
-S_maybe_unreachable(CFCType *return_type);
-
-/* Generate code which converts C types to Perl types and pushes arguments
- * onto the Perl stack.
- */
-static char*
-S_callback_start(CFCMethod *method);
-
-/* Adapt the refcounts of parameters and return types.
- */
-static char*
-S_callback_refcount_mods(CFCMethod *method);
-
-/* Return a function which throws a runtime error indicating which variable
- * couldn't be mapped.  TODO: it would be better to resolve all these cases at
- * compile-time.
- */
-static char*
-S_invalid_callback_def(CFCMethod *method);
-
-// Create a callback for a method which operates in a void context.
-static char*
-S_void_callback_def(CFCMethod *method, const char *callback_start,
-                    const char *refcount_mods);
-
-// Create a callback which returns a primitive type.
-static char*
-S_primitive_callback_def(CFCMethod *method, const char *callback_start,
-                         const char *refcount_mods);
-
-/* Create a callback which returns an object type -- either a generic object or
- * a string. */
-static char*
-S_obj_callback_def(CFCMethod *method, const char *callback_start,
-                   const char *refcount_mods);
-
-static const CFCMeta CFCPERLMETHOD_META = {
-    "Clownfish::CFC::Binding::Perl::Method",
-    sizeof(CFCPerlMethod),
-    (CFCBase_destroy_t)CFCPerlMethod_destroy
-};
-
-CFCPerlMethod*
-CFCPerlMethod_new(CFCMethod *method, const char *alias) {
-    CFCPerlMethod *self
-        = (CFCPerlMethod*)CFCBase_allocate(&CFCPERLMETHOD_META);
-    return CFCPerlMethod_init(self, method, alias);
-}
-
-CFCPerlMethod*
-CFCPerlMethod_init(CFCPerlMethod *self, CFCMethod *method,
-                   const char *alias) {
-    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,
-                    use_labeled_params);
-    self->method = (CFCMethod*)CFCBase_incref((CFCBase*)method);
-    return self;
-}
-
-void
-CFCPerlMethod_destroy(CFCPerlMethod *self) {
-    CFCBase_decref((CFCBase*)self->method);
-    CFCPerlSub_destroy((CFCPerlSub*)self);
-}
-
-char*
-CFCPerlMethod_xsub_def(CFCPerlMethod *self) {
-    if (self->sub.use_labeled_params) {
-        return S_xsub_def_labeled_params(self);
-    }
-    else {
-        return S_xsub_def_positional_args(self);
-    }
-}
-
-static char*
-S_xsub_body(CFCPerlMethod *self) {
-    CFCMethod    *method        = self->method;
-    CFCParamList *param_list    = CFCMethod_get_param_list(method);
-    CFCVariable **arg_vars      = CFCParamList_get_variables(param_list);
-    const char   *name_list     = CFCParamList_name_list(param_list);
-    char *body = CFCUtil_strdup("");
-
-    CFCParcel *parcel = CFCMethod_get_parcel(method);
-    const char *class_name = CFCMethod_get_class_name(method);
-    CFCClass *klass = CFCClass_fetch_singleton(parcel, class_name);
-    if (!klass) {
-        CFCUtil_die("Can't find a CFCClass for '%s'", class_name);
-    }
-
-    // Extract the method function pointer.
-    char *full_typedef = CFCMethod_full_typedef(method, klass);
-    char *full_meth    = CFCMethod_full_method_sym(method, klass);
-    char *method_ptr
-        = CFCUtil_sprintf("%s method = CFISH_METHOD_PTR(%s, %s);\n    ",
-                          full_typedef, CFCClass_full_vtable_var(klass),
-                          full_meth);
-    body = CFCUtil_cat(body, method_ptr, NULL);
-    FREEMEM(full_typedef);
-    FREEMEM(full_meth);
-    FREEMEM(method_ptr);
-
-    // Compensate for functions which eat refcounts.
-    for (int i = 0; arg_vars[i] != NULL; i++) {
-        CFCVariable *var = arg_vars[i];
-        CFCType     *type = CFCVariable_get_type(var);
-        if (CFCType_is_object(type) && CFCType_decremented(type)) {
-            body = CFCUtil_cat(body, "CFISH_INCREF(",
-                               CFCVariable_micro_sym(var), ");\n    ", NULL);
-        }
-    }
-
-    if (CFCType_is_void(CFCMethod_get_return_type(method))) {
-        // Invoke method in void context.
-        body = CFCUtil_cat(body, "method(", name_list,
-                           ");\n    XSRETURN(0);", NULL);
-    }
-    else {
-        // Return a value for method invoked in a scalar context.
-        CFCType *return_type = CFCMethod_get_return_type(method);
-        const char *type_str = CFCType_to_c(return_type);
-        char *assignment = CFCPerlTypeMap_to_perl(return_type, "retval");
-        if (!assignment) {
-            CFCUtil_die("Can't find typemap for '%s'", type_str);
-        }
-        body = CFCUtil_cat(body, type_str, " retval = method(",
-                           name_list, ");\n    ST(0) = ", assignment, ";",
-                           NULL);
-        if (CFCType_is_object(return_type)
-            && CFCType_incremented(return_type)
-           ) {
-            body = CFCUtil_cat(body, "\n    CFISH_DECREF(retval);", NULL);
-        }
-        body = CFCUtil_cat(body, "\n    sv_2mortal( ST(0) );\n    XSRETURN(1);",
-                           NULL);
-        FREEMEM(assignment);
-    }
-
-    return body;
-}
-
-// Create an assignment statement for extracting $self from the Perl stack.
-static char*
-S_self_assign_statement(CFCPerlMethod *self, CFCType *type) {
-    (void)self; // unused
-    const char *type_c = CFCType_to_c(type);
-    if (!CFCType_is_object(type)) {
-        CFCUtil_die("Not an object type: %s", type_c);
-    }
-    const char *vtable_var = CFCType_get_vtable_var(type);
-    char pattern[] = "%s self = (%s)XSBind_sv_to_cfish_obj(ST(0), %s, NULL);";
-    char *statement = CFCUtil_sprintf(pattern, type_c, type_c, vtable_var);
-
-    return statement;
-}
-
-static char*
-S_xsub_def_labeled_params(CFCPerlMethod *self) {
-    const char *c_name = self->sub.c_name;
-    CFCParamList *param_list = self->sub.param_list;
-    CFCVariable **arg_vars   = CFCParamList_get_variables(param_list);
-    CFCVariable *self_var    = arg_vars[0];
-    CFCType     *self_type   = CFCVariable_get_type(self_var);
-    const char  *self_micro_sym = CFCVariable_micro_sym(self_var);
-    char *self_assign = S_self_assign_statement(self, self_type);
-    char *allot_params = CFCPerlSub_build_allot_params((CFCPerlSub*)self);
-    char *body = S_xsub_body(self);
-
-    char pattern[] =
-        "XS(%s);\n"
-        "XS(%s) {\n"
-        "    dXSARGS;\n"
-        "    CFISH_UNUSED_VAR(cv);\n"
-        "    if (items < 1) { CFISH_THROW(CFISH_ERR, \"Usage: %%s(%s, ...)\",  GvNAME(CvGV(cv))); }\n"
-        "    SP -= items;\n"
-        "\n"
-        "    /* Extract vars from Perl stack. */\n"
-        "    %s\n"
-        "    %s\n"
-        "\n"
-        "    /* Execute */\n"
-        "    %s\n"
-        "}\n";
-    char *xsub_def
-        = CFCUtil_sprintf(pattern, c_name, c_name, self_micro_sym,
-                          allot_params, self_assign, body);
-
-    FREEMEM(self_assign);
-    FREEMEM(allot_params);
-    FREEMEM(body);
-    return xsub_def;
-}
-
-static char*
-S_xsub_def_positional_args(CFCPerlMethod *self) {
-    CFCMethod *method = self->method;
-    CFCParamList *param_list = CFCMethod_get_param_list(method);
-    CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
-    const char **arg_inits = CFCParamList_get_initial_values(param_list);
-    unsigned num_vars = (unsigned)CFCParamList_num_vars(param_list);
-    char *body = S_xsub_body(self);
-
-    // Determine how many args are truly required and build an error check.
-    unsigned min_required = 0;
-    for (unsigned i = 0; i < num_vars; i++) {
-        if (arg_inits[i] == NULL) {
-            min_required = i + 1;
-        }
-    }
-    char *xs_name_list = num_vars > 0
-                         ? CFCUtil_strdup(CFCVariable_micro_sym(arg_vars[0]))
-                         : CFCUtil_strdup("");
-    for (unsigned i = 1; i < num_vars; i++) {
-        const char *var_name = CFCVariable_micro_sym(arg_vars[i]);
-        if (i < min_required) {
-            xs_name_list = CFCUtil_cat(xs_name_list, ", ", var_name, NULL);
-        }
-        else {
-            xs_name_list = CFCUtil_cat(xs_name_list, ", [", var_name, "]",
-                                       NULL);
-        }
-    }
-    const char num_args_pattern[] =
-        "if (items %s %u) { CFISH_THROW(CFISH_ERR, \"Usage: %%s(%s)\", GvNAME(CvGV(cv))); }";
-    char *num_args_check;
-    if (min_required < num_vars) {
-        num_args_check = CFCUtil_sprintf(num_args_pattern, "<", min_required,
-                                         xs_name_list);
-    }
-    else {
-        num_args_check = CFCUtil_sprintf(num_args_pattern, "!=", num_vars,
-                                         xs_name_list);
-    }
-
-    // Var assignments.
-    char *var_assignments = CFCUtil_strdup("");
-    for (unsigned i = 0; i < num_vars; i++) {
-        CFCVariable *var = arg_vars[i];
-        const char  *val = arg_inits[i];
-        const char  *var_name = CFCVariable_micro_sym(var);
-        CFCType     *var_type = CFCVariable_get_type(var);
-        const char  *type_c   = CFCType_to_c(var_type);
-
-        if (i == 0) {    // self
-            char *statement = S_self_assign_statement(self, var_type);
-            var_assignments = CFCUtil_cat(var_assignments, statement, NULL);
-            FREEMEM(statement);
-        }
-        else {
-            char perl_stack_var[30];
-            sprintf(perl_stack_var, "ST(%u)", i);
-            char *conversion
-                = CFCPerlTypeMap_from_perl(var_type, perl_stack_var);
-            if (!conversion) {
-                CFCUtil_die("Can't map type '%s'", type_c);
-            }
-            if (val) {
-                char pattern[] =
-                    "\n    %s %s = ( items >= %u && XSBind_sv_defined(ST(%u)) )"
-                    " ? %s : %s;";
-                char *statement = CFCUtil_sprintf(pattern, type_c, var_name, i,
-                                                  i, conversion, val);
-                var_assignments
-                    = CFCUtil_cat(var_assignments, statement, NULL);
-                FREEMEM(statement);
-            }
-            else {
-                var_assignments
-                    = CFCUtil_cat(var_assignments, "\n    ", type_c, " ",
-                                  var_name, " = ", conversion, ";", NULL);
-            }
-            FREEMEM(conversion);
-        }
-    }
-
-    char pattern[] =
-        "XS(%s);\n"
-        "XS(%s) {\n"
-        "    dXSARGS;\n"
-        "    CFISH_UNUSED_VAR(cv);\n"
-        "    SP -= items;\n"
-        "    %s;\n"
-        "\n"
-        "    /* Extract vars from Perl stack. */\n"
-        "    %s\n"
-        "\n"
-        "    /* Execute */\n"
-        "    %s\n"
-        "}\n";
-    char *xsub
-        = CFCUtil_sprintf(pattern, self->sub.c_name, self->sub.c_name,
-                          num_args_check, var_assignments, body);
-
-    FREEMEM(num_args_check);
-    FREEMEM(var_assignments);
-    FREEMEM(body);
-    return xsub;
-}
-
-char*
-CFCPerlMethod_callback_def(CFCMethod *method) {
-    CFCType *return_type = CFCMethod_get_return_type(method);
-    char *start = S_callback_start(method);
-    char *callback_def = NULL;
-    char *refcount_mods = S_callback_refcount_mods(method);
-
-    if (!start) {
-        // Can't map vars, because there's at least one type in the argument
-        // list we don't yet support.  Return a callback wrapper that throws
-        // an error error.
-        callback_def = S_invalid_callback_def(method);
-    }
-    else if (CFCType_is_void(return_type)) {
-        callback_def = S_void_callback_def(method, start, refcount_mods);
-    }
-    else if (CFCType_is_object(return_type)) {
-        callback_def = S_obj_callback_def(method, start, refcount_mods);
-    }
-    else if (CFCType_is_integer(return_type)
-             || CFCType_is_floating(return_type)
-        ) {
-        callback_def = S_primitive_callback_def(method, start, refcount_mods);
-    }
-    else {
-        // Can't map return type.
-        callback_def = S_invalid_callback_def(method);
-    }
-
-    FREEMEM(start);
-    FREEMEM(refcount_mods);
-    return callback_def;
-}
-
-static char*
-S_build_unused_vars(CFCVariable **vars) {
-    char *unused = CFCUtil_strdup("");
-
-    for (int i = 0; vars[i] != NULL; i++) {
-        const char *var_name = CFCVariable_micro_sym(vars[i]);
-        size_t size = strlen(unused) + strlen(var_name) + 80;
-        unused = (char*)REALLOCATE(unused, size);
-        strcat(unused, "\n    CFISH_UNUSED_VAR(");
-        strcat(unused, var_name);
-        strcat(unused, ");");
-    }
-
-    return unused;
-}
-
-static char*
-S_maybe_unreachable(CFCType *return_type) {
-    char *return_statement;
-    if (CFCType_is_void(return_type)) {
-        return_statement = CFCUtil_strdup("");
-    }
-    else {
-        const char *ret_type_str = CFCType_to_c(return_type);
-        char pattern[] = "\n    CFISH_UNREACHABLE_RETURN(%s);";
-        return_statement = CFCUtil_sprintf(pattern, ret_type_str);
-    }
-    return return_statement;
-}
-
-static char*
-S_callback_start(CFCMethod *method) {
-    CFCParamList *param_list = CFCMethod_get_param_list(method);
-    static const char pattern[] =
-        "    dSP;\n"
-        "    EXTEND(SP, %d);\n"
-        "    ENTER;\n"
-        "    SAVETMPS;\n"
-        "    PUSHMARK(SP);\n"
-        "    mPUSHs((SV*)CFISH_Obj_To_Host((cfish_Obj*)self));\n";
-    int num_args = (int)CFCParamList_num_vars(param_list) - 1;
-    int num_to_extend = num_args == 0 ? 1
-                      : num_args == 1 ? 2
-                      : 1 + (num_args * 2);
-    char *params = CFCUtil_sprintf(pattern, num_to_extend);
-
-    // Iterate over arguments, mapping them to Perl scalars.
-    CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
-    for (int i = 1; arg_vars[i] != NULL; i++) {
-        CFCVariable *var      = arg_vars[i];
-        const char  *name     = CFCVariable_micro_sym(var);
-        CFCType     *type     = CFCVariable_get_type(var);
-        const char  *c_type   = CFCType_to_c(type);
-
-        // Add labels when there are two or more parameters.
-        if (num_args > 1) {
-            char num_buf[20];
-            sprintf(num_buf, "%d", (int)strlen(name));
-            params = CFCUtil_cat(params, "   mPUSHp(\"", name, "\", ",
-                                 num_buf, ");\n", NULL);
-        }
-
-        if (CFCType_is_string_type(type)) {
-            // Convert Clownfish string type to UTF-8 Perl string scalars.
-            params = CFCUtil_cat(params, "    mPUSHs(XSBind_str_to_sv(",
-                                 "(cfish_String*)", name, "));\n", NULL);
-        }
-        else if (CFCType_is_object(type)) {
-            // Wrap other Clownfish object types in Perl objects.
-            params = CFCUtil_cat(params, "    mPUSHs(XSBind_cfish_to_perl(",
-                                 "(cfish_Obj*)", name, "));\n", NULL);
-        }
-        else if (CFCType_is_integer(type)) {
-            // Convert primitive integer types to IV Perl scalars.
-            int width = (int)CFCType_get_width(type);
-            if (width != 0 && width <= 4) {
-                params = CFCUtil_cat(params, "   mPUSHi(",
-                                     name, ");\n", NULL);
-            }
-            else {
-                // If the Perl IV integer type is not wide enough, use
-                // doubles.  This may be lossy if the value is above 2**52,
-                // but practically speaking, it's important to handle numbers
-                // between 2**32 and 2**52 cleanly.
-                params = CFCUtil_cat(params,
-                                     "    if (sizeof(IV) >= sizeof(", c_type,
-                                     ")) { mPUSHi(", name, "); }\n",
-                                     "    else { mPUSHn((double)", name,
-                                     "); } // lossy \n", NULL);
-            }
-        }
-        else if (CFCType_is_floating(type)) {
-            // Convert primitive floating point types to NV Perl scalars.
-            params = CFCUtil_cat(params, "   mPUSHn(",
-                                 name, ");\n", NULL);
-        }
-        else {
-            // Can't map variable type.  Signal to caller.
-            FREEMEM(params);
-            return NULL;
-        }
-    }
-
-    // Restore the Perl stack pointer.
-    params = CFCUtil_cat(params, "    PUTBACK;\n", NULL);
-
-    return params;
-}
-
-static char*
-S_callback_refcount_mods(CFCMethod *method) {
-    char *refcount_mods = CFCUtil_strdup("");
-    CFCType *return_type = CFCMethod_get_return_type(method);
-    CFCParamList *param_list = CFCMethod_get_param_list(method);
-    CFCVariable **arg_vars = CFCParamList_get_variables(param_list);
-
-    // `XSBind_perl_to_cfish()` returns an incremented object.  If this method
-    // does not return an incremented object, we must cancel out that
-    // refcount.  (No function can return a decremented object.)
-    if (CFCType_is_object(return_type) && !CFCType_incremented(return_type)) {
-        refcount_mods = CFCUtil_cat(refcount_mods,
-                                    "\n    CFISH_DECREF(retval);", NULL);
-    }
-
-    // Adjust refcounts of arguments per method signature, so that Perl code
-    // does not have to.
-    for (int i = 0; arg_vars[i] != NULL; i++) {
-        CFCVariable *var  = arg_vars[i];
-        CFCType     *type = CFCVariable_get_type(var);
-        const char  *name = CFCVariable_micro_sym(var);
-        if (!CFCType_is_object(type)) {
-            continue;
-        }
-        else if (CFCType_incremented(type)) {
-            refcount_mods = CFCUtil_cat(refcount_mods, "\n    CFISH_INCREF(",
-                                        name, ");", NULL);
-        }
-        else if (CFCType_decremented(type)) {
-            refcount_mods = CFCUtil_cat(refcount_mods, "\n    CFISH_DECREF(",
-                                        name, ");", NULL);
-        }
-    }
-
-    return refcount_mods;
-}
-
-static char*
-S_invalid_callback_def(CFCMethod *method) {
-    char *full_method_sym = CFCMethod_full_method_sym(method, NULL);
-
-    const char *override_sym = CFCMethod_full_override_sym(method);
-    CFCParamList *param_list = CFCMethod_get_param_list(method);
-    const char *params = CFCParamList_to_c(param_list);
-    CFCVariable **param_vars = CFCParamList_get_variables(param_list);
-
-    // Thwart compiler warnings.
-    CFCType *return_type = CFCMethod_get_return_type(method);
-    const char *ret_type_str = CFCType_to_c(return_type);
-    char *unused = S_build_unused_vars(param_vars);
-    char *unreachable = S_maybe_unreachable(return_type);
-
-    char pattern[] =
-        "%s\n"
-        "%s(%s) {%s\n"
-        "    CFISH_THROW(CFISH_ERR, \"Can't override %s via binding\");%s\n"
-        "}\n";
-    char *callback_def
-        = CFCUtil_sprintf(pattern, ret_type_str, override_sym, params, unused,
-                          full_method_sym, unreachable);
-
-    FREEMEM(full_method_sym);
-    FREEMEM(unreachable);
-    FREEMEM(unused);
-    return callback_def;
-}
-
-static char*
-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);
-    const char pattern[] =
-        "void\n"
-        "%s(%s) {\n"
-        "%s"
-        "    S_finish_callback_void(\"%s\");%s\n"
-        "}\n";
-    char *callback_def
-        = CFCUtil_sprintf(pattern, override_sym, params, callback_start,
-                          micro_sym, refcount_mods);
-
-    return callback_def;
-}
-
-static char*
-S_primitive_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));
-    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)) {
-        strcpy(callback_func, "S_finish_callback_i64");
-    }
-    else if (CFCType_is_floating(return_type)) {
-        strcpy(callback_func, "S_finish_callback_f64");
-    }
-    else {
-        CFCUtil_die("Unexpected type: %s", ret_type_str);
-    }
-
-    char pattern[] =
-        "%s\n"
-        "%s(%s) {\n"
-        "%s"
-        "    %s retval = (%s)%s(\"%s\");%s\n"
-        "    return retval;\n"
-        "}\n";
-    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);
-
-    return callback_def;
-}
-
-static char*
-S_obj_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));
-    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 pattern[] =
-        "%s\n"
-        "%s(%s) {\n"
-        "%s"
-        "    %s retval = (%s)S_finish_callback_obj(self, \"%s\", %s);%s\n"
-        "    return retval;\n"
-        "}\n";
-    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);
-
-    return callback_def;
-}
-

http://git-wip-us.apache.org/repos/asf/lucy/blob/1704c275/clownfish/compiler/src/CFCPerlMethod.h
----------------------------------------------------------------------
diff --git a/clownfish/compiler/src/CFCPerlMethod.h b/clownfish/compiler/src/CFCPerlMethod.h
deleted file mode 100644
index dbd19c0..0000000
--- a/clownfish/compiler/src/CFCPerlMethod.h
+++ /dev/null
@@ -1,69 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements.  See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License.  You may obtain a copy of the License at
- *
- *     http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#ifndef H_CFCPERLMETHOD
-#define H_CFCPERLMETHOD
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/** Clownfish::CFC::Binding::Perl::Method - Binding for an object method.
- *
- * 
- * This class isa Clownfish::CFC::Binding::Perl::Subroutine -- see its
- * documentation for various code-generating routines.
- * 
- * Method bindings use labeled parameters if the C function takes more than one
- * argument (other than "self").  If there is only one argument, the binding
- * will be set up to accept a single positional argument.
- */
-typedef struct CFCPerlMethod CFCPerlMethod;
-struct CFCMethod;
-
-CFCPerlMethod*
-CFCPerlMethod_new(struct CFCMethod *method, const char *alias);
-
-/**
- * @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);
-
-void
-CFCPerlMethod_destroy(CFCPerlMethod *self);
-
-/** Generate C code for the XSUB.
- */
-char*
-CFCPerlMethod_xsub_def(CFCPerlMethod *self);
-
-/** Return C code implementing a callback to Perl for this method.  This code
- * is run when a Perl subclass has overridden a method in a Clownfish base
- * class.
- */
-char*
-CFCPerlMethod_callback_def(struct CFCMethod *method);
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* H_CFCPERLMETHOD */
-

http://git-wip-us.apache.org/repos/asf/lucy/blob/1704c275/clownfish/compiler/src/CFCPerlPod.c
----------------------------------------------------------------------
diff --git a/clownfish/compiler/src/CFCPerlPod.c b/clownfish/compiler/src/CFCPerlPod.c
deleted file mode 100644
index 78c804f..0000000
--- a/clownfish/compiler/src/CFCPerlPod.c
+++ /dev/null
@@ -1,391 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements.  See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License.  You may obtain a copy of the License at
- *
- *     http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#include <string.h>
-#include <ctype.h>
-#define CFC_NEED_BASE_STRUCT_DEF
-#include "CFCBase.h"
-#include "CFCPerlPod.h"
-#include "CFCUtil.h"
-#include "CFCClass.h"
-#include "CFCMethod.h"
-#include "CFCParcel.h"
-#include "CFCParamList.h"
-#include "CFCFunction.h"
-#include "CFCDocuComment.h"
-
-#ifndef true
-  #define true 1
-  #define false 0
-#endif
-
-typedef struct NamePod {
-    char *alias;
-    char *func;
-    char *sample;
-    char *pod;
-} NamePod;
-
-struct CFCPerlPod {
-    CFCBase base;
-    char    *synopsis;
-    char    *description;
-    NamePod *methods;
-    size_t   num_methods;
-    NamePod *constructors;
-    size_t   num_constructors;
-};
-
-static const CFCMeta CFCPERLPOD_META = {
-    "Clownfish::CFC::Binding::Perl::Pod",
-    sizeof(CFCPerlPod),
-    (CFCBase_destroy_t)CFCPerlPod_destroy
-};
-
-CFCPerlPod*
-CFCPerlPod_new(void) {
-    CFCPerlPod *self
-        = (CFCPerlPod*)CFCBase_allocate(&CFCPERLPOD_META);
-    return CFCPerlPod_init(self);
-}
-
-CFCPerlPod*
-CFCPerlPod_init(CFCPerlPod *self) {
-    self->synopsis         = CFCUtil_strdup("");
-    self->description      = CFCUtil_strdup("");
-    self->methods          = NULL;
-    self->constructors     = NULL;
-    self->num_methods      = 0;
-    self->num_constructors = 0;
-    return self;
-}
-
-void
-CFCPerlPod_destroy(CFCPerlPod *self) {
-    FREEMEM(self->synopsis);
-    FREEMEM(self->description);
-    for (size_t i = 0; i < self->num_methods; i++) {
-        FREEMEM(self->methods[i].alias);
-        FREEMEM(self->methods[i].pod);
-        FREEMEM(self->methods[i].func);
-        FREEMEM(self->methods[i].sample);
-    }
-    FREEMEM(self->methods);
-    for (size_t i = 0; i < self->num_constructors; i++) {
-        FREEMEM(self->constructors[i].alias);
-        FREEMEM(self->constructors[i].pod);
-        FREEMEM(self->constructors[i].func);
-        FREEMEM(self->constructors[i].sample);
-    }
-    FREEMEM(self->constructors);
-    CFCBase_destroy((CFCBase*)self);
-}
-
-void
-CFCPerlPod_add_method(CFCPerlPod *self, const char *alias, const char *method,
-                      const char *sample, const char *pod) {
-    CFCUTIL_NULL_CHECK(alias);
-    self->num_methods++;
-    size_t size = self->num_methods * sizeof(NamePod);
-    self->methods = (NamePod*)REALLOCATE(self->methods, size);
-    NamePod *slot = &self->methods[self->num_methods - 1];
-    slot->alias  = CFCUtil_strdup(alias);
-    slot->func   = method ? CFCUtil_strdup(method) : NULL;
-    slot->sample = CFCUtil_strdup(sample ? sample : "");
-    slot->pod    = pod ? CFCUtil_strdup(pod) : NULL;
-}
-
-void
-CFCPerlPod_add_constructor(CFCPerlPod *self, const char *alias,
-                           const char *initializer, const char *sample,
-                           const char *pod) {
-    self->num_constructors++;
-    size_t size = self->num_constructors * sizeof(NamePod);
-    self->constructors = (NamePod*)REALLOCATE(self->constructors, size);
-    NamePod *slot = &self->constructors[self->num_constructors - 1];
-    slot->alias  = CFCUtil_strdup(alias ? alias : "new");
-    slot->func   = CFCUtil_strdup(initializer ? initializer : "init");
-    slot->sample = CFCUtil_strdup(sample ? sample : "");
-    slot->pod    = pod ? CFCUtil_strdup(pod) : NULL;
-}
-
-void
-CFCPerlPod_set_synopsis(CFCPerlPod *self, const char *synopsis) {
-    FREEMEM(self->synopsis);
-    self->synopsis = CFCUtil_strdup(synopsis);
-}
-
-const char*
-CFCPerlPod_get_synopsis(CFCPerlPod *self) {
-    return self->synopsis;
-}
-
-void
-CFCPerlPod_set_description(CFCPerlPod *self, const char *description) {
-    FREEMEM(self->description);
-    self->description = CFCUtil_strdup(description);
-}
-
-const char*
-CFCPerlPod_get_description(CFCPerlPod *self) {
-    return self->description;
-}
-
-char*
-CFCPerlPod_methods_pod(CFCPerlPod *self, CFCClass *klass) {
-    const char *class_name = CFCClass_get_class_name(klass);
-    char *abstract_pod = CFCUtil_strdup("");
-    char *methods_pod  = CFCUtil_strdup("");
-    for (size_t i = 0; i < self->num_methods; i++) {
-        NamePod meth_spec = self->methods[i];
-        CFCMethod *method = CFCClass_method(klass, meth_spec.func);
-        if (!method) {
-            method = CFCClass_method(klass, meth_spec.alias);
-        }
-        if (!method) {
-            CFCUtil_die("Can't find method '%s' in class '%s'",
-                        meth_spec.alias, CFCClass_get_class_name(klass));
-        }
-        char *meth_pod;
-        if (meth_spec.pod) {
-            meth_pod = CFCPerlPod_perlify_doc_text(self, meth_spec.pod);
-        }
-        else {
-            char *raw
-                = CFCPerlPod_gen_subroutine_pod(self, (CFCFunction*)method,
-                                                meth_spec.alias, klass,
-                                                meth_spec.sample, class_name,
-                                                false);
-            meth_pod = CFCPerlPod_perlify_doc_text(self, raw);
-            FREEMEM(raw);
-        }
-        if (CFCMethod_abstract(method)) {
-            abstract_pod = CFCUtil_cat(abstract_pod, meth_pod, NULL);
-        }
-        else {
-            methods_pod = CFCUtil_cat(methods_pod, meth_pod, NULL);
-        }
-        FREEMEM(meth_pod);
-    }
-
-    char *pod = CFCUtil_strdup("");
-    if (strlen(abstract_pod)) {
-        pod = CFCUtil_cat(pod, "=head1 ABSTRACT METHODS\n\n", abstract_pod, NULL);
-    }
-    FREEMEM(abstract_pod);
-    if (strlen(methods_pod)) {
-        pod = CFCUtil_cat(pod, "=head1 METHODS\n\n", methods_pod, NULL);
-    }
-    FREEMEM(methods_pod);
-
-    return pod;
-}
-
-char*
-CFCPerlPod_constructors_pod(CFCPerlPod *self, CFCClass *klass) {
-    if (!self->num_constructors) {
-        return CFCUtil_strdup("");
-    }
-    const char *class_name = CFCClass_get_class_name(klass);
-    char *pod = CFCUtil_strdup("=head1 CONSTRUCTORS\n\n");
-    for (size_t i = 0; i < self->num_constructors; i++) {
-        NamePod slot = self->constructors[i];
-        if (slot.pod) {
-            char *perlified = CFCPerlPod_perlify_doc_text(self, slot.pod);
-            pod = CFCUtil_cat(pod, perlified, NULL);
-            FREEMEM(perlified);
-        }
-        else {
-            CFCFunction *init_func = CFCClass_function(klass, slot.func);
-            char *sub_pod
-                = CFCPerlPod_gen_subroutine_pod(self, init_func, slot.alias, klass,
-                                                slot.sample, class_name, true);
-            char *perlified = CFCPerlPod_perlify_doc_text(self, sub_pod);
-            pod = CFCUtil_cat(pod, perlified, NULL);
-            FREEMEM(sub_pod);
-            FREEMEM(perlified);
-        }
-    }
-    return pod;
-}
-
-static char*
-S_global_replace(const char *string, const char *match,
-                 const char *replacement) {
-    char *found = (char*)string;
-    int   string_len      = (int)strlen(string);
-    int   match_len       = (int)strlen(match);
-    int   replacement_len = (int)strlen(replacement);
-    int   len_diff        = replacement_len - match_len;
-
-    // Allocate space.
-    unsigned count = 0;
-    while (NULL != (found = strstr(found, match))) {
-        count++;
-        found += match_len;
-    }
-    int size = string_len + count * len_diff + 1;
-    char *modified = (char*)MALLOCATE(size);
-    modified[size - 1] = 0; // NULL-terminate.
-
-    // Iterate through all matches.
-    found = (char*)string;
-    char *target = modified;
-    size_t last_end = 0;
-    if (count) {
-        while (NULL != (found = strstr(found, match))) {
-            size_t pos = found - string;
-            size_t unchanged_len = pos - last_end;
-            found += match_len;
-            memcpy(target, string + last_end, unchanged_len);
-            target += unchanged_len;
-            last_end = pos + match_len;
-            memcpy(target, replacement, replacement_len);
-            target += replacement_len;
-        }
-    }
-    size_t remaining = string_len - last_end;
-    memcpy(target, string + string_len - remaining, remaining);
-
-    return modified;
-}
-
-char*
-CFCPerlPod_gen_subroutine_pod(CFCPerlPod *self, CFCFunction *func,
-                              const char *alias, CFCClass *klass,
-                              const char *code_sample,
-                              const char *class_name, int is_constructor) {
-    // Only allow "public" subs to be exposed as part of the public API.
-    if (!CFCFunction_public(func)) {
-        CFCUtil_die("%s#%s is not public", class_name, alias);
-    }
-
-    CFCParamList *param_list = CFCFunction_get_param_list(func);
-    int num_vars = (int)CFCParamList_num_vars(param_list);
-    char *pod = CFCUtil_sprintf("=head2 %s", alias);
-
-    // Get documentation, which may be inherited.
-    CFCDocuComment *docucomment = CFCFunction_get_docucomment(func);
-    if (!docucomment) {
-        const char *micro_sym = CFCFunction_micro_sym(func);
-        CFCClass *parent = klass;
-        while (NULL != (parent = CFCClass_get_parent(parent))) {
-            CFCFunction *parent_func
-                = (CFCFunction*)CFCClass_method(parent, micro_sym);
-            if (!parent_func) { break; }
-            docucomment = CFCFunction_get_docucomment(parent_func);
-            if (docucomment) { break; }
-        }
-    }
-    if (!docucomment) {
-        CFCUtil_die("No DocuComment for '%s' in '%s'", alias, class_name);
-    }
-
-    // Build string summarizing arguments to use in header.
-    if (num_vars > 2 || (is_constructor && num_vars > 1)) {
-        pod = CFCUtil_cat(pod, "( I<[labeled params]> )\n\n", NULL);
-    }
-    else if (num_vars == 2) {
-        // Kill self param.
-        const char *name_list = CFCParamList_name_list(param_list);
-        const char *after_comma = strchr(name_list, ',') + 1;
-        while (isspace(*after_comma)) { after_comma++; }
-        pod = CFCUtil_cat(pod, "(", after_comma, ")\n\n", NULL);
-    }
-    else {
-        // num_args == 1, leave off 'self'.
-        pod = CFCUtil_cat(pod, "()\n\n", NULL);
-    }
-
-    // Add code sample.
-    if (code_sample && strlen(code_sample)) {
-        pod = CFCUtil_cat(pod, code_sample, "\n", NULL);
-    }
-
-    // Incorporate "description" text from DocuComment.
-    const char *long_doc = CFCDocuComment_get_description(docucomment);
-    if (long_doc && strlen(long_doc)) {
-        char *perlified = CFCPerlPod_perlify_doc_text(self, long_doc);
-        pod = CFCUtil_cat(pod, perlified, "\n\n", NULL);
-        FREEMEM(perlified);
-    }
-
-    // Add params in a list.
-    const char**param_names = CFCDocuComment_get_param_names(docucomment);
-    const char**param_docs  = CFCDocuComment_get_param_docs(docucomment);
-    if (param_names[0]) {
-        pod = CFCUtil_cat(pod, "=over\n\n", NULL);
-        for (size_t i = 0; param_names[i] != NULL; i++) {
-            pod = CFCUtil_cat(pod, "=item *\n\nB<", param_names[i], "> - ",
-                              param_docs[i], "\n\n", NULL);
-        }
-        pod = CFCUtil_cat(pod, "=back\n\n", NULL);
-    }
-
-    // Add return value description, if any.
-    const char *retval_doc = CFCDocuComment_get_retval(docucomment);
-    if (retval_doc && strlen(retval_doc)) {
-        pod = CFCUtil_cat(pod, "Returns: ", retval_doc, "\n\n", NULL);
-    }
-
-    return pod;
-}
-
-char*
-CFCPerlPod_perlify_doc_text(CFCPerlPod *self, const char *source) {
-    (void)self; // unused
-
-    // Change <code>foo</code> to C<< foo >>.
-    char *copy = CFCUtil_strdup(source);
-    char *orig = copy;
-    copy = S_global_replace(orig, "<code>", "C<< ");
-    FREEMEM(orig);
-    orig = copy;
-    copy = S_global_replace(orig, "</code>", " >>");
-    FREEMEM(orig);
-
-    // Lowercase all method names: Open_In() => open_in()
-    for (size_t i = 0, max = strlen(copy); i < max; i++) {
-        if (isupper(copy[i])) {
-            size_t mark = i;
-            for (; i < max; i++) {
-                char c = copy[i];
-                if (!(isalpha(c) || c == '_')) {
-                    if (memcmp(copy + i, "()", 2) == 0) {
-                        for (size_t j = mark; j < i; j++) {
-                            copy[j] = tolower(copy[j]);
-                        }
-                        i += 2; // go past parens.
-                    }
-                    break;
-                }
-            }
-        }
-    }
-
-    // Change all instances of NULL to 'undef'
-    orig = copy;
-    copy = S_global_replace(orig, "NULL", "undef");
-    FREEMEM(orig);
-
-    // Change "Err_error" to "Clownfish->error".
-    orig = copy;
-    copy = S_global_replace(orig, "Err_error", "Clownfish->error");
-    FREEMEM(orig);
-
-    return copy;
-}
-

http://git-wip-us.apache.org/repos/asf/lucy/blob/1704c275/clownfish/compiler/src/CFCPerlPod.h
----------------------------------------------------------------------
diff --git a/clownfish/compiler/src/CFCPerlPod.h b/clownfish/compiler/src/CFCPerlPod.h
deleted file mode 100644
index 3fb94eb..0000000
--- a/clownfish/compiler/src/CFCPerlPod.h
+++ /dev/null
@@ -1,125 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements.  See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License.  You may obtain a copy of the License at
- *
- *     http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#ifndef H_CFCPERLPOD
-#define H_CFCPERLPOD
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/** Spec for generating POD for a single class.
- */
-
-typedef struct CFCPerlPod CFCPerlPod;
-struct CFCFunction;
-struct CFCClass;
-
-CFCPerlPod*
-CFCPerlPod_new(void);
-
-CFCPerlPod*
-CFCPerlPod_init(CFCPerlPod *self);
-
-void
-CFCPerlPod_destroy(CFCPerlPod *self);
-
-/** Add pod for a method.
- * 
- * @param alias The name of the method, spelled as it will be used from
- * Perl-space.
- * @param method The name of the method from the Clownfish class.  If not
- * supplied, an attempt will be made to locate the correct method using
- * <code>alias</code>.
- * @param sample An optional Perl usage sample.
- * @param pod Optional verbatim POD, which will override all POD which would
- * otherwise have been generated.
- */
-void
-CFCPerlPod_add_method(CFCPerlPod *self, const char *alias, const char *method,
-                      const char *sample, const char *pod);
-
-/** Add pod for a constructor.
- * 
- * @param alias The name of the constructor, spelled as it will be used from
- * Perl-space.
- * @param initializer The name of the initialization routine from the
- * Clownfish class.  Defaults to "init".
- * @param sample An optional Perl usage sample.
- * @param pod Optional verbatim POD, which will override all POD which would
- * otherwise have been generated.
- */
-void
-CFCPerlPod_add_constructor(CFCPerlPod *self, const char *alias,
-                           const char *initializer, const char *sample,
-                           const char *pod);
-
-/** Generate POD for a METHODS section and possibly an ABSTRACT METHODS
- * section as well.
- */
-char*
-CFCPerlPod_methods_pod(CFCPerlPod *self, struct CFCClass *klass);
-
-/** Generate POD for a CONSTRUCTORS section.
- */
-char*
-CFCPerlPod_constructors_pod(CFCPerlPod *self, struct CFCClass *klass);
-
-/** Supply a SYNOPSIS section.
- */
-void
-CFCPerlPod_set_synopsis(CFCPerlPod *self, const char *synopsis);
-
-/** Accessor for SYNOPSIS text.
- */
-const char*
-CFCPerlPod_get_synopsis(CFCPerlPod *self);
-
-/** Supply a DESCRIPTION section.
- */
-void
-CFCPerlPod_set_description(CFCPerlPod *self, const char *description);
-
-/** Accessor for DESCRIPTION text.
- */
-const char*
-CFCPerlPod_get_description(CFCPerlPod *self);
-
-char*
-CFCPerlPod_perlify_doc_text(CFCPerlPod *self, const char *source);
-
-/** Autogenerate pod for either a Clownfish::CFC::Model::Method or a
- * Clownfish::CFC::Model::Function.
- * 
- * @param func The Method or Function.
- * @param alias The Perl name for the subroutine.
- * @param klass The Clownfish::CFC::Model::Class.
- * @param code_sample Optional example usage code.
- * @param is_construtor Indicate whether this is a constructor, as the default
- * argument handling is different for constructors.
- */
-char*
-CFCPerlPod_gen_subroutine_pod(CFCPerlPod *self, struct CFCFunction *func,
-                              const char *alias, struct CFCClass *klass,
-                              const char *code_sample,
-                              const char *class_name, int is_constructor);
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* H_CFCPERLPOD */
-

http://git-wip-us.apache.org/repos/asf/lucy/blob/1704c275/clownfish/compiler/src/CFCPerlSub.c
----------------------------------------------------------------------
diff --git a/clownfish/compiler/src/CFCPerlSub.c b/clownfish/compiler/src/CFCPerlSub.c
deleted file mode 100644
index 5d8d1f2..0000000
--- a/clownfish/compiler/src/CFCPerlSub.c
+++ /dev/null
@@ -1,262 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements.  See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License.  You may obtain a copy of the License at
- *
- *     http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#include <string.h>
-#include <stdio.h>
-#define CFC_NEED_BASE_STRUCT_DEF
-#define CFC_NEED_PERLSUB_STRUCT_DEF
-#include "CFCPerlSub.h"
-#include "CFCBase.h"
-#include "CFCUtil.h"
-#include "CFCParamList.h"
-#include "CFCVariable.h"
-#include "CFCType.h"
-
-#ifndef true
-    #define true 1
-    #define false 0
-#endif
-
-CFCPerlSub*
-CFCPerlSub_init(CFCPerlSub *self, CFCParamList *param_list,
-                const char *class_name, const char *alias,
-                int use_labeled_params) {
-    CFCUTIL_NULL_CHECK(param_list);
-    CFCUTIL_NULL_CHECK(class_name);
-    CFCUTIL_NULL_CHECK(alias);
-    self->param_list  = (CFCParamList*)CFCBase_incref((CFCBase*)param_list);
-    self->class_name  = CFCUtil_strdup(class_name);
-    self->alias       = CFCUtil_strdup(alias);
-    self->use_labeled_params = use_labeled_params;
-    self->perl_name = CFCUtil_sprintf("%s::%s", class_name, alias);
-
-    size_t c_name_len = strlen(self->perl_name) + sizeof("XS_") + 1;
-    self->c_name = (char*)MALLOCATE(c_name_len);
-    int j = 3;
-    memcpy(self->c_name, "XS_", j);
-    for (int i = 0, max = (int)strlen(self->perl_name); i < max; i++) {
-        char c = self->perl_name[i];
-        if (c == ':') {
-            while (self->perl_name[i + 1] == ':') { i++; }
-            self->c_name[j++] = '_';
-        }
-        else {
-            self->c_name[j++] = c;
-        }
-    }
-    self->c_name[j] = 0; // NULL-terminate.
-
-    return self;
-}
-
-void
-CFCPerlSub_destroy(CFCPerlSub *self) {
-    CFCBase_decref((CFCBase*)self->param_list);
-    FREEMEM(self->class_name);
-    FREEMEM(self->alias);
-    FREEMEM(self->perl_name);
-    FREEMEM(self->c_name);
-    CFCBase_destroy((CFCBase*)self);
-}
-
-char*
-CFCPerlSub_params_hash_def(CFCPerlSub *self) {
-    if (!self->use_labeled_params) {
-        return NULL;
-    }
-
-    char *def = CFCUtil_strdup("");
-    def = CFCUtil_cat(def, "%", self->perl_name, "_PARAMS = (", NULL);
-
-    CFCVariable **arg_vars = CFCParamList_get_variables(self->param_list);
-    const char **vals = CFCParamList_get_initial_values(self->param_list);
-
-    // No labeled params means an empty params hash def.
-    if (!arg_vars[1]) {
-        def = CFCUtil_cat(def, ");\n", NULL);
-        return def;
-    }
-
-    for (int i = 1; arg_vars[i] != NULL; i++) {
-        CFCVariable *var = arg_vars[i];
-        const char *micro_sym = CFCVariable_micro_sym(var);
-        const char *val = vals[i];
-        val = val == NULL
-              ? "undef"
-              : strcmp(val, "NULL") == 0
-              ? "undef"
-              : strcmp(val, "true") == 0
-              ? "1"
-              : strcmp(val, "false") == 0
-              ? "0"
-              : val;
-        def = CFCUtil_cat(def, "\n    ", micro_sym, " => ", val, ",", NULL);
-    }
-    def = CFCUtil_cat(def, "\n);\n", NULL);
-
-    return def;
-}
-
-struct allot_macro_map {
-    const char *prim_type;
-    const char *allot_macro;
-};
-
-struct allot_macro_map prim_type_to_allot_macro[] = {
-    { "double",     "ALLOT_F64"    },
-    { "float",      "ALLOT_F32"    },
-    { "int",        "ALLOT_INT"    },
-    { "short",      "ALLOT_SHORT"  },
-    { "long",       "ALLOT_LONG"   },
-    { "size_t",     "ALLOT_SIZE_T" },
-    { "uint64_t",   "ALLOT_U64"    },
-    { "uint32_t",   "ALLOT_U32"    },
-    { "uint16_t",   "ALLOT_U16"    },
-    { "uint8_t",    "ALLOT_U8"     },
-    { "int64_t",    "ALLOT_I64"    },
-    { "int32_t",    "ALLOT_I32"    },
-    { "int16_t",    "ALLOT_I16"    },
-    { "int8_t",     "ALLOT_I8"     },
-    { "bool",       "ALLOT_BOOL"   },
-    { NULL, NULL }
-};
-
-static char*
-S_allot_params_arg(CFCType *type, const char *label, int required) {
-    const char *type_c_string = CFCType_to_c(type);
-    unsigned label_len = (unsigned)strlen(label);
-    const char *req_string = required ? "true" : "false";
-
-    if (CFCType_is_object(type)) {
-        const char *struct_sym = CFCType_get_specifier(type);
-        const char *vtable_var = CFCType_get_vtable_var(type);
-
-        // Share buffers rather than copy between Perl scalars and Clownfish
-        // string types.
-        int use_sv_buffer = false;
-        if (strcmp(struct_sym, "cfish_String") == 0
-            || strcmp(struct_sym, "cfish_Obj") == 0
-           ) {
-            use_sv_buffer = true;
-        }
-        const char *allocation = use_sv_buffer
-                                 ? "alloca(cfish_SStr_size())"
-                                 : "NULL";
-        const char pattern[] = "ALLOT_OBJ(&%s, \"%s\", %u, %s, %s, %s)";
-        char *arg = CFCUtil_sprintf(pattern, label, label, label_len,
-                                    req_string, vtable_var, allocation);
-        return arg;
-    }
-    else if (CFCType_is_primitive(type)) {
-        for (int i = 0; prim_type_to_allot_macro[i].prim_type != NULL; i++) {
-            const char *prim_type = prim_type_to_allot_macro[i].prim_type;
-            if (strcmp(prim_type, type_c_string) == 0) {
-                const char *allot = prim_type_to_allot_macro[i].allot_macro;
-                char pattern[] = "%s(&%s, \"%s\", %u, %s)";
-                char *arg = CFCUtil_sprintf(pattern, allot, label, label,
-                                            label_len, req_string);
-                return arg;
-            }
-        }
-    }
-
-    CFCUtil_die("Missing typemap for %s", type_c_string);
-    return NULL; // unreachable
-}
-
-char*
-CFCPerlSub_build_allot_params(CFCPerlSub *self) {
-    CFCParamList *param_list = self->param_list;
-    CFCVariable **arg_vars   = CFCParamList_get_variables(param_list);
-    const char  **arg_inits  = CFCParamList_get_initial_values(param_list);
-    size_t        num_vars   = CFCParamList_num_vars(param_list);
-    char *allot_params = CFCUtil_strdup("");
-
-    // Declare variables and assign default values.
-    for (size_t i = 1; i < num_vars; i++) {
-        CFCVariable *arg_var = arg_vars[i];
-        const char  *val     = arg_inits[i];
-        const char  *local_c = CFCVariable_local_c(arg_var);
-        if (val == NULL) {
-            CFCType *arg_type = CFCVariable_get_type(arg_var);
-            val = CFCType_is_object(arg_type)
-                  ? "NULL"
-                  : "0";
-        }
-        allot_params = CFCUtil_cat(allot_params, local_c, " = ", val,
-                                   ";\n    ", NULL);
-    }
-
-    // Iterate over args in param list.
-    allot_params
-        = CFCUtil_cat(allot_params,
-                      "bool args_ok = XSBind_allot_params(\n"
-                      "        &(ST(0)), 1, items, ", NULL);
-    for (size_t i = 1; i < num_vars; i++) {
-        CFCVariable *var = arg_vars[i];
-        const char  *val = arg_inits[i];
-        int required = val ? 0 : 1;
-        const char *name = CFCVariable_micro_sym(var);
-        CFCType *type = CFCVariable_get_type(var);
-        char *arg = S_allot_params_arg(type, name, required);
-        allot_params
-            = CFCUtil_cat(allot_params, "        ", arg, ",\n", NULL);
-        FREEMEM(arg);
-    }
-    allot_params
-        = CFCUtil_cat(allot_params, "        NULL);\n",
-                      "    if (!args_ok) {\n"
-                      "        CFISH_RETHROW(CFISH_INCREF(cfish_Err_get_error()));\n"
-                      "    }", NULL);
-
-    return allot_params;
-}
-
-CFCParamList*
-CFCPerlSub_get_param_list(CFCPerlSub *self) {
-    return self->param_list;
-}
-
-const char*
-CFCPerlSub_get_class_name(CFCPerlSub *self) {
-    return self->class_name;
-}
-
-const char*
-CFCPerlSub_get_alias(CFCPerlSub *self) {
-    return self->alias;
-}
-
-int
-CFCPerlSub_use_labeled_params(CFCPerlSub *self) {
-    return self->use_labeled_params;
-}
-
-const char*
-CFCPerlSub_perl_name(CFCPerlSub *self) {
-    return self->perl_name;
-}
-
-const char*
-CFCPerlSub_c_name(CFCPerlSub *self) {
-    return self->c_name;
-}
-
-const char*
-CFCPerlSub_c_name_list(CFCPerlSub *self) {
-    return CFCParamList_name_list(self->param_list);
-}
-

http://git-wip-us.apache.org/repos/asf/lucy/blob/1704c275/clownfish/compiler/src/CFCPerlSub.h
----------------------------------------------------------------------
diff --git a/clownfish/compiler/src/CFCPerlSub.h b/clownfish/compiler/src/CFCPerlSub.h
deleted file mode 100644
index 6bc846c..0000000
--- a/clownfish/compiler/src/CFCPerlSub.h
+++ /dev/null
@@ -1,120 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements.  See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License.  You may obtain a copy of the License at
- *
- *     http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#ifndef H_CFCPERLSUB
-#define H_CFCPERLSUB
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-typedef struct CFCPerlSub CFCPerlSub;
-struct CFCParamList;
-struct CFCType;
-
-#ifdef CFC_NEED_PERLSUB_STRUCT_DEF
-#define CFC_NEED_BASE_STRUCT_DEF
-#include "CFCBase.h"
-struct CFCPerlSub {
-    CFCBase base;
-    struct CFCParamList *param_list;
-    char *class_name;
-    char *alias;
-    int use_labeled_params;
-    char *perl_name;
-    char *c_name;
-};
-#endif
-
-/** Clownfish::CFC::Binding::Perl::Subroutine - Abstract base binding for a
- * Clownfish::CFC::Model::Function.
- * 
- * This class is used to generate binding code for invoking Clownfish's
- * functions and methods across the Perl/C barrier.
- */ 
-
-/** Abstract constructor.
- * 
- * @param param_list A Clownfish::CFC::Model::ParamList.
- * @param class_name The name of the Perl class that the subroutine belongs
- * to.
- * @param alias The local, unqualified name for the Perl subroutine that
- * will be used to invoke the function.
- * @param use_labeled_params True if the binding should take hash-style
- * labeled parameters, false if it should take positional arguments.
- */
-CFCPerlSub*
-CFCPerlSub_init(CFCPerlSub *self, struct CFCParamList *param_list,
-                const char *class_name, const char *alias,
-                int use_labeled_params);
-
-void
-CFCPerlSub_destroy(CFCPerlSub *self);
-
-/** Return Perl code initializing a package-global hash where all the keys are
- * the names of labeled params.  The hash's name consists of the the binding's
- * perl_name() plus "_PARAMS".
- */
-char*
-CFCPerlSub_params_hash_def(CFCPerlSub *self);
-
-/** Generate code which will invoke XSBind_allot_params() to parse labeled
- * parameters supplied to an XSUB.
- */
-char*
-CFCPerlSub_build_allot_params(CFCPerlSub *self);
-
-/** Accessor for param list.
- */
-struct CFCParamList*
-CFCPerlSub_get_param_list(CFCPerlSub *self);
-
-/** Accessor for class name.
- */
-const char*
-CFCPerlSub_get_class_name(CFCPerlSub *self);
-
-/** Accessor for use_labeled_params.
- */
-int
-CFCPerlSub_use_labeled_params(CFCPerlSub *self);
-
-/**
- * @return the fully-qualified perl subroutine name.
- */
-const char*
-CFCPerlSub_perl_name(CFCPerlSub *self);
-
-/**
- * @return the fully-qualified name of the C function that implements the
- * XSUB.
- */
-const char*
-CFCPerlSub_c_name(CFCPerlSub *self);
-
-/**
- * @return a string containing the names of arguments to feed to bound C
- * function, joined by commas.
- */
-const char*
-CFCPerlSub_c_name_list(CFCPerlSub *self);
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* H_CFCPERLSUB */
-

http://git-wip-us.apache.org/repos/asf/lucy/blob/1704c275/clownfish/compiler/src/CFCPerlTypeMap.c
----------------------------------------------------------------------
diff --git a/clownfish/compiler/src/CFCPerlTypeMap.c b/clownfish/compiler/src/CFCPerlTypeMap.c
deleted file mode 100644
index 4553a13..0000000
--- a/clownfish/compiler/src/CFCPerlTypeMap.c
+++ /dev/null
@@ -1,306 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements.  See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License.  You may obtain a copy of the License at
- *
- *     http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#include <string.h>
-#include <stdio.h>
-#include "CFCPerlTypeMap.h"
-#include "CFCUtil.h"
-#include "CFCHierarchy.h"
-#include "CFCClass.h"
-#include "CFCType.h"
-
-#ifndef true
-    #define true 1
-    #define false 0
-#endif
-
-// Convert from a Perl scalar to a primitive type.
-struct char_map {
-    char *key;
-    char *value;
-};
-
-
-char*
-CFCPerlTypeMap_from_perl(CFCType *type, const char *xs_var) {
-    char *result = NULL;
-
-    if (CFCType_is_object(type)) {
-        const char *struct_sym = CFCType_get_specifier(type);
-        const char *vtable_var = CFCType_get_vtable_var(type);
-        const char *allocation;
-        if (strcmp(struct_sym, "cfish_String") == 0
-            || strcmp(struct_sym, "cfish_Obj") == 0
-           ) {
-            // Share buffers rather than copy between Perl scalars and
-            // Clownfish string types.
-            allocation = "alloca(cfish_SStr_size())";
-        }
-        else {
-            allocation = "NULL";
-        }
-        const char pattern[] = "(%s*)XSBind_sv_to_cfish_obj(%s, %s, %s)";
-        result = CFCUtil_sprintf(pattern, struct_sym, xs_var, vtable_var,
-                                 allocation);
-    }
-    else if (CFCType_is_primitive(type)) {
-        const char *specifier = CFCType_get_specifier(type);
-
-        if (strcmp(specifier, "double") == 0) {
-            result = CFCUtil_sprintf("SvNV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "float") == 0) {
-            result = CFCUtil_sprintf("(float)SvNV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "int") == 0) {
-            result = CFCUtil_sprintf("(int)SvIV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "short") == 0) {
-            result = CFCUtil_sprintf("(short)SvIV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "long") == 0) {
-            const char pattern[] =
-                "((sizeof(long) <= sizeof(IV)) ? (long)SvIV(%s) "
-                ": (long)SvNV(%s))";
-            result = CFCUtil_sprintf(pattern, xs_var, xs_var);
-        }
-        else if (strcmp(specifier, "size_t") == 0) {
-            result = CFCUtil_sprintf("(size_t)SvIV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "uint64_t") == 0) {
-            result = CFCUtil_sprintf("(uint64_t)SvNV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "uint32_t") == 0) {
-            result = CFCUtil_sprintf("(uint32_t)SvUV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "uint16_t") == 0) {
-            result = CFCUtil_sprintf("(uint16_t)SvUV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "uint8_t") == 0) {
-            result = CFCUtil_sprintf("(uint8_t)SvUV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "int64_t") == 0) {
-            result = CFCUtil_sprintf("(int64_t)SvNV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "int32_t") == 0) {
-            result = CFCUtil_sprintf("(int32_t)SvIV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "int16_t") == 0) {
-            result = CFCUtil_sprintf("(int16_t)SvIV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "int8_t") == 0) {
-            result = CFCUtil_sprintf("(int8_t)SvIV(%s)", xs_var);
-        }
-        else if (strcmp(specifier, "bool") == 0) {
-            result = CFCUtil_sprintf("SvTRUE(%s) ? 1 : 0", xs_var);
-        }
-        else {
-            FREEMEM(result);
-            result = NULL;
-        }
-    }
-
-    return result;
-}
-
-char*
-CFCPerlTypeMap_to_perl(CFCType *type, const char *cf_var) {
-    const char *type_str = CFCType_to_c(type);
-    char *result = NULL;
-
-    if (CFCType_is_object(type)) {
-        const char pattern[] =
-            "(%s == NULL ? newSV(0) : XSBind_cfish_to_perl((cfish_Obj*)%s))";
-        result = CFCUtil_sprintf(pattern, cf_var, cf_var);
-    }
-    else if (CFCType_is_primitive(type)) {
-        // Convert from a primitive type to a Perl scalar.
-        const char *specifier = CFCType_get_specifier(type);
-
-        if (strcmp(specifier, "double") == 0) {
-            result = CFCUtil_sprintf("newSVnv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "float") == 0) {
-            result = CFCUtil_sprintf("newSVnv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "int") == 0) {
-            result = CFCUtil_sprintf("newSViv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "short") == 0) {
-            result = CFCUtil_sprintf("newSViv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "long") == 0) {
-            char pattern[] =
-                "((sizeof(long) <= sizeof(IV)) ? "
-                "newSViv((IV)%s) : newSVnv((NV)%s))";
-            result = CFCUtil_sprintf(pattern, cf_var, cf_var);
-        }
-        else if (strcmp(specifier, "size_t") == 0) {
-            result = CFCUtil_sprintf("newSViv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "uint64_t") == 0) {
-            char pattern[] =
-                "sizeof(UV) == 8 ? "
-                "newSVuv((UV)%s) : newSVnv((NV)CFISH_U64_TO_DOUBLE(%s))";
-            result = CFCUtil_sprintf(pattern, cf_var, cf_var);
-        }
-        else if (strcmp(specifier, "uint32_t") == 0) {
-            result = CFCUtil_sprintf("newSVuv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "uint16_t") == 0) {
-            result = CFCUtil_sprintf("newSVuv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "uint8_t") == 0) {
-            result = CFCUtil_sprintf("newSVuv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "int64_t") == 0) {
-            char pattern[] = "sizeof(IV) == 8 ? newSViv((IV)%s) : newSVnv((NV)%s)";
-            result = CFCUtil_sprintf(pattern, cf_var, cf_var);
-        }
-        else if (strcmp(specifier, "int32_t") == 0) {
-            result = CFCUtil_sprintf("newSViv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "int16_t") == 0) {
-            result = CFCUtil_sprintf("newSViv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "int8_t") == 0) {
-            result = CFCUtil_sprintf("newSViv(%s)", cf_var);
-        }
-        else if (strcmp(specifier, "bool") == 0) {
-            result = CFCUtil_sprintf("newSViv(%s)", cf_var);
-        }
-        else {
-            FREEMEM(result);
-            result = NULL;
-        }
-    }
-    else if (CFCType_is_composite(type)) {
-        if (strcmp(type_str, "void*") == 0) {
-            // Assume that void* is a reference SV -- either a hashref or an
-            // arrayref.
-            result = CFCUtil_sprintf("newRV_inc((SV*)%s)", cf_var);
-        }
-    }
-
-    return result;
-}
-
-static const char typemap_start[] =
-    "# Auto-generated file.\n"
-    "\n"
-    "TYPEMAP\n"
-    "bool\tCFISH_BOOL\n"
-    "int8_t\tCFISH_SIGNED_INT\n"
-    "int16_t\tCFISH_SIGNED_INT\n"
-    "int32_t\tCFISH_SIGNED_INT\n"
-    "int64_t\tCFISH_BIG_SIGNED_INT\n"
-    "uint8_t\tCFISH_UNSIGNED_INT\n"
-    "uint16_t\tCFISH_UNSIGNED_INT\n"
-    "uint32_t\tCFISH_UNSIGNED_INT\n"
-    "uint64_t\tCFISH_BIG_UNSIGNED_INT\n"
-    "\n";
-
-
-static const char typemap_input[] =
-    "INPUT\n"
-    "\n"
-    "CFISH_BOOL\n"
-    "    $var = ($type)SvTRUE($arg);\n"
-    "\n"
-    "CFISH_SIGNED_INT \n"
-    "    $var = ($type)SvIV($arg);\n"
-    "\n"
-    "CFISH_UNSIGNED_INT\n"
-    "    $var = ($type)SvUV($arg);\n"
-    "\n"
-    "CFISH_BIG_SIGNED_INT \n"
-    "    $var = (sizeof(IV) == 8) ? ($type)SvIV($arg) : ($type)SvNV($arg);\n"
-    "\n"
-    "CFISH_BIG_UNSIGNED_INT \n"
-    "    $var = (sizeof(UV) == 8) ? ($type)SvUV($arg) : ($type)SvNV($arg);\n"
-    "\n";
-
-static const char typemap_output[] =
-    "OUTPUT\n"
-    "\n"
-    "CFISH_BOOL\n"
-    "    sv_setiv($arg, (IV)$var);\n"
-    "\n"
-    "CFISH_SIGNED_INT\n"
-    "    sv_setiv($arg, (IV)$var);\n"
-    "\n"
-    "CFISH_UNSIGNED_INT\n"
-    "    sv_setuv($arg, (UV)$var);\n"
-    "\n"
-    "CFISH_BIG_SIGNED_INT\n"
-    "    if (sizeof(IV) == 8) { sv_setiv($arg, (IV)$var); }\n"
-    "    else                 { sv_setnv($arg, (NV)$var); }\n"
-    "\n"
-    "CFISH_BIG_UNSIGNED_INT\n"
-    "    if (sizeof(UV) == 8) { sv_setuv($arg, (UV)$var); }\n"
-    "    else {\n"
-    "        sv_setnv($arg, (NV)CFISH_U64_TO_DOUBLE($var));\n"
-    "    }\n"
-    "\n";
-
-void
-CFCPerlTypeMap_write_xs_typemap(CFCHierarchy *hierarchy) {
-    CFCClass **classes = CFCHierarchy_ordered_classes(hierarchy);
-    char *start  = CFCUtil_strdup("");
-    char *input  = CFCUtil_strdup("");
-    char *output = CFCUtil_strdup("");
-    for (int i = 0; classes[i] != NULL; i++) {
-        CFCClass *klass = classes[i];
-        // TODO: Skip classes from parcels the source parcels don't depend on.
-
-        const char *full_struct_sym = CFCClass_full_struct_sym(klass);
-        const char *vtable_var      = CFCClass_full_vtable_var(klass);
-
-        start = CFCUtil_cat(start, full_struct_sym, "*\t", vtable_var, "_\n",
-                            NULL);
-        const char *allocation;
-        if (strcmp(full_struct_sym, "cfish_String") == 0) {
-            // Share buffers rather than copy between Perl scalars and
-            // Clownfish string types.
-            allocation = "alloca(cfish_SStr_size())";
-        }
-        else {
-            allocation = "NULL";
-        }
-        input = CFCUtil_cat(input, vtable_var, "_\n"
-                            "    $var = (", full_struct_sym,
-                            "*)XSBind_sv_to_cfish_obj($arg, ", vtable_var,
-                            ", ", allocation, ");\n\n", NULL);
-
-        output = CFCUtil_cat(output, vtable_var, "_\n"
-                             "    $arg = (SV*)CFISH_Obj_To_Host((cfish_Obj*)$var);\n"
-                             "    CFISH_DECREF($var);\n"
-                             "\n", NULL);
-    }
-
-    char *content = CFCUtil_strdup("");
-    content = CFCUtil_cat(content, typemap_start, start, "\n\n",
-                          typemap_input, input, "\n\n",
-                          typemap_output, output, "\n\n", NULL);
-    CFCUtil_write_if_changed("typemap", content, strlen(content));
-
-    FREEMEM(content);
-    FREEMEM(output);
-    FREEMEM(input);
-    FREEMEM(start);
-    FREEMEM(classes);
-}
-

http://git-wip-us.apache.org/repos/asf/lucy/blob/1704c275/clownfish/compiler/src/CFCPerlTypeMap.h
----------------------------------------------------------------------
diff --git a/clownfish/compiler/src/CFCPerlTypeMap.h b/clownfish/compiler/src/CFCPerlTypeMap.h
deleted file mode 100644
index eceb86d..0000000
--- a/clownfish/compiler/src/CFCPerlTypeMap.h
+++ /dev/null
@@ -1,76 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements.  See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License.  You may obtain a copy of the License at
- *
- *     http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#ifndef H_CFCPERLTYPEMAP
-#define H_CFCPERLTYPEMAP
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/** Clownfish::CFC::Binding::Perl::TypeMap - Convert between Clownfish and
- * Perl via XS.
- *
- * TypeMap serves up C code fragments for translating between Perl data
- * structures and Clownfish data structures.  The functions to_perl() and
- * from_perl() achieve this for individual types; write_xs_typemap() exports
- * all types using the XS "typemap" format documented in "perlxs".
- */
-
-struct CFCHierarchy;
-struct CFCType;
-
-/** Return an expression which converts from a Perl scalar to a variable of
- * the specified type.
- * 
- * @param type A Clownfish::CFC::Model::Type, which will be used to select the
- * mapping code.
- * @param xs_var The C name of the Perl scalar from which we are extracting
- * a value.
- */
-char*
-CFCPerlTypeMap_from_perl(struct CFCType *type, const char *xs_var);
-
-/** Return an expression converts from a variable of type $type to a Perl
- * scalar.
- * 
- * @param type A Clownfish::CFC::Model::Type, which will be used to select the
- * mapping code.
- * @param cf_var The name of the variable from which we are extracting a
- * value.
- */ 
-char*
-CFCPerlTypeMap_to_perl(struct CFCType *type, const char *cf_var);
-
-/** Auto-generate a "typemap" file that adheres to the conventions documented
- * in "perlxs".
- * 
- * We generate this file on the fly rather than maintain a static copy because
- * we want an entry for each Clownfish type so that we can differentiate
- * between them when checking arguments.  Keeping the entries up-to-date
- * manually as classes come and go would be a pain.
- * 
- * @param hierarchy A Clownfish::CFC::Model::Hierarchy.
- */
-void
-CFCPerlTypeMap_write_xs_typemap(struct CFCHierarchy *hierarchy);
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* H_CFCPERLTYPEMAP */
-


Mime
View raw message