55377bdc08
Exit() is a wrapper for exit() by default, but SetExitHandler() allows specifying a function to call instead. This means that failures within DOH (e.g. Malloc() failing due to lack of memory) will now perform cleanup such as removing output files. This commit also cleans up exit statuses so SWIG should now reliably exit with status 0 if the run was successful and status 1 if there was an error (or a warning and -Werror was in effect). Previously in some situations SWIG would try to exit with the status set to the number of errors encountered, but that's problematic - for example if there were 256 errors this would result in exit status 0 on most platforms. Also some error statuses have special meanings e.g. those defined by <sysexits.h>. Also SWIG/Javascript tried to exit with status -1 in a few places (which typically results in exit status 255).
1870 lines
62 KiB
C++
1870 lines
62 KiB
C++
/* -----------------------------------------------------------------------------
|
|
* 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);
|
|
Exit(EXIT_SUCCESS);
|
|
} else if (strcmp(argv[i], "-where") == 0) {
|
|
PrintIncludeArg();
|
|
Exit(EXIT_SUCCESS);
|
|
} 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);
|
|
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);
|
|
Exit(EXIT_FAILURE);
|
|
}
|
|
String *mlifilen = NewStringf("%s%s", SWIG_output_directory(), mlifile);
|
|
if ((f_mliout = NewFile(mlifilen, "w", SWIG_output_files())) == 0) {
|
|
FileErrorDisplay(mlifilen);
|
|
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_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, "$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"))) {
|
|
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, "$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"))) {
|
|
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, "$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))) {
|
|
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))) {
|
|
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))) {
|
|
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, "$input", "args");
|
|
emit_action_code(n, f->code, tm);
|
|
} else if ((tm = Swig_typemap_lookup("in", n, name, 0))) {
|
|
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, "$result", "swig_result");
|
|
emit_action_code(n, f->code, tm);
|
|
} else if ((tm = Swig_typemap_lookup("out", n, name, 0))) {
|
|
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();
|
|
}
|