Google Git
Sign in
fuchsia / third_party / swig / 3f3073547804f2e112085429ddfb691beba5a2ba / . / Source / Modules / ocaml.cxx
blob: 9f7504b871c1bdf24f05185249889546b16241e1 [file] [log] [blame]
/* -----------------------------------------------------------------------------
* This file is part of SWIG, which is licensed as a whole under version 3
* (or any later version) of the GNU General Public License. Some additional
* terms also apply to certain portions of SWIG. The full details of the SWIG
* license and copyrights can be found in the LICENSE and COPYRIGHT files
* included with the SWIG source code as distributed by the SWIG developers
* and at http://www.swig.org/legal.html.
*
* ocaml.cxx
*
* Ocaml language module for SWIG.
* ----------------------------------------------------------------------------- */
#include "swigmod.h"
#include <ctype.h>
static const char *usage = "\
Ocaml Options (available with -ocaml)\n\
-oldvarnames - Old intermediary method names for variable wrappers\n\
-prefix <name> - Set a prefix <name> to be prepended to all names\n\
-suffix <name> - Deprecated alias for general option -cppext\n\
-where - Emit library location\n\
\n";
static int classmode = 0;
static int in_constructor = 0, in_destructor = 0, in_copyconst = 0;
static int const_enum = 0;
static int static_member_function = 0;
static int generate_sizeof = 0;
static String *prefix = 0;
static const char *ocaml_path = "ocaml";
static bool old_variable_names = false;
static String *classname = 0;
static String *module = 0;
static String *init_func_def = 0;
static String *f_classtemplate = 0;
static SwigType *name_qualifier_type = 0;
static Hash *seen_enums = 0;
static Hash *seen_enumvalues = 0;
static Hash *seen_constructors = 0;
static File *f_header = 0;
static File *f_begin = 0;
static File *f_runtime = 0;
static File *f_wrappers = 0;
static File *f_directors = 0;
static File *f_directors_h = 0;
static File *f_init = 0;
static File *f_mlout = 0;
static File *f_mliout = 0;
static File *f_mlbody = 0;
static File *f_mlibody = 0;
static File *f_mltail = 0;
static File *f_mlitail = 0;
static File *f_enumtypes_type = 0;
static File *f_enumtypes_value = 0;
static File *f_class_ctors = 0;
static File *f_class_ctors_end = 0;
static File *f_enum_to_int = 0;
static File *f_int_to_enum = 0;
class OCAML:public Language {
public:
OCAML() {
director_prot_ctor_code = NewString("");
Printv(director_prot_ctor_code,
"if ( $comparison ) { /* subclassed */\n",
" $director_new \n", "} else {\n", " caml_failwith(\"accessing abstract class or protected constructor\"); \n", "}\n", NIL);
director_multiple_inheritance = 1;
director_language = 1;
}
String *Swig_class_name(Node *n) {
String *name;
name = Copy(Getattr(n, "sym:name"));
return name;
}
void PrintIncludeArg() {
Printv(stdout, SWIG_LIB, SWIG_FILE_DELIMITER, ocaml_path, "\n", NIL);
}
/* ------------------------------------------------------------
* main()
* ------------------------------------------------------------ */
virtual void main(int argc, char *argv[]) {
int i;
prefix = 0;
SWIG_library_directory(ocaml_path);
// Look for certain command line options
for (i = 1; i < argc; i++) {
if (argv[i]) {
if (strcmp(argv[i], "-help") == 0) {
fputs(usage, stdout);
SWIG_exit(0);
} else if (strcmp(argv[i], "-where") == 0) {
PrintIncludeArg();
SWIG_exit(0);
} else if (strcmp(argv[i], "-prefix") == 0) {
if (argv[i + 1]) {
prefix = NewString(argv[i + 1]);
Swig_mark_arg(i);
Swig_mark_arg(i + 1);
i++;
} else {
Swig_arg_error();
}
} else if (strcmp(argv[i], "-suffix") == 0) {
if (argv[i + 1]) {
Printf(stderr, "swig: warning: -suffix option deprecated. SWIG 3.0.4 and later provide a -cppext option which should be used instead.\n");
SWIG_config_cppext(argv[i + 1]);
Swig_mark_arg(i);
Swig_mark_arg(i + 1);
i++;
} else
Swig_arg_error();
} else if (strcmp(argv[i], "-oldvarnames") == 0) {
Swig_mark_arg(i);
old_variable_names = true;
}
}
}
// If a prefix has been specified make sure it ends in a '_' (not actually used!)
if (prefix) {
const char *px = Char(prefix);
if (px[Len(prefix) - 1] != '_')
Printf(prefix, "_");
} else
prefix = NewString("swig_");
// Add a symbol for this module
Preprocessor_define("SWIGOCAML 1", 0);
// Set name of typemaps
SWIG_typemap_lang("ocaml");
// Read in default typemaps */
SWIG_config_file("ocaml.i");
allow_overloading();
}
/* Swig_director_declaration()
*
* Generate the full director class declaration, complete with base classes.
* e.g. "class SwigDirector_myclass : public myclass, public Swig::Director {"
*
*/
String *Swig_director_declaration(Node *n) {
String *classname = Swig_class_name(n);
String *directorname = NewStringf("SwigDirector_%s", classname);
String *base = Getattr(n, "classtype");
String *declaration = Swig_class_declaration(n, directorname);
Printf(declaration, " : public %s, public Swig::Director {\n", base);
Delete(classname);
Delete(directorname);
return declaration;
}
void emitBanner(File *f) {
Printf(f, "(* ----------------------------------------------------------------------------\n");
Swig_banner_target_lang(f, " *");
Printf(f, " * ---------------------------------------------------------------------------- *)\n\n");
}
/* ------------------------------------------------------------
* top()
*
* Recognize the %module, and capture the module name.
* Create the default enum cases.
* Set up the named outputs:
*
* init
* ml
* mli
* wrapper
* header
* runtime
* directors
* directors_h
* ------------------------------------------------------------ */
virtual int top(Node *n) {
/* Set comparison with none for ConstructorToFunction */
setSubclassInstanceCheck(NewString("caml_list_nth(args,0) != Val_unit"));
/* check if directors are enabled for this module. note: this
* is a "master" switch, without which no director code will be
* emitted. %feature("director") statements are also required
* to enable directors for individual classes or methods.
*
* use %module(directors="1") modulename at the start of the
* interface file to enable director generation.
*/
String *mod_docstring = NULL;
{
Node *module = Getattr(n, "module");
if (module) {
Node *options = Getattr(module, "options");
if (options) {
if (Getattr(options, "directors")) {
allow_directors();
}
if (Getattr(options, "dirprot")) {
allow_dirprot();
}
if (Getattr(options, "sizeof")) {
generate_sizeof = 1;
}
mod_docstring = Getattr(options, "docstring");
}
}
}
/* Initialize all of the output files */
String *outfile = Getattr(n, "outfile");
f_begin = NewFile(outfile, "w", SWIG_output_files());
if (!f_begin) {
FileErrorDisplay(outfile);
SWIG_exit(EXIT_FAILURE);
}
f_runtime = NewString("");
f_init = NewString("");
f_header = NewString("");
f_wrappers = NewString("");
f_directors = NewString("");
f_directors_h = NewString("");
f_enumtypes_type = NewString("");
f_enumtypes_value = NewString("");
init_func_def = NewString("");
f_mlbody = NewString("");
f_mlibody = NewString("");
f_mltail = NewString("");
f_mlitail = NewString("");
f_class_ctors = NewString("");
f_class_ctors_end = NewString("");
f_enum_to_int = NewString("");
f_int_to_enum = NewString("");
f_classtemplate = NewString("");
module = Getattr(n, "name");
seen_constructors = NewHash();
seen_enums = NewHash();
seen_enumvalues = NewHash();
/* Register file targets with the SWIG file handler */
Swig_register_filebyname("init", init_func_def);
Swig_register_filebyname("header", f_header);
Swig_register_filebyname("wrapper", f_wrappers);
Swig_register_filebyname("begin", f_begin);
Swig_register_filebyname("runtime", f_runtime);
Swig_register_filebyname("mli", f_mlibody);
Swig_register_filebyname("ml", f_mlbody);
Swig_register_filebyname("mlitail", f_mlitail);
Swig_register_filebyname("mltail", f_mltail);
Swig_register_filebyname("director", f_directors);
Swig_register_filebyname("director_h", f_directors_h);
Swig_register_filebyname("classtemplate", f_classtemplate);
Swig_register_filebyname("class_ctors", f_class_ctors);
if (old_variable_names) {
Swig_name_register("set", "%n%v__set__");
Swig_name_register("get", "%n%v__get__");
}
Swig_banner(f_begin);
Printf(f_runtime, "\n\n#ifndef SWIGOCAML\n#define SWIGOCAML\n#endif\n\n");
Printf(f_runtime, "#define SWIG_MODULE \"%s\"\n", module);
/* Module name */
Printf(f_mlbody, "let module_name = \"%s\"\n", module);
Printf(f_mlibody, "val module_name : string\n");
Printf(f_enum_to_int,
"let enum_to_int x (v : c_obj) =\n"
" match v with\n"
" C_enum _y ->\n"
" (let y = _y in match (x : c_enum_type) with\n"
" `unknown -> " " (match y with\n" " `Int x -> (Swig.C_int x)\n" " | _ -> raise (LabelNotFromThisEnum v))\n");
Printf(f_int_to_enum, "let int_to_enum x y =\n" " match (x : c_enum_type) with\n" " `unknown -> C_enum (`Int y)\n");
if (directorsEnabled()) {
Printf(f_runtime, "#define SWIG_DIRECTORS\n");
}
Printf(f_runtime, "\n");
/* Produce the enum_to_int and int_to_enum functions */
Printf(f_enumtypes_type, "open Swig\n" "type c_enum_type = [ \n `unknown\n");
Printf(f_enumtypes_value, "type c_enum_value = [ \n `Int of int\n");
String *mlfile = NewString("");
String *mlifile = NewString("");
Printv(mlfile, module, ".ml", NIL);
Printv(mlifile, module, ".mli", NIL);
String *mlfilen = NewStringf("%s%s", SWIG_output_directory(), mlfile);
if ((f_mlout = NewFile(mlfilen, "w", SWIG_output_files())) == 0) {
FileErrorDisplay(mlfilen);
SWIG_exit(EXIT_FAILURE);
}
String *mlifilen = NewStringf("%s%s", SWIG_output_directory(), mlifile);
if ((f_mliout = NewFile(mlifilen, "w", SWIG_output_files())) == 0) {
FileErrorDisplay(mlifilen);
SWIG_exit(EXIT_FAILURE);
}
emitBanner(f_mlout);
emitBanner(f_mliout);
Language::top(n);
if (mod_docstring) {
if (Len(mod_docstring)) {
Printv(f_mliout, "(** ", mod_docstring, " *)\n", NIL);
}
Delete(mod_docstring);
mod_docstring = NULL;
}
Printf(f_enum_to_int, ") | _ -> (C_int (get_int v))\n" "let _ = Callback.register \"%s_enum_to_int\" enum_to_int\n", module);
Printf(f_mlibody, "val enum_to_int : c_enum_type -> c_obj -> Swig.c_obj\n");
Printf(f_int_to_enum, "let _ = Callback.register \"%s_int_to_enum\" int_to_enum\n", module);
Printf(f_mlibody, "val int_to_enum : c_enum_type -> int -> c_obj\n");
Printf(f_init, "#define SWIG_init f_%s_init\n" "%s" "}\n", module, init_func_def);
Printf(f_mlbody, "external f_init : unit -> unit = \"f_%s_init\" ;;\n" "let _ = f_init ()\n", module);
Printf(f_enumtypes_type, "]\n");
Printf(f_enumtypes_value, "]\n\n" "type c_obj = c_enum_value c_obj_t\n");
if (directorsEnabled()) {
// Insert director runtime into the f_runtime file (make it occur before %header section)
Swig_insert_file("director_common.swg", f_runtime);
Swig_insert_file("director.swg", f_runtime);
}
SwigType_emit_type_table(f_runtime, f_wrappers);
/* Close all of the files */
Dump(f_runtime, f_begin);
Dump(f_directors_h, f_header);
Dump(f_header, f_begin);
Dump(f_directors, f_wrappers);
Dump(f_wrappers, f_begin);
Wrapper_pretty_print(f_init, f_begin);
Delete(f_header);
Delete(f_wrappers);
Delete(f_init);
Delete(f_runtime);
Delete(f_begin);
Dump(f_enumtypes_type, f_mlout);
Dump(f_enumtypes_value, f_mlout);
Dump(f_mlbody, f_mlout);
Dump(f_enum_to_int, f_mlout);
Dump(f_int_to_enum, f_mlout);
Delete(f_int_to_enum);
Delete(f_enum_to_int);
Dump(f_class_ctors, f_mlout);
Dump(f_class_ctors_end, f_mlout);
Dump(f_mltail, f_mlout);
Delete(f_mlout);
Dump(f_enumtypes_type, f_mliout);
Dump(f_enumtypes_value, f_mliout);
Dump(f_mlibody, f_mliout);
Dump(f_mlitail, f_mliout);
Delete(f_mliout);
return SWIG_OK;
}
/* Produce an error for the given type */
void throw_unhandled_ocaml_type_error(SwigType *d, const char *types) {
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number, "Unable to handle type %s (%s).\n", SwigType_str(d, 0), types);
}
/* Return true iff T is a pointer type */
int
is_a_pointer(SwigType *t) {
return SwigType_ispointer(SwigType_typedef_resolve_all(t));
}
/*
* Delete one reference from a given type.
*/
void oc_SwigType_del_reference(SwigType *t) {
char *c = Char(t);
if (strncmp(c, "q(", 2) == 0) {
Delete(SwigType_pop(t));
c = Char(t);
}
if (strncmp(c, "r.", 2)) {
printf("Fatal error. SwigType_del_pointer applied to non-pointer.\n");
abort();
}
Replace(t, "r.", "", DOH_REPLACE_ANY | DOH_REPLACE_FIRST);
}
void oc_SwigType_del_array(SwigType *t) {
char *c = Char(t);
if (strncmp(c, "q(", 2) == 0) {
Delete(SwigType_pop(t));
c = Char(t);
}
if (strncmp(c, "a(", 2) == 0) {
Delete(SwigType_pop(t));
}
}
/*
* Return true iff T is a reference type
*/
int
is_a_reference(SwigType *t) {
return SwigType_isreference(SwigType_typedef_resolve_all(t));
}
int
is_an_array(SwigType *t) {
return SwigType_isarray(SwigType_typedef_resolve_all(t));
}
virtual int membervariableHandler(Node *n) {
String *symname = Getattr(n, "sym:name");
Language::membervariableHandler(n);
String *mname = Swig_name_member(NSPACE_TODO, classname, symname);
String *getname = Swig_name_get(NSPACE_TODO, mname);
String *mangled_getname = mangleNameForCaml(getname);
Delete(getname);
if (!GetFlag(n, "feature:immutable")) {
String *setname = Swig_name_set(NSPACE_TODO, mname);
String *mangled_setname = mangleNameForCaml(setname);
Delete(setname);
Printf(f_class_ctors, " \"[%s]\", (fun args -> " "if args = (C_list [ raw_ptr ]) then _%s args else _%s args) ;\n", symname, mangled_getname, mangled_setname);
Delete(mangled_setname);
} else {
Printf(f_class_ctors, " \"[%s]\", (fun args -> " "if args = (C_list [ raw_ptr ]) then _%s args else C_void) ;\n", symname, mangled_getname);
}
Delete(mangled_getname);
Delete(mname);
return SWIG_OK;
}
/* ------------------------------------------------------------
* functionWrapper()
* Create a function declaration and register it with the interpreter.
* ------------------------------------------------------------ */
virtual int functionWrapper(Node *n) {
char *iname = GetChar(n, "sym:name");
SwigType *d = Getattr(n, "type");
String *return_type_normalized = normalizeTemplatedClassName(d);
ParmList *l = Getattr(n, "parms");
int director_method = 0;
Parm *p;
Wrapper *f = NewWrapper();
String *proc_name = NewString("");
String *target = NewString("");
String *arg = NewString("");
String *cleanup = NewString("");
String *outarg = NewString("");
String *build = NewString("");
String *tm;
int i = 0;
int numargs;
int numreq;
int newobj = GetFlag(n, "feature:new");
String *nodeType = Getattr(n, "nodeType");
int destructor = (!Cmp(nodeType, "destructor"));
String *overname = 0;
bool isOverloaded = Getattr(n, "sym:overloaded") ? true : false;
// For overloaded functions, only the dispatch function needs to be exposed in the ml and mli files.
bool expose_func = !isOverloaded || !Getattr(n, "sym:nextSibling");
// Make a wrapper name for this
String *wname = Swig_name_wrapper(iname);
if (isOverloaded) {
overname = Getattr(n, "sym:overname");
} else {
if (!addSymbol(iname, n)) {
DelWrapper(f);
return SWIG_ERROR;
}
}
if (overname) {
Append(wname, overname);
}
/* Do this to disambiguate functions emitted from different modules */
Append(wname, module);
Setattr(n, "wrap:name", wname);
// Build the name for Scheme.
Printv(proc_name, "_", iname, NIL);
String *mangled_name = mangleNameForCaml(proc_name);
if (classmode && in_constructor && expose_func) { // Emit constructor for object
String *mangled_name_nounder = NewString((char *) (Char(mangled_name)) + 1);
Printf(f_class_ctors_end, "let %s clst = _%s clst\n", mangled_name_nounder, mangled_name_nounder);
Printf(f_mlibody, "val %s : c_obj -> c_obj\n", mangled_name_nounder);
Delete(mangled_name_nounder);
} else if (classmode && in_destructor) {
Printf(f_class_ctors, " \"~\", %s ;\n", mangled_name);
} else if (classmode && !in_constructor && !in_destructor && !static_member_function &&
!Getattr(n, "membervariableHandler:sym:name") && expose_func) {
String *opname = Copy(Getattr(n, "memberfunctionHandler:sym:name"));
Replaceall(opname, "operator ", "");
Printf(f_class_ctors, " \"%s\", %s ;\n", opname, mangled_name);
Delete(opname);
}
if (classmode && in_constructor) {
Setattr(seen_constructors, mangled_name, "true");
}
// writing the function wrapper function
Printv(f->def, "SWIGEXT CAML_VALUE ", wname, " (", NIL);
Printv(f->def, "CAML_VALUE args", NIL);
Printv(f->def, ")\n{", NIL);
/* Define the scheme name in C. This define is used by several
macros. */
//Printv(f->def, "#define FUNC_NAME \"", mangled_name, "\"", NIL);
// adds local variables
Wrapper_add_local(f, "args", "CAMLparam1(args)");
Wrapper_add_local(f, "ret", "SWIG_CAMLlocal2(swig_result,rv)");
d = SwigType_typedef_qualified(d);
emit_parameter_variables(l, f);
/* Attach the standard typemaps */
emit_attach_parmmaps(l, f);
Setattr(n, "wrap:parms", l);
numargs = emit_num_arguments(l);
numreq = emit_num_required(l);
if (!isOverloaded) {
if (numargs > 0) {
if (numreq > 0) {
Printf(f->code, "if (caml_list_length(args) < %d || caml_list_length(args) > %d) {\n", numreq, numargs);
} else {
Printf(f->code, "if (caml_list_length(args) > %d) {\n", numargs);
}
Printf(f->code, "caml_invalid_argument(\"Incorrect number of arguments passed to '%s'\");\n}\n", iname);
} else {
Printf(f->code, "if (caml_list_length(args) > 0) caml_invalid_argument(\"'%s' takes no arguments\");\n", iname);
}
}
Printf(f->code, "swig_result = Val_unit;\n");
// Now write code to extract the parameters (this is super ugly)
for (i = 0, p = l; i < numargs; i++) {
/* Skip ignored arguments */
while (checkAttribute(p, "tmap:in:numinputs", "0")) {
p = Getattr(p, "tmap:in:next");
}
SwigType *pt = Getattr(p, "type");
String *ln = Getattr(p, "lname");
pt = SwigType_typedef_qualified(pt);
// Produce names of source and target
Clear(target);
Clear(arg);
String *source = NewStringf("caml_list_nth(args,%d)", i);
Printf(target, "%s", ln);
Printv(arg, Getattr(p, "name"), NIL);
if (i >= numreq) {
Printf(f->code, "if (caml_list_length(args) > %d) {\n", i);
}
// Handle parameter types.
if ((tm = Getattr(p, "tmap:in"))) {
Replaceall(tm, "$source", source);
Replaceall(tm, "$target", target);
Replaceall(tm, "$input", source);
Setattr(p, "emit:input", source);
Printv(f->code, tm, "\n", NIL);
p = Getattr(p, "tmap:in:next");
} else {
// no typemap found
// check if typedef and resolve
throw_unhandled_ocaml_type_error(pt, "in");
p = nextSibling(p);
}
if (i >= numreq) {
Printf(f->code, "}\n");
}
Delete(source);
}
/* Insert constraint checking code */
for (p = l; p;) {
if ((tm = Getattr(p, "tmap:check"))) {
Replaceall(tm, "$target", Getattr(p, "lname"));
Printv(f->code, tm, "\n", NIL);
p = Getattr(p, "tmap:check:next");
} else {
p = nextSibling(p);
}
}
// Pass output arguments back to the caller.
for (p = l; p;) {
if ((tm = Getattr(p, "tmap:argout"))) {
Replaceall(tm, "$source", Getattr(p, "emit:input")); /* Deprecated */
Replaceall(tm, "$target", Getattr(p, "lname")); /* Deprecated */
Replaceall(tm, "$arg", Getattr(p, "emit:input"));
Replaceall(tm, "$input", Getattr(p, "emit:input"));
Replaceall(tm, "$ntype", normalizeTemplatedClassName(Getattr(p, "type")));
Printv(outarg, tm, "\n", NIL);
p = Getattr(p, "tmap:argout:next");
} else {
p = nextSibling(p);
}
}
// Free up any memory allocated for the arguments.
/* Insert cleanup code */
for (p = l; p;) {
if ((tm = Getattr(p, "tmap:freearg"))) {
Replaceall(tm, "$target", Getattr(p, "lname"));
Printv(cleanup, tm, "\n", NIL);
p = Getattr(p, "tmap:freearg:next");
} else {
p = nextSibling(p);
}
}
/* if the object is a director, and the method call originated from its
* underlying ocaml object, resolve the call by going up the c++
* inheritance chain. otherwise try to resolve the method in ocaml.
* without this check an infinite loop is set up between the director and
* shadow class method calls.
*/
// NOTE: this code should only be inserted if this class is the
// base class of a director class. however, in general we haven't
// yet analyzed all classes derived from this one to see if they are
// directors. furthermore, this class may be used as the base of
// a director class defined in a completely different module at a
// later time, so this test must be included whether or not directorbase
// is true. we do skip this code if directors have not been enabled
// at the command line to preserve source-level compatibility with
// non-polymorphic swig. also, if this wrapper is for a smart-pointer
// method, there is no need to perform the test since the calling object
// (the smart-pointer) and the director object (the "pointee") are
// distinct.
director_method = is_member_director(n) && !is_smart_pointer() && !destructor;
if (director_method) {
Wrapper_add_local(f, "director", "Swig::Director *director = 0");
Printf(f->code, "director = dynamic_cast<Swig::Director *>(arg1);\n");
Wrapper_add_local(f, "upcall", "bool upcall = false");
Append(f->code, "upcall = (director);\n");
}
// Now write code to make the function call
Swig_director_emit_dynamic_cast(n, f);
String *actioncode = emit_action(n);
if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) {
Replaceall(tm, "$source", "swig_result");
Replaceall(tm, "$target", "rv");
Replaceall(tm, "$result", "rv");
Replaceall(tm, "$ntype", return_type_normalized);
Printv(f->code, tm, "\n", NIL);
} else {
throw_unhandled_ocaml_type_error(d, "out");
}
emit_return_variable(n, d, f);
// Dump the argument output code
Printv(f->code, Char(outarg), NIL);
// Dump the argument cleanup code
Printv(f->code, Char(cleanup), NIL);
// Look for any remaining cleanup
if (GetFlag(n, "feature:new")) {
if ((tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0))) {
Replaceall(tm, "$source", "swig_result");
Printv(f->code, tm, "\n", NIL);
}
}
/* See if there is any return cleanup code */
if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) {
Replaceall(tm, "$source", Swig_cresult_name());
Printf(f->code, "%s\n", tm);
Delete(tm);
}
// Free any memory allocated by the function being wrapped..
if ((tm = Swig_typemap_lookup("swig_result", n, Swig_cresult_name(), 0))) {
Replaceall(tm, "$source", Swig_cresult_name());
Printv(f->code, tm, "\n", NIL);
}
// Wrap things up (in a manner of speaking)
Printv(f->code, tab4, "swig_result = caml_list_append(swig_result,rv);\n", NIL);
Printv(f->code, tab4, "CAMLreturn(swig_result);\n", NIL);
Printv(f->code, "}\n", NIL);
/* Substitute the function name */
Replaceall(f->code, "$symname", iname);
Wrapper_print(f, f_wrappers);
if (isOverloaded) {
if (!Getattr(n, "sym:nextSibling")) {
int maxargs;
Wrapper *df = NewWrapper();
String *dispatch = Swig_overload_dispatch(n,
"free(argv);\n" "CAMLreturn(%s(args));\n",
&maxargs);
Wrapper_add_local(df, "argv", "CAML_VALUE *argv");
/* Undifferentiate name .. this is the dispatch function */
wname = Swig_name_wrapper(iname);
/* Do this to disambiguate functions emitted from different
* modules */
Append(wname, module);
Printv(df->def,
"SWIGEXT CAML_VALUE ", wname, "(CAML_VALUE args) {\n" " CAMLparam1(args);\n" " int i;\n" " int argc = caml_list_length(args);\n", NIL);
Printv(df->code,
"argv = (CAML_VALUE *)malloc( argc * sizeof( CAML_VALUE ) );\n"
"for( i = 0; i < argc; i++ ) {\n" " argv[i] = caml_list_nth(args,i);\n" "}\n", NIL);
Printv(df->code, dispatch, "\nfree(argv);\n", NIL);
Node *sibl = n;
while (Getattr(sibl, "sym:previousSibling"))
sibl = Getattr(sibl, "sym:previousSibling");
String *protoTypes = NewString("");
do {
String *fulldecl = Swig_name_decl(sibl);
Printf(protoTypes, "\n\" %s\\n\"", fulldecl);
Delete(fulldecl);
} while ((sibl = Getattr(sibl, "sym:nextSibling")));
Printf(df->code, "caml_failwith(\"Wrong number or type of arguments for overloaded function '%s'.\\n\""
"\n\" Possible C/C++ prototypes are:\\n\"%s);\n", iname, protoTypes);
Delete(protoTypes);
Printv(df->code, "}\n", NIL);
Wrapper_print(df, f_wrappers);
DelWrapper(df);
Delete(dispatch);
}
}
if (expose_func) {
Printf(f_mlbody, "external %s_f : c_obj list -> c_obj list = \"%s\" ;;\n", mangled_name, wname);
Printf(f_mlbody, "let %s arg = match %s_f (%s(fnhelper arg)) with\n", mangled_name, mangled_name,
in_constructor && Swig_directorclass(getCurrentClass()) ? "director_core_helper " : "");
Printf(f_mlbody, " [] -> C_void\n"
"| [x] -> (if %s then Gc.finalise \n"
" (fun x -> ignore ((invoke x) \"~\" C_void)) x) ; x\n"
"| lst -> C_list lst ;;\n", newobj ? "true" : "false");
}
if ((!classmode || in_constructor || in_destructor || static_member_function) && expose_func)
Printf(f_mlibody, "val %s : c_obj -> c_obj\n", mangled_name);
Delete(proc_name);
Delete(target);
Delete(arg);
Delete(outarg);
Delete(cleanup);
Delete(build);
DelWrapper(f);
return SWIG_OK;
}
/* ------------------------------------------------------------
* variableWrapper()
*
* Create a link to a C variable.
* This creates a single function _wrap_varname().
* This function takes a single optional argument. If supplied, it means
* we are setting this variable to some value. If omitted, it means we are
* simply evaluating this variable. We return the value of the variable
* in both cases.
*
* symname is the name of the variable with respect to C. This
* may need to differ from the original name in the case of enums.
* enumvname is the name of the variable with respect to ocaml. This
* will vary if the variable has been renamed.
* ------------------------------------------------------------ */
virtual int variableWrapper(Node *n) {
char *name = GetChar(n, "feature:symname");
String *iname = Getattr(n, "feature:enumvname");
String *mname = mangleNameForCaml(iname);
SwigType *t = Getattr(n, "type");
String *proc_name = NewString("");
String *tm;
Wrapper *f;
if (!name) {
name = GetChar(n, "name");
}
if (!iname) {
iname = Getattr(n, "sym:name");
mname = mangleNameForCaml(NewString(iname));
}
if (!iname || !addSymbol(iname, n))
return SWIG_ERROR;
f = NewWrapper();
// evaluation function names
String *var_name = Swig_name_wrapper(iname);
// Build the name for OCaml.
Printv(proc_name, iname, NIL);
Setattr(n, "wrap:name", proc_name);
Printf(f->def, "SWIGEXT CAML_VALUE %s(CAML_VALUE args) {\n", var_name);
// Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
Wrapper_add_local(f, "args", "CAMLparam1(args)");
Wrapper_add_local(f, "swig_result", "SWIG_CAMLlocal1(swig_result)");
Printf(f->code, "swig_result = Val_unit;\n");
if (!GetFlag(n, "feature:immutable")) {
/* Check for a setting of the variable value */
Printf(f->code, "if (args != Val_int(0)) {\n");
if ((tm = Swig_typemap_lookup("varin", n, name, 0))) {
Replaceall(tm, "$source", "args");
Replaceall(tm, "$target", name);
Replaceall(tm, "$input", "args");
emit_action_code(n, f->code, tm);
} else if ((tm = Swig_typemap_lookup("in", n, name, 0))) {
Replaceall(tm, "$source", "args");
Replaceall(tm, "$target", name);
Replaceall(tm, "$input", "args");
emit_action_code(n, f->code, tm);
} else {
throw_unhandled_ocaml_type_error(t, "varin/in");
}
Printf(f->code, "}\n");
}
// Now return the value of the variable (regardless
// of evaluating or setting)
if ((tm = Swig_typemap_lookup("varout", n, name, 0))) {
Replaceall(tm, "$source", name);
Replaceall(tm, "$target", "swig_result");
Replaceall(tm, "$result", "swig_result");
emit_action_code(n, f->code, tm);
} else if ((tm = Swig_typemap_lookup("out", n, name, 0))) {
Replaceall(tm, "$source", name);
Replaceall(tm, "$target", "swig_result");
Replaceall(tm, "$result", "swig_result");
emit_action_code(n, f->code, tm);
} else {
throw_unhandled_ocaml_type_error(t, "varout/out");
}
Printf(f->code, "\nCAMLreturn(swig_result);\n");
Printf(f->code, "}\n");
Wrapper_print(f, f_wrappers);
// Now add symbol to the Ocaml interpreter
if (GetFlag(n, "feature:immutable")) {
Printf(f_mlbody, "external _%s : c_obj -> Swig.c_obj = \"%s\" \n", mname, var_name);
Printf(f_mlibody, "val _%s : c_obj -> Swig.c_obj\n", iname);
if (const_enum) {
Printf(f_enum_to_int, " | `%s -> _%s C_void\n", mname, mname);
Printf(f_int_to_enum, " if y = (get_int (_%s C_void)) then `%s else\n", mname, mname);
}
} else {
Printf(f_mlbody, "external _%s : c_obj -> c_obj = \"%s\"\n", mname, var_name);
Printf(f_mlibody, "external _%s : c_obj -> c_obj = \"%s\"\n", mname, var_name);
}
Delete(var_name);
Delete(proc_name);
DelWrapper(f);
return SWIG_OK;
}
/* ------------------------------------------------------------
* staticmemberfunctionHandler --
* Overridden to set static_member_function
* ------------------------------------------------------------ */
virtual int staticmemberfunctionHandler(Node *n) {
static_member_function = 1;
Language::staticmemberfunctionHandler(n);
static_member_function = 0;
return SWIG_OK;
}
/* ------------------------------------------------------------
* constantWrapper()
*
* The one trick here is that we have to make sure we rename the
* constant to something useful that doesn't collide with the
* original if any exists.
* ------------------------------------------------------------ */
virtual int constantWrapper(Node *n) {
String *name = Getattr(n, "feature:symname");
SwigType *type = Getattr(n, "type");
String *rawval = Getattr(n, "rawval");
String *value = rawval ? rawval : Getattr(n, "value");
SwigType *qname = Getattr(n, "qualified:name");
if (qname)
value = qname;
if (!name) {
name = mangleNameForCaml(Getattr(n, "name"));
Insert(name, 0, "_swig_wrap_");
Setattr(n, "feature:symname", name);
}
// See if there's a typemap
// Create variable and assign it a value
Printf(f_header, "static %s = %s;\n", SwigType_str(type, name), value);
SetFlag(n, "feature:immutable");
variableWrapper(n);
return SWIG_OK;
}
int constructorHandler(Node *n) {
int ret;
in_constructor = 1;
ret = Language::constructorHandler(n);
in_constructor = 0;
return ret;
}
/* destructorHandler:
* Turn on destructor flag to inform decisions in functionWrapper
*/
int destructorHandler(Node *n) {
int ret;
in_destructor = 1;
ret = Language::destructorHandler(n);
in_destructor = 0;
return ret;
}
/* copyconstructorHandler:
* Turn on constructor and copyconstructor flags for functionWrapper
*/
int copyconstructorHandler(Node *n) {
int ret;
in_copyconst = 1;
in_constructor = 1;
ret = Language::copyconstructorHandler(n);
in_constructor = 0;
in_copyconst = 0;
return ret;
}
/**
* A simple, somewhat general purpose function for writing to multiple
* streams from a source template. This allows the user to define the
* class definition in ways different from the one I have here if they
* want to. It will also make the class definition system easier to
* fiddle with when I want to change methods, etc.
*/
void Multiwrite(String *s) {
char *find_marker = strstr(Char(s), "(*Stream:");
while (find_marker) {
char *next = strstr(find_marker, "*)");
find_marker += strlen("(*Stream:");
if (next) {
int num_chars = (int)(next - find_marker);
String *stream_name = NewString(find_marker);
Delslice(stream_name, num_chars, Len(stream_name));
File *fout = Swig_filebyname(stream_name);
if (fout) {
next += strlen("*)");
char *following = strstr(next, "(*Stream:");
find_marker = following;
if (!following)
following = next + strlen(next);
String *chunk = NewString(next);
Delslice(chunk, (int)(following - next), Len(chunk));
Printv(fout, chunk, NIL);
}
}
}
}
bool isSimpleType(String *name) {
char *ch = Char(name);
return !(strchr(ch, '(') || strchr(ch, '<') || strchr(ch, ')') || strchr(ch, '>'));
}
/* We accept all chars in identifiers because we use strings to index
* them. */
int validIdentifier(String *name) {
return Len(name) > 0 ? 1 : 0;
}
/* classHandler
*
* Create a "class" definition for ocaml. I thought quite a bit about
* how I should do this part of it, and arrived here, using a function
* invocation to select a method, and dispatch. This can obviously be
* done better, but I can't see how, given that I want to support
* overloaded methods, out parameters, and operators.
*
* I needed a system that would do this:
*
* a Be able to call these methods:
* int foo( int x );
* float foo( int x, int &out );
*
* b Be typeable, even in the presence of mutually dependent classes.
*
* c Support some form of operator invocation.
*
* (c) I chose strings for the method names so that "+=" would be a
* valid method name, and the somewhat natural << (invoke x) "+=" y >>
* would work.
*
* (a) (b) Since the c_obj type exists, it's easy to return C_int in one
* case and C_list [ C_float ; C_int ] in the other. This makes tricky
* problems with out parameters disappear; they're simply appended to the
* return list.
*
* (b) Since every item that comes from C++ is the same type, there is no
* problem with the following:
*
* class Foo;
* class Bar { Foo *toFoo(); }
* class Foo { Bar *toBar(); }
*
* Since the Objective caml types of Foo and Bar are the same. Now that
* I correctly incorporate SWIG's typechecking, this isn't a big deal.
*
* The class is in the form of a function returning a c_obj. The c_obj
* is a C_obj containing a function which invokes a method on the
* underlying object given its type.
*
* The name emitted here is normalized before being sent to
* Callback.register, because we need this string to look up properly
* when the typemap passes the descriptor string. I've been considering
* some, possibly more forgiving method that would do some transformations
* on the $descriptor in order to find a potential match. This is for
* later.
*
* Important things to note:
*
* We rely on exception handling (BadMethodName) in order to call an
* ancestor. This can be improved.
*
* The method used to get :classof could be improved to look at the type
* info that the base pointer contains. It's really an error to have a
* SWIG-generated object that does not contain type info, since the
* existence of the object means that SWIG knows the type.
*
* :parents could use :classof to tell what class it is and make a better
* decision. This could be nice, (i.e. provide a run-time graph of C++
* classes represented);.
*
* I can't think of a more elegant way of converting a C_obj fun to a
* pointer than "operator &"...
*
* Added a 'sizeof' that will allow you to do the expected thing.
* This should help users to fill buffer structs and the like (as is
* typical in windows-styled code). It's only enabled if you give
* %feature(sizeof) and then, only for simple types.
*
* Overall, carrying the list of methods and base classes has worked well.
* It allows me to give the Ocaml user introspection over their objects.
*/
int classHandler(Node *n) {
String *name = Getattr(n, "name");
classname = Getattr(n, "sym:name");
if (!name)
return SWIG_OK;
String *mangled_name = mangleNameForCaml(name);
String *this_class_def = NewString(f_classtemplate);
String *name_normalized = normalizeTemplatedClassName(name);
String *old_class_ctors = f_class_ctors;
String *base_classes = NewString("");
f_class_ctors = NewString("");
bool sizeof_feature = generate_sizeof && isSimpleType(name);
classmode = true;
int rv = Language::classHandler(n);
classmode = false;
if (sizeof_feature) {
Printf(f_wrappers,
"SWIGEXT CAML_VALUE _wrap_%s_sizeof( CAML_VALUE args ) {\n"
" CAMLparam1(args);\n" " CAMLreturn(Val_int(sizeof(%s)));\n" "}\n", mangled_name, name_normalized);
Printf(f_mlbody, "external __%s_sizeof : unit -> int = " "\"_wrap_%s_sizeof\"\n", mangled_name, mangled_name);
}
/* Insert sizeof operator for concrete classes */
if (sizeof_feature) {
Printv(f_class_ctors, "\"sizeof\" , (fun args -> C_int (__", mangled_name, "_sizeof ())) ;\n", NIL);
}
/* Handle up-casts in a nice way */
List *baselist = Getattr(n, "bases");
if (baselist && Len(baselist)) {
Iterator b;
b = First(baselist);
while (b.item) {
String *bname = Getattr(b.item, "name");
if (bname) {
String *base_create = NewString("");
Printv(base_create, "(create_class \"", bname, "\")", NIL);
Printv(f_class_ctors, " \"::", bname, "\", (fun args -> ", base_create, " args) ;\n", NIL);
Printv(base_classes, base_create, " ;\n", NIL);
}
b = Next(b);
}
}
Replaceall(this_class_def, "$classname", mangled_name);
Replaceall(this_class_def, "$normalized", name_normalized);
Replaceall(this_class_def, "$realname", name);
Replaceall(this_class_def, "$baselist", base_classes);
Replaceall(this_class_def, "$classbody", f_class_ctors);
Delete(f_class_ctors);
f_class_ctors = old_class_ctors;
// Actually write out the class definition
Multiwrite(this_class_def);
Setattr(n, "ocaml:ctor", mangled_name);
return rv;
}
String *normalizeTemplatedClassName(String *name) {
String *name_normalized = SwigType_typedef_resolve_all(name);
bool took_action;
do {
took_action = false;
if (is_a_pointer(name_normalized)) {
SwigType_del_pointer(name_normalized);
took_action = true;
}
if (is_a_reference(name_normalized)) {
oc_SwigType_del_reference(name_normalized);
took_action = true;
}
if (is_an_array(name_normalized)) {
oc_SwigType_del_array(name_normalized);
took_action = true;
}
} while (took_action);
return SwigType_str(name_normalized, 0);
}
/*
* Produce the symbol name that ocaml will use when referring to the
* target item. I wonder if there's a better way to do this:
*
* I shudder to think about doing it with a hash lookup, but that would
* make a couple of things easier:
*/
String *mangleNameForCaml(String *s) {
String *out = Copy(s);
Replaceall(out, " ", "_xx");
Replaceall(out, "::", "_xx");
Replaceall(out, ",", "_x");
Replaceall(out, "+", "_xx_plus");
Replaceall(out, "-", "_xx_minus");
Replaceall(out, "<", "_xx_ldbrace");
Replaceall(out, ">", "_xx_rdbrace");
Replaceall(out, "!", "_xx_not");
Replaceall(out, "%", "_xx_mod");
Replaceall(out, "^", "_xx_xor");
Replaceall(out, "*", "_xx_star");
Replaceall(out, "&", "_xx_amp");
Replaceall(out, "|", "_xx_or");
Replaceall(out, "(", "_xx_lparen");
Replaceall(out, ")", "_xx_rparen");
Replaceall(out, "[", "_xx_lbrace");
Replaceall(out, "]", "_xx_rbrace");
Replaceall(out, "~", "_xx_bnot");
Replaceall(out, "=", "_xx_equals");
Replaceall(out, "/", "_xx_slash");
Replaceall(out, ".", "_xx_dot");
return out;
}
SwigType *fully_qualified_enum_type(Node *n) {
Node *parent = 0;
String *fully_qualified_name = NewString("");
String *parent_type = 0;
parent = parentNode(n);
while (parent) {
parent_type = nodeType(parent);
if (Getattr(parent, "name")) {
String *parent_copy = NewStringf("%s::", Getattr(parent, "name"));
if (Cmp(parent_type, "class") == 0 || Cmp(parent_type, "namespace") == 0)
Insert(fully_qualified_name, 0, parent_copy);
Delete(parent_copy);
}
if (!Cmp(parent_type, "class"))
break;
parent = parentNode(parent);
}
return fully_qualified_name;
}
/* Benedikt Grundmann inspired --> Enum wrap styles */
int enumvalueDeclaration(Node *n) {
String *name = Getattr(n, "name");
SwigType *qtype = 0;
if (name_qualifier_type) {
qtype = Copy(name_qualifier_type);
Printv(qtype, name, NIL);
}
if (const_enum && qtype && name && !Getattr(seen_enumvalues, name)) {
Setattr(seen_enumvalues, name, "true");
SetFlag(n, "feature:immutable");
Setattr(n, "feature:enumvalue", "1"); // this does not appear to be used
Setattr(n, "qualified:name", SwigType_namestr(qtype));
String *evname = SwigType_manglestr(qtype);
Insert(evname, 0, "SWIG_ENUM_");
Setattr(n, "feature:enumvname", name);
Setattr(n, "feature:symname", evname);
Delete(evname);
Printf(f_enumtypes_value, "| `%s\n", name);
return Language::enumvalueDeclaration(n);
} else
return SWIG_OK;
}
/* -------------------------------------------------------------------
* This function is a bit uglier than it deserves.
*
* I used to direct lookup the name of the enum. Now that certain fixes
* have been made in other places, the names of enums are now fully
* qualified, which is a good thing, overall, but requires me to do
* some legwork.
*
* The other thing that uglifies this function is the varying way that
* typedef enum and enum are handled. I need to produce consistent names,
* which means looking up and registering by typedef and enum name. */
int enumDeclaration(Node *n) {
if (getCurrentClass() && (cplus_mode != PUBLIC))
return SWIG_NOWRAP;
String *name = Getattr(n, "name");
if (name) {
String *oname = NewString(name);
/* name is now fully qualified */
String *fully_qualified_name = NewString(name);
bool seen_enum = false;
if (name_qualifier_type)
Delete(name_qualifier_type);
char *strip_position;
name_qualifier_type = fully_qualified_enum_type(n);
strip_position = strstr(Char(oname), "::");
while (strip_position) {
strip_position += 2;
oname = NewString(strip_position);
strip_position = strstr(Char(oname), "::");
}
seen_enum = (Getattr(seen_enums, fully_qualified_name) ? true : false);
if (!seen_enum) {
const_enum = true;
Printf(f_enum_to_int, "| `%s -> (match y with\n", oname);
Printf(f_int_to_enum, "| `%s -> C_enum (\n", oname);
/* * * * A note about enum name resolution * * * *
* This code should now work, but I think we can do a bit better.
* The problem I'm having is that swig isn't very precise about
* typedef name resolution. My opinion is that SwigType_typedef
* resolve_all should *always* return the enum tag if one exists,
* rather than the admittedly friendlier enclosing typedef.
*
* This would make one of the cases below unnecessary.
* * * */
Printf(f_mlbody, "let _ = Callback.register \"%s_marker\" (`%s)\n", fully_qualified_name, oname);
if (!strncmp(Char(fully_qualified_name), "enum ", 5)) {
String *fq_noenum = NewString(Char(fully_qualified_name) + 5);
Printf(f_mlbody,
"let _ = Callback.register \"%s_marker\" (`%s)\n" "let _ = Callback.register \"%s_marker\" (`%s)\n", fq_noenum, oname, fq_noenum, name);
}
Printf(f_enumtypes_type, "| `%s\n", oname);
Insert(fully_qualified_name, 0, "enum ");
Setattr(seen_enums, fully_qualified_name, n);
}
}
int ret = Language::enumDeclaration(n);
if (const_enum) {
Printf(f_int_to_enum, "`Int y)\n");
Printf(f_enum_to_int, "| `Int x -> Swig.C_int x\n" "| _ -> raise (LabelNotFromThisEnum v))\n");
}
const_enum = false;
return ret;
}
/* ----------------------------------------------------------------------------
* BEGIN C++ Director Class modifications
* ------------------------------------------------------------------------- */
/*
* Modified polymorphism code for Ocaml language module.
*
* TODO
*
* Move some boilerplate code generation to Swig_...() functions.
*
*/
/* ---------------------------------------------------------------
* classDirectorMethod()
*
* Emit a virtual director method to pass a method call on to the
* underlying Python object.
*
* --------------------------------------------------------------- */
int classDirectorMethod(Node *n, Node *parent, String *super) {
int is_void = 0;
int is_pointer = 0;
String *storage = Getattr(n, "storage");
String *value = Getattr(n, "value");
String *decl = Getattr(n, "decl");
String *returntype = Getattr(n, "type");
String *name = Getattr(n, "name");
String *classname = Getattr(parent, "sym:name");
String *c_classname = Getattr(parent, "name");
String *symname = Getattr(n, "sym:name");
String *declaration = NewString("");
ParmList *l = Getattr(n, "parms");
Wrapper *w = NewWrapper();
String *tm;
String *wrap_args = NewString("");
int status = SWIG_OK;
int idx;
bool pure_virtual = false;
bool ignored_method = GetFlag(n, "feature:ignore") ? true : false;
if (Cmp(storage, "virtual") == 0) {
if (Cmp(value, "0") == 0) {
pure_virtual = true;
}
}
Printf(w->locals, "CAMLparam0();\n");
/* determine if the method returns a pointer */
is_pointer = SwigType_ispointer_return(decl);
is_void = (!Cmp(returntype, "void") && !is_pointer);
/* virtual method definition */
String *target;
String *pclassname = NewStringf("SwigDirector_%s", classname);
String *qualified_name = NewStringf("%s::%s", pclassname, name);
SwigType *rtype = Getattr(n, "conversion_operator") ? 0 : Getattr(n, "classDirectorMethods:type");
target = Swig_method_decl(rtype, decl, qualified_name, l, 0);
Printf(w->def, "%s", target);
Delete(qualified_name);
Delete(target);
/* header declaration */
target = Swig_method_decl(rtype, decl, name, l, 1);
Printf(declaration, " virtual %s", target);
Delete(target);
// Get any exception classes in the throws typemap
if (Getattr(n, "noexcept")) {
Append(w->def, " noexcept");
Append(declaration, " noexcept");
}
ParmList *throw_parm_list = 0;
if ((throw_parm_list = Getattr(n, "throws")) || Getattr(n, "throw")) {
Parm *p;
int gencomma = 0;
Append(w->def, " throw(");
Append(declaration, " throw(");
if (throw_parm_list)
Swig_typemap_attach_parms("throws", throw_parm_list, 0);
for (p = throw_parm_list; p; p = nextSibling(p)) {
if (Getattr(p, "tmap:throws")) {
if (gencomma++) {
Append(w->def, ", ");
Append(declaration, ", ");
}
String *str = SwigType_str(Getattr(p, "type"), 0);
Append(w->def, str);
Append(declaration, str);
Delete(str);
}
}
Append(w->def, ")");
Append(declaration, ")");
}
Append(w->def, " {");
Append(declaration, ";\n");
/* declare method return value
* if the return value is a reference or const reference, a specialized typemap must
* handle it, including declaration of c_result ($result).
*/
if (!is_void && (!ignored_method || pure_virtual)) {
if (!SwigType_isclass(returntype)) {
if (!(SwigType_ispointer(returntype) || SwigType_isreference(returntype))) {
String *construct_result = NewStringf("= SwigValueInit< %s >()", SwigType_lstr(returntype, 0));
Wrapper_add_localv(w, "c_result", SwigType_lstr(returntype, "c_result"), construct_result, NIL);
Delete(construct_result);
} else {
Wrapper_add_localv(w, "c_result", SwigType_lstr(returntype, "c_result"), "= 0", NIL);
}
} else {
String *cres = SwigType_lstr(returntype, "c_result");
Printf(w->code, "%s;\n", cres);
Delete(cres);
}
}
if (ignored_method) {
if (!pure_virtual) {
String *super_call = Swig_method_call(super, l);
if (is_void)
Printf(w->code, "%s;\n", super_call);
else
Printf(w->code, "CAMLreturn_type(%s);\n", super_call);
Delete(super_call);
} else {
Printf(w->code, "Swig::DirectorPureVirtualException::raise(\"Attempted to invoke pure virtual method %s::%s\");\n", SwigType_namestr(c_classname),
SwigType_namestr(name));
}
} else {
Wrapper_add_local(w, "swig_result", "SWIG_CAMLlocal2(swig_result, args)");
/* attach typemaps to arguments (C/C++ -> Ocaml) */
String *arglist = NewString("");
Swig_director_parms_fixup(l);
Swig_typemap_attach_parms("in", l, 0);
Swig_typemap_attach_parms("directorin", l, w);
Swig_typemap_attach_parms("directorargout", l, w);
Parm *p;
int num_arguments = emit_num_arguments(l);
int i;
char source[256];
int outputs = 0;
if (!is_void)
outputs++;
/* build argument list and type conversion string */
for (i = 0, idx = 0, p = l; i < num_arguments; i++) {
while (Getattr(p, "tmap:ignore")) {
p = Getattr(p, "tmap:ignore:next");
}
if (Getattr(p, "tmap:directorargout") != 0)
outputs++;
String *pname = Getattr(p, "name");
String *ptype = Getattr(p, "type");
Putc(',', arglist);
if ((tm = Getattr(p, "tmap:directorin")) != 0) {
Setattr(p, "emit:directorinput", pname);
Replaceall(tm, "$input", pname);
Replaceall(tm, "$owner", "0");
if (Len(tm) == 0)
Append(tm, pname);
Printv(wrap_args, tm, "\n", NIL);
p = Getattr(p, "tmap:directorin:next");
continue;
} else if (Cmp(ptype, "void")) {
/* special handling for pointers to other C++ director classes.
* ideally this would be left to a typemap, but there is currently no
* way to selectively apply the dynamic_cast<> to classes that have
* directors. in other words, the type "SwigDirector_$1_lname" only exists
* for classes with directors. we avoid the problem here by checking
* module.wrap::directormap, but it's not clear how to get a typemap to
* do something similar. perhaps a new default typemap (in addition
* to SWIGTYPE) called DIRECTORTYPE?
*/
if (SwigType_ispointer(ptype) || SwigType_isreference(ptype)) {
Node *module = Getattr(parent, "module");
Node *target = Swig_directormap(module, ptype);
sprintf(source, "obj%d", idx++);
String *nonconst = 0;
/* strip pointer/reference --- should move to Swig/stype.c */
String *nptype = NewString(Char(ptype) + 2);
/* name as pointer */
String *ppname = Copy(pname);
if (SwigType_isreference(ptype)) {
Insert(ppname, 0, "&");
}
/* if necessary, cast away const since Python doesn't support it! */
if (SwigType_isconst(nptype)) {
nonconst = NewStringf("nc_tmp_%s", pname);
String *nonconst_i = NewStringf("= const_cast< %s >(%s)", SwigType_lstr(ptype, 0), ppname);
Wrapper_add_localv(w, nonconst, SwigType_lstr(ptype, 0), nonconst, nonconst_i, NIL);
Delete(nonconst_i);
Swig_warning(WARN_LANG_DISCARD_CONST, input_file, line_number,
"Target language argument '%s' discards const in director method %s::%s.\n", SwigType_str(ptype, pname),
SwigType_namestr(c_classname), SwigType_namestr(name));
} else {
nonconst = Copy(ppname);
}
Delete(nptype);
Delete(ppname);
String *mangle = SwigType_manglestr(ptype);
if (target) {
String *director = NewStringf("director_%s", mangle);
Wrapper_add_localv(w, director, "Swig::Director *", director, "= 0", NIL);
Wrapper_add_localv(w, source, "CAML_VALUE", source, "= Val_unit", NIL);
Printf(wrap_args, "%s = dynamic_cast<Swig::Director *>(%s);\n", director, nonconst);
Printf(wrap_args, "if (!%s) {\n", director);
Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE%s, 0);\n", source, nonconst, mangle);
Printf(wrap_args, "} else {\n");
Printf(wrap_args, "%s = %s->swig_get_self();\n", source, director);
Printf(wrap_args, "}\n");
Delete(director);
Printv(arglist, source, NIL);
} else {
Wrapper_add_localv(w, source, "CAML_VALUE", source, "= Val_unit", NIL);
Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE%s, 0);\n", source, nonconst, mangle);
//Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE_p_%s, 0);\n",
// source, nonconst, base);
Printv(arglist, source, NIL);
}
Delete(mangle);
Delete(nonconst);
} else {
Swig_warning(WARN_TYPEMAP_DIRECTORIN_UNDEF, input_file, line_number,
"Unable to use type %s as a function argument in director method %s::%s (skipping method).\n", SwigType_str(ptype, 0),
SwigType_namestr(c_classname), SwigType_namestr(name));
status = SWIG_NOWRAP;
break;
}
}
p = nextSibling(p);
}
Printv(w->code, "swig_result = Val_unit;\n", 0);
Printf(w->code, "args = Val_unit;\n");
/* wrap complex arguments to values */
Printv(w->code, wrap_args, NIL);
/* pass the method call on to the OCaml object */
Printv(w->code,
"swig_result = caml_swig_alloc(1,C_list);\n" "SWIG_Store_field(swig_result,0,args);\n" "args = swig_result;\n" "swig_result = Val_unit;\n", 0);
Printf(w->code, "static const CAML_VALUE *swig_ocaml_func_val = NULL;\n" "if (!swig_ocaml_func_val) {\n");
Printf(w->code, " swig_ocaml_func_val = caml_named_value(\"swig_runmethod\");\n }\n");
Printf(w->code, "swig_result = caml_callback3(*swig_ocaml_func_val,swig_get_self(),caml_copy_string(\"%s\"),args);\n", Getattr(n, "name"));
/* exception handling */
tm = Swig_typemap_lookup("director:except", n, Swig_cresult_name(), 0);
if (!tm) {
tm = Getattr(n, "feature:director:except");
}
if ((tm) && Len(tm) && (Strcmp(tm, "1") != 0)) {
Printf(w->code, "if (!%s) {\n", Swig_cresult_name());
Printf(w->code, " CAML_VALUE error = *caml_named_value(\"director_except\");\n");
Replaceall(tm, "$error", "error");
Printv(w->code, Str(tm), "\n", NIL);
Printf(w->code, "}\n");
}
/*
* Python method may return a simple object, or a tuple.
* for in/out arguments, we have to extract the appropriate values from the
* argument list, then marshal everything back to C/C++ (return value and
* output arguments).
*/
/* marshal return value and other outputs (if any) from value to C/C++
* type */
String *cleanup = NewString("");
String *outarg = NewString("");
tm = Swig_typemap_lookup("directorout", n, "c_result", w);
if (tm != 0) {
Replaceall(tm, "$input", "swig_result");
/* TODO check this */
if (Getattr(n, "wrap:disown")) {
Replaceall(tm, "$disown", "SWIG_POINTER_DISOWN");
} else {
Replaceall(tm, "$disown", "0");
}
Replaceall(tm, "$result", "c_result");
Printv(w->code, tm, "\n", NIL);
}
/* marshal outputs */
for (p = l; p;) {
if ((tm = Getattr(p, "tmap:directorargout")) != 0) {
Replaceall(tm, "$result", "swig_result");
Replaceall(tm, "$input", Getattr(p, "emit:directorinput"));
Printv(w->code, tm, "\n", NIL);
p = Getattr(p, "tmap:directorargout:next");
} else {
p = nextSibling(p);
}
}
Delete(arglist);
Delete(cleanup);
Delete(outarg);
}
/* any existing helper functions to handle this? */
if (!is_void) {
if (!(ignored_method && !pure_virtual)) {
/* A little explanation:
* The director_enum test case makes a method whose return type
* is an enum type. returntype here is "int". gcc complains
* about an implicit enum conversion, and although i don't strictly
* agree with it, I'm working on fixing the error:
*
* Below is what I came up with. It's not great but it should
* always essentially work.
*/
if (!SwigType_isreference(returntype)) {
Printf(w->code, "CAMLreturn_type((%s)c_result);\n", SwigType_lstr(returntype, ""));
} else {
Printf(w->code, "CAMLreturn_type(*c_result);\n");
}
}
} else {
Printf(w->code, "CAMLreturn0;\n");
}
Printf(w->code, "}\n");
// We expose protected methods via an extra public inline method which makes a straight call to the wrapped class' method
String *inline_extra_method = NewString("");
if (dirprot_mode() && !is_public(n) && !pure_virtual) {
Printv(inline_extra_method, declaration, NIL);
String *extra_method_name = NewStringf("%sSwigPublic", name);
Replaceall(inline_extra_method, name, extra_method_name);
Replaceall(inline_extra_method, ";\n", " {\n ");
if (!is_void)
Printf(inline_extra_method, "return ");
String *methodcall = Swig_method_call(super, l);
Printv(inline_extra_method, methodcall, ";\n }\n", NIL);
Delete(methodcall);
Delete(extra_method_name);
}
/* emit the director method */
if (status == SWIG_OK) {
if (!Getattr(n, "defaultargs")) {
Replaceall(w->code, "$symname", symname);
Wrapper_print(w, f_directors);
Printv(f_directors_h, declaration, NIL);
Printv(f_directors_h, inline_extra_method, NIL);
}
}
/* clean up */
Delete(wrap_args);
Delete(pclassname);
DelWrapper(w);
return status;
}
/* ------------------------------------------------------------
* classDirectorConstructor()
* ------------------------------------------------------------ */
int classDirectorConstructor(Node *n) {
Node *parent = Getattr(n, "parentNode");
String *sub = NewString("");
String *decl = Getattr(n, "decl");
String *supername = Swig_class_name(parent);
String *classname = NewString("");
Printf(classname, "SwigDirector_%s", supername);
/* insert self parameter */
Parm *p, *q;
ParmList *superparms = Getattr(n, "parms");
ParmList *parms = CopyParmList(superparms);
String *type = NewString("CAML_VALUE");
p = NewParm(type, NewString("self"), n);
q = Copy(p);
set_nextSibling(q, superparms);
set_nextSibling(p, parms);
parms = p;
if (!Getattr(n, "defaultargs")) {
/* constructor */
{
Wrapper *w = NewWrapper();
String *call;
String *basetype = Getattr(parent, "classtype");
String *target = Swig_method_decl(0, decl, classname, parms, 0);
call = Swig_csuperclass_call(0, basetype, superparms);
Printf(w->def, "%s::%s: %s, Swig::Director(self) { }", classname, target, call);
Delete(target);
Wrapper_print(w, f_directors);
Delete(call);
DelWrapper(w);
}
/* constructor header */
{
String *target = Swig_method_decl(0, decl, classname, parms, 1);
Printf(f_directors_h, " %s;\n", target);
Delete(target);
}
}
Setattr(n, "parms", q);
Language::classDirectorConstructor(n);
Delete(sub);
Delete(classname);
Delete(supername);
//Delete(parms);
return SWIG_OK;
}
/* ------------------------------------------------------------
* classDirectorDefaultConstructor()
* ------------------------------------------------------------ */
int classDirectorDefaultConstructor(Node *n) {
String *classname;
classname = Swig_class_name(n);
/* insert self parameter */
Parm *p, *q;
ParmList *superparms = Getattr(n, "parms");
ParmList *parms = CopyParmList(superparms);
String *type = NewString("CAML_VALUE");
p = NewParm(type, NewString("self"), n);
q = Copy(p);
set_nextSibling(p, parms);
{
Wrapper *w = NewWrapper();
Printf(w->def, "SwigDirector_%s::SwigDirector_%s(CAML_VALUE self) : Swig::Director(self) { }", classname, classname);
Wrapper_print(w, f_directors);
DelWrapper(w);
}
Printf(f_directors_h, " SwigDirector_%s(CAML_VALUE self);\n", classname);
Delete(classname);
Setattr(n, "parms", q);
return Language::classDirectorDefaultConstructor(n);
}
int classDirectorInit(Node *n) {
String *declaration = Swig_director_declaration(n);
Printf(f_directors_h, "\n" "%s\n" "public:\n", declaration);
Delete(declaration);
return Language::classDirectorInit(n);
}
int classDirectorEnd(Node *n) {
Printf(f_directors_h, "};\n\n");
return Language::classDirectorEnd(n);
}
/* ---------------------------------------------------------------------
* typedefHandler
*
* This is here in order to maintain the correct association between
* typedef names and enum names.
*
* Since I implement enums as polymorphic variant tags, I need to call
* back into ocaml to evaluate them. This requires a string that can
* be generated in the typemaps, and also at SWIG time to be the same
* string. The problem that arises is that SWIG variously generates
* enum e_name_tag
* e_name_tag
* e_typedef_name
* for
* typedef enum e_name_tag { ... } e_typedef_name;
*
* Since I need these strings to be consistent, I must maintain a correct
* association list between typedef and enum names.
* --------------------------------------------------------------------- */
int typedefHandler(Node *n) {
String *type = Getattr(n, "type");
Node *enum_node = type ? Getattr(seen_enums, type) : 0;
if (enum_node) {
String *name = Getattr(enum_node, "name");
Printf(f_mlbody, "let _ = Callback.register \"%s_marker\" (`%s)\n", Getattr(n, "name"), name);
}
return SWIG_OK;
}
String *runtimeCode() {
String *s = Swig_include_sys("ocamlrun.swg");
if (!s) {
Printf(stderr, "*** Unable to open 'ocamlrun.swg'\n");
s = NewString("");
}
return s;
}
String *defaultExternalRuntimeFilename() {
return NewString("swigocamlrun.h");
}
};
/* -------------------------------------------------------------------------
* swig_ocaml() - Instantiate module
* ------------------------------------------------------------------------- */
static Language *new_swig_ocaml() {
return new OCAML();
}
extern "C" Language *swig_ocaml(void) {
return new_swig_ocaml();
}