656cb7ab06
new git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@7564 626c5289-ae23-0410-ae9c-e8d60b6d4f22
1652 lines
49 KiB
C++
1652 lines
49 KiB
C++
/********************************************************************
|
|
* CHICKEN module for SWIG
|
|
*
|
|
* Author : Jonah Beckford
|
|
*
|
|
* Major restructuring: John Lenz
|
|
*
|
|
* Modified from mzscheme.cxx, guile.cxx and python.cxx : David
|
|
* Beazley
|
|
*
|
|
* Please read the file LICENSE for the copyright and terms by which
|
|
* SWIG can be used and distributed.
|
|
*
|
|
********************************************************************/
|
|
|
|
char cvsroot_chicken_cxx[] = "$Header$";
|
|
|
|
/***********************************************************************
|
|
* $Header$
|
|
*
|
|
* chicken.cxx
|
|
*
|
|
* Definitions for adding functions to CHICKEN
|
|
***********************************************************************/
|
|
|
|
#include "swigmod.h"
|
|
|
|
#include <ctype.h>
|
|
|
|
static const char *chicken_usage = (char*)"\
|
|
\
|
|
CHICKEN Options (available with -chicken)\n\
|
|
-proxy - Export TinyCLOS class definitions\n\
|
|
-closprefix <prefix> - Prepend <prefix> to all clos identifiers\n\
|
|
-useclassprefix - Prepend the class name to all clos identifiers\n\
|
|
-unhideprimitive - Unhide the primitive: symbols\n\
|
|
-nounit - Do not (declare (unit ...)) in scheme file\n\
|
|
-noclosuses - Do not (declare (uses ...)) in scheme file\n\
|
|
-nocollection - Do not register pointers with chicken garbage\n\
|
|
collector and export destructors\n\
|
|
\n"
|
|
;
|
|
|
|
static char *module = 0;
|
|
static char *chicken_path=(char*)"chicken";
|
|
static int num_methods = 0;
|
|
|
|
static File *f_runtime = 0;
|
|
static File *f_header = 0;
|
|
static File *f_wrappers = 0;
|
|
static File *f_init = 0;
|
|
static String *chickentext = 0;
|
|
static String *closprefix = 0;
|
|
static String *swigtype_ptr = 0;
|
|
|
|
|
|
static String *f_sym_size = 0;
|
|
|
|
/* some options */
|
|
static int declare_unit = 1;
|
|
static int no_collection = 0;
|
|
static int clos_uses = 1;
|
|
|
|
/* C++ Support + Clos Classes */
|
|
static int clos = 0;
|
|
static String *class_name = 0;
|
|
static String *short_class_name = 0;
|
|
|
|
static int in_class = 0;
|
|
static int have_constructor = 0;
|
|
static bool exporting_destructor = false;
|
|
static bool exporting_constructor = false;
|
|
static String *constructor_name = 0;
|
|
static String *member_name = 0;
|
|
|
|
/* sections of the clos code */
|
|
static String *clos_class_defines = 0;
|
|
static String *clos_methods = 0;
|
|
|
|
/* Some clos options */
|
|
static int useclassprefix = 0;
|
|
static String *clossymnameprefix = 0;
|
|
static int hide_primitive = 1;
|
|
static Hash *primitive_names = 0;
|
|
|
|
/* Used for overloading constructors */
|
|
static int has_constructor_args = 0;
|
|
static List *constructor_arg_types = 0;
|
|
static String *constructor_dispatch = 0;
|
|
|
|
static Hash *overload_parameter_lists = 0;
|
|
|
|
class CHICKEN : public Language {
|
|
public:
|
|
|
|
virtual void main(int argc, char *argv[]);
|
|
virtual int top(Node *n);
|
|
virtual int functionWrapper(Node *n);
|
|
virtual int variableWrapper(Node *n);
|
|
virtual int constantWrapper(Node *n);
|
|
virtual int classHandler(Node *n);
|
|
virtual int memberfunctionHandler(Node *n);
|
|
virtual int membervariableHandler(Node *n);
|
|
virtual int constructorHandler(Node *n);
|
|
virtual int destructorHandler(Node *n);
|
|
virtual int validIdentifier(String *s);
|
|
virtual int staticmembervariableHandler(Node *n);
|
|
virtual int staticmemberfunctionHandler(Node *n);
|
|
virtual int importDirective(Node *n);
|
|
|
|
protected:
|
|
void addMethod(String *scheme_name, String *function);
|
|
/* Return true iff T is a pointer type */
|
|
int isPointer(SwigType *t);
|
|
void dispatchFunction(Node *n);
|
|
|
|
String *chickenNameMapping(String *, String_or_char *);
|
|
String *chickenPrimitiveName(String *);
|
|
|
|
String *runtimeCode();
|
|
String *defaultExternalRuntimeFilename();
|
|
String *buildClosFunctionCall(List *types, String_or_char *closname, String_or_char *funcname);
|
|
};
|
|
|
|
/* -----------------------------------------------------------------------
|
|
* swig_chicken() - Instantiate module
|
|
* ----------------------------------------------------------------------- */
|
|
|
|
static Language * new_swig_chicken() {
|
|
return new CHICKEN();
|
|
}
|
|
|
|
extern "C" {
|
|
Language * swig_chicken(void) {
|
|
return new_swig_chicken();
|
|
}
|
|
}
|
|
|
|
void
|
|
CHICKEN::main(int argc, char *argv[])
|
|
{
|
|
int i;
|
|
|
|
SWIG_library_directory(chicken_path);
|
|
|
|
// Look for certain command line options
|
|
for (i = 1; i < argc; i++) {
|
|
if (argv[i]) {
|
|
if (strcmp(argv[i], "-help") == 0) {
|
|
fputs(chicken_usage, stdout);
|
|
SWIG_exit(0);
|
|
}
|
|
else if (strcmp(argv[i],"-proxy") == 0) {
|
|
clos = 1;
|
|
Swig_mark_arg(i);
|
|
} else if (strcmp(argv[i],"-closprefix") == 0) {
|
|
if (argv[i+1]) {
|
|
clossymnameprefix = NewString(argv[i+1]);
|
|
Swig_mark_arg(i);
|
|
Swig_mark_arg(i+1);
|
|
i++;
|
|
} else {
|
|
Swig_arg_error();
|
|
}
|
|
} else if (strcmp(argv[i],"-useclassprefix") == 0) {
|
|
useclassprefix = 1;
|
|
Swig_mark_arg(i);
|
|
} else if (strcmp(argv[i],"-unhideprimitive") == 0) {
|
|
hide_primitive = 0;
|
|
Swig_mark_arg(i);
|
|
} else if (strcmp(argv[i],"-nounit") == 0) {
|
|
declare_unit = 0;
|
|
Swig_mark_arg(i);
|
|
} else if (strcmp(argv[i],"-noclosuses") == 0) {
|
|
clos_uses = 0;
|
|
Swig_mark_arg(i);
|
|
} else if (strcmp(argv[i],"-nocollection") == 0) {
|
|
no_collection = 1;
|
|
Swig_mark_arg(i);
|
|
}
|
|
}
|
|
}
|
|
|
|
if (!clos) hide_primitive = 0;
|
|
|
|
// Add a symbol for this module
|
|
Preprocessor_define("SWIGCHICKEN 1",0);
|
|
|
|
// Set name of typemaps
|
|
|
|
SWIG_typemap_lang("chicken");
|
|
|
|
// Read in default typemaps */
|
|
SWIG_config_file("chicken.swg");
|
|
allow_overloading();
|
|
}
|
|
|
|
int
|
|
CHICKEN::top(Node *n)
|
|
{
|
|
String *chicken_filename = NewString("");
|
|
File *f_scm;
|
|
String *scmmodule;
|
|
|
|
/* Initialize all of the output files */
|
|
String *outfile = Getattr(n,"outfile");
|
|
|
|
f_runtime = NewFile(outfile,"w");
|
|
if (!f_runtime) {
|
|
FileErrorDisplay(outfile);
|
|
SWIG_exit(EXIT_FAILURE);
|
|
}
|
|
f_init = NewString("");
|
|
f_header = NewString("");
|
|
f_wrappers = NewString("");
|
|
chickentext = NewString("");
|
|
closprefix = NewString("");
|
|
f_sym_size = NewString("");
|
|
primitive_names = NewHash();
|
|
overload_parameter_lists = NewHash();
|
|
|
|
/* Register file targets with the SWIG file handler */
|
|
Swig_register_filebyname("header",f_header);
|
|
Swig_register_filebyname("wrapper",f_wrappers);
|
|
Swig_register_filebyname("runtime",f_runtime);
|
|
Swig_register_filebyname("init",f_init);
|
|
|
|
Swig_register_filebyname("chicken", chickentext);
|
|
Swig_register_filebyname("closprefix", closprefix);
|
|
|
|
clos_class_defines = NewString("");
|
|
clos_methods = NewString("");
|
|
|
|
Printf(f_runtime, "/* -*- buffer-read-only: t -*- vi: set ro: */\n");
|
|
Swig_banner(f_runtime);
|
|
|
|
Printf(f_runtime, "/* Implementation : CHICKEN */\n\n");
|
|
|
|
if (no_collection)
|
|
Printf(f_runtime, "#define SWIG_CHICKEN_NO_COLLECTION 1\n");
|
|
|
|
/* Set module name */
|
|
module = Swig_copy_string(Char(Getattr(n, "name")));
|
|
scmmodule = NewString(module);
|
|
Replaceall(scmmodule, "_", "-");
|
|
|
|
Printf(f_header,"#define SWIG_init swig_%s_init\n", module);
|
|
Printf(f_header,"#define SWIG_name \"%s\"\n", scmmodule);
|
|
|
|
Printf(f_wrappers,"#ifdef __cplusplus\n");
|
|
Printf(f_wrappers,"extern \"C\" {\n");
|
|
Printf(f_wrappers,"#endif\n\n");
|
|
|
|
Language::top(n);
|
|
|
|
SwigType_emit_type_table(f_runtime, f_wrappers);
|
|
|
|
Printf(f_wrappers,"#ifdef __cplusplus\n");
|
|
Printf(f_wrappers,"}\n");
|
|
Printf(f_wrappers,"#endif\n");
|
|
|
|
Printf(f_init, "C_kontinue (continuation, ret);\n");
|
|
Printf(f_init, "}\n\n");
|
|
|
|
Printf(f_init,"#ifdef __cplusplus\n");
|
|
Printf(f_init,"}\n");
|
|
Printf(f_init,"#endif\n");
|
|
|
|
Printf(chicken_filename,"%s%s.scm", SWIG_output_directory(), module);
|
|
if ((f_scm = NewFile(chicken_filename,"w")) == 0) {
|
|
FileErrorDisplay(chicken_filename);
|
|
SWIG_exit(EXIT_FAILURE);
|
|
}
|
|
|
|
Printv(f_scm,
|
|
";; -*- buffer-read-only: t -*- vi: set ro:\n",
|
|
";; This file was created automatically by SWIG.\n",
|
|
";; Don't modify this file, modify the SWIG interface instead.\n",
|
|
NIL);
|
|
if (declare_unit)
|
|
Printv(f_scm,"(declare (unit ", scmmodule, "))\n\n", NIL);
|
|
Printv(f_scm,"(declare \n",
|
|
tab4, "(hide swig-init swig-init-return)\n",
|
|
tab4, "(foreign-declare \"C_extern void swig_", module, "_init(C_word,C_word,C_word) C_noret;\"))\n", NIL);
|
|
Printv(f_scm,"(define swig-init (##core#primitive \"swig_", module,
|
|
"_init\"))\n", NIL);
|
|
Printv(f_scm,"(define swig-init-return (swig-init))\n\n", NIL);
|
|
|
|
if (clos) {
|
|
Printf (f_scm, "(declare (uses tinyclos))\n");
|
|
Replaceall(closprefix,"$module", scmmodule);
|
|
Printf (f_scm, "%s\n", closprefix);
|
|
Printf (f_scm, "%s\n", clos_class_defines);
|
|
Printf (f_scm, "%s\n", clos_methods);
|
|
}
|
|
|
|
Printf(f_scm, "%s\n", chickentext);
|
|
|
|
|
|
Close(f_scm);
|
|
Delete(f_scm);
|
|
|
|
char buftmp[20];
|
|
sprintf(buftmp, "%d", num_methods);
|
|
Replaceall(f_init, "$nummethods", buftmp);
|
|
Replaceall(f_init, "$symsize", f_sym_size);
|
|
|
|
if (hide_primitive)
|
|
Replaceall(f_init, "$veclength", buftmp);
|
|
else
|
|
Replaceall(f_init, "$veclength", "0");
|
|
|
|
Delete(chicken_filename);
|
|
Delete(chickentext);
|
|
Delete(closprefix);
|
|
Delete(overload_parameter_lists);
|
|
|
|
Delete(clos_class_defines);
|
|
Delete(clos_methods);
|
|
|
|
/* Close all of the files */
|
|
Delete(primitive_names);
|
|
Delete(scmmodule);
|
|
Dump(f_header,f_runtime);
|
|
Dump(f_wrappers,f_runtime);
|
|
Wrapper_pretty_print(f_init,f_runtime);
|
|
Delete(f_header);
|
|
Delete(f_wrappers);
|
|
Delete(f_sym_size);
|
|
Delete(f_init);
|
|
Close(f_runtime);
|
|
Delete(f_runtime);
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::functionWrapper(Node *n)
|
|
{
|
|
|
|
String *name = Getattr(n,"name");
|
|
String *iname = Getattr(n,"sym:name");
|
|
SwigType *d = Getattr(n,"type");
|
|
ParmList *l = Getattr(n,"parms");
|
|
|
|
Parm *p;
|
|
int i;
|
|
String *wname;
|
|
String *source;
|
|
Wrapper *f;
|
|
String *mangle = NewString("");
|
|
String *get_pointers;
|
|
String *cleanup;
|
|
String *argout;
|
|
String *tm;
|
|
String *overname = 0;
|
|
String *declfunc = 0;
|
|
String *scmname;
|
|
bool any_specialized_arg = false;
|
|
List *function_arg_types = NewList();
|
|
int return_proxy_fastcall = 0;
|
|
|
|
int num_required;
|
|
int num_arguments;
|
|
|
|
Printf(mangle, "\"%s\"", SwigType_manglestr(d));
|
|
|
|
if (Getattr(n,"sym:overloaded")) {
|
|
overname = Getattr(n,"sym:overname");
|
|
} else {
|
|
if (!addSymbol(iname,n)) return SWIG_ERROR;
|
|
}
|
|
|
|
f = NewWrapper();
|
|
wname = NewString("");
|
|
get_pointers = NewString("");
|
|
cleanup = NewString("");
|
|
argout = NewString("");
|
|
declfunc = NewString("");
|
|
scmname = NewString(iname);
|
|
Replaceall(scmname, "_", "-");
|
|
|
|
/* Local vars */
|
|
Wrapper_add_local(f,"resultobj", "C_word resultobj");
|
|
|
|
/* Write code to extract function parameters. */
|
|
emit_args(d, l, f);
|
|
|
|
/* Attach the standard typemaps */
|
|
emit_attach_parmmaps(l,f);
|
|
Setattr(n,"wrap:parms",l);
|
|
|
|
/* Get number of required and total arguments */
|
|
num_arguments = emit_num_arguments(l);
|
|
num_required = emit_num_required(l);
|
|
|
|
Append(wname, Swig_name_wrapper(iname));
|
|
if (overname) {
|
|
Append(wname, overname);
|
|
}
|
|
|
|
// Check for interrupts
|
|
Printv (f->code, "C_trace(\"",scmname,"\");\n", NIL);
|
|
|
|
Printv(f->def,
|
|
"static ",
|
|
"void ", wname,
|
|
" (C_word argc, C_word closure, C_word continuation",
|
|
NIL);
|
|
Printv(declfunc,
|
|
"void ", wname,
|
|
"(C_word,C_word,C_word",
|
|
NIL);
|
|
|
|
/* Generate code for argument marshalling */
|
|
for (i = 0, p=l; i < num_arguments; i++) {
|
|
|
|
while (checkAttribute(p,"tmap:in:numinputs","0")) {
|
|
p = Getattr(p,"tmap:in:next");
|
|
}
|
|
|
|
SwigType *pt = Getattr(p,"type");
|
|
String *ln = Getattr(p,"lname");
|
|
|
|
source = NewStringf("scm%d",i+1);
|
|
|
|
Printf(f->def, ", C_word scm%d", i+1);
|
|
Printf(declfunc,",C_word");
|
|
|
|
/* Look for an input typemap */
|
|
if ((tm = Getattr(p,"tmap:in"))) {
|
|
String *parse = Getattr(p,"tmap:in:parse");
|
|
if (!parse) {
|
|
Replaceall(tm,"$source",source);
|
|
Replaceall(tm,"$target",ln);
|
|
Replaceall(tm,"$input", source);
|
|
Setattr(p,"emit:input", source); /* Save the location of
|
|
the object */
|
|
|
|
if (Getattr(p,"wrap:disown") || (Getattr(p,"tmap:in:disown"))) {
|
|
Replaceall(tm,"$disown","SWIG_POINTER_DISOWN");
|
|
} else {
|
|
Replaceall(tm,"$disown","0");
|
|
}
|
|
|
|
if (i >= num_required)
|
|
Printf(get_pointers, "if (argc-2>%i && (%s)) {\n", i, source);
|
|
Printv(get_pointers,tm,"\n", NIL);
|
|
if (i >= num_required)
|
|
Printv(get_pointers, "}\n", NIL);
|
|
|
|
if (clos) {
|
|
if (i < num_required) {
|
|
if (strcmp("void", Char(pt)) != 0) {
|
|
Node *class_node = 0;
|
|
String *clos_code = Getattr(p, "tmap:in:closcode");
|
|
class_node = classLookup(pt);
|
|
if (clos_code && class_node) {
|
|
String *class_name = NewStringf("<%s>", Getattr(class_node, "sym:name"));
|
|
Append(function_arg_types, class_name);
|
|
Append(function_arg_types, Copy(clos_code));
|
|
any_specialized_arg = true;
|
|
Delete(class_name);
|
|
} else {
|
|
Append(function_arg_types, "<top>");
|
|
Append(function_arg_types, "$input");
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
} else {
|
|
}
|
|
|
|
|
|
p = Getattr(p,"tmap:in:next");
|
|
continue;
|
|
} else {
|
|
Swig_warning(WARN_TYPEMAP_IN_UNDEF, input_file, line_number,
|
|
"Unable to use type %s as a function argument.\n",
|
|
SwigType_str(pt,0));
|
|
break;
|
|
}
|
|
|
|
Delete(source);
|
|
p = nextSibling(p);
|
|
}
|
|
|
|
/* finish argument marshalling */
|
|
|
|
Printf(f->def, ") {");
|
|
Printf(declfunc, ")");
|
|
|
|
if (num_required != num_arguments) {
|
|
Append(function_arg_types, "^^##optional$$");
|
|
}
|
|
|
|
/* First check the number of arguments is correct */
|
|
if (num_arguments != num_required)
|
|
Printf(f->code, "if (argc-2<%i || argc-2>%i) C_bad_argc(argc,%i);\n", num_required, num_arguments, num_required+2);
|
|
else
|
|
Printf(f->code, "if (argc!=%i) C_bad_argc(argc,%i);\n", num_arguments+2, num_arguments+2);
|
|
|
|
/* Now piece together the first part of the wrapper function */
|
|
Printv(f->code, get_pointers, NIL);
|
|
|
|
/* 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);
|
|
}
|
|
}
|
|
|
|
/* Insert cleanup code */
|
|
for (p = l; p;) {
|
|
if ((tm = Getattr(p,"tmap:freearg"))) {
|
|
Replaceall(tm,"$source",Getattr(p,"lname"));
|
|
Printv(cleanup,tm,"\n",NIL);
|
|
p = Getattr(p,"tmap:freearg:next");
|
|
} else {
|
|
p = nextSibling(p);
|
|
}
|
|
}
|
|
|
|
/* Emit the function call */
|
|
emit_action(n,f);
|
|
|
|
/* Insert argument output code */
|
|
for (p = l; p;) {
|
|
if ((tm = Getattr(p,"tmap:argout"))) {
|
|
if (!Wrapper_check_local(f, "gswig_list_p")) {
|
|
Wrapper_add_local(f,"resultobjlast", "C_word resultobjlast");
|
|
Wrapper_add_local(f,"gswig_list_p", "int gswig_list_p = 0");
|
|
}
|
|
Replaceall(tm,"$source",Getattr(p,"lname"));
|
|
Replaceall(tm,"$target","resultobj");
|
|
Replaceall(tm,"$arg",Getattr(p,"emit:input"));
|
|
Replaceall(tm,"$input",Getattr(p,"emit:input"));
|
|
Printf(argout, "%s", tm);
|
|
p = Getattr(p,"tmap:argout:next");
|
|
} else {
|
|
p = nextSibling(p);
|
|
}
|
|
}
|
|
|
|
/* Return the function value */
|
|
if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
|
|
Replaceall(tm,"$source", "result");
|
|
Replaceall(tm,"$target", "resultobj");
|
|
Replaceall(tm,"$result", "resultobj");
|
|
if (GetFlag(n,"feature:new")) {
|
|
Replaceall(tm,"$owner","1");
|
|
} else {
|
|
Replaceall(tm,"$owner","0");
|
|
}
|
|
|
|
/* check for chickenfastproxy flag */
|
|
if (Getattr(n, "tmap:out:chickenfastproxy")) {
|
|
if (exporting_constructor && clos && hide_primitive) {
|
|
/* Don't return a proxy, the wrapped CLOS class is the proxy */
|
|
Replaceall(tm, "$proxy", "0");
|
|
} else {
|
|
/* can only do fast proxy if there are no argout paramaters... */
|
|
if (Wrapper_check_local(f, "gswig_list_p")) {
|
|
Replaceall(tm, "$proxy", "1");
|
|
} else {
|
|
Replaceall(tm, "$proxy", "0");
|
|
return_proxy_fastcall = 1;
|
|
}
|
|
}
|
|
}
|
|
Printf(f->code, "%s", tm);
|
|
} else {
|
|
Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number,
|
|
"Unable to use return type %s in function %s.\n",
|
|
SwigType_str(d,0), name);
|
|
}
|
|
|
|
/* Insert the argumetn output code */
|
|
Printv(f->code, argout, NIL);
|
|
|
|
/* Output cleanup code */
|
|
Printv(f->code,cleanup,NIL);
|
|
|
|
/* Look to see if there is any newfree cleanup code */
|
|
if (GetFlag(n,"feature:new")) {
|
|
if ((tm = Swig_typemap_lookup_new("newfree",n,"result",0))) {
|
|
Replaceall(tm,"$source","result");
|
|
Printf(f->code,"%s\n",tm);
|
|
}
|
|
}
|
|
|
|
/* See if there is any return cleanup code */
|
|
if ((tm = Swig_typemap_lookup_new("ret", n, "result", 0))) {
|
|
Replaceall(tm,"$source","result");
|
|
Printf(f->code,"%s\n",tm);
|
|
}
|
|
|
|
if (return_proxy_fastcall) {
|
|
Printv(f->code,"{\n",
|
|
"C_word func;\n",
|
|
"SWIG_Chicken_FindCreateProxy(func, resultobj);\n",
|
|
"if (C_swig_is_closurep(func))\n",
|
|
" ((C_proc3)(void *)C_block_item(func, 0))(3,func,continuation,resultobj);\n",
|
|
"else\n",
|
|
" C_kontinue(continuation, resultobj);\n",
|
|
"}\n", NIL);
|
|
} else if (Wrapper_check_local(f, "gswig_list_p")) {
|
|
Printv(f->code,"if (gswig_list_p)\n",
|
|
" C_apply_values(3, C_SCHEME_UNDEFINED, continuation, resultobj);\n",
|
|
"else\n",
|
|
" C_kontinue(continuation, resultobj);\n", NIL);
|
|
} else {
|
|
Printf(f->code,"C_kontinue (continuation, resultobj);\n");
|
|
}
|
|
|
|
/* Error handling code */
|
|
#ifdef USE_FAIL
|
|
Printf(f->code,"fail:\n");
|
|
Printv(f->code,cleanup,NIL);
|
|
Printf(f->code,"swig_panic (\"failure in "
|
|
"'$symname' SWIG function wrapper\");\n");
|
|
#endif
|
|
Printf(f->code,"}\n");
|
|
|
|
/* Substitute the cleanup code */
|
|
Replaceall(f->code,"$cleanup",cleanup);
|
|
|
|
/* Substitute the function name */
|
|
Replaceall(f->code,"$symname",iname);
|
|
Replaceall(f->code,"$result","resultobj");
|
|
|
|
/* Dump the function out */
|
|
Printv(f_wrappers,
|
|
"static ",
|
|
declfunc, " C_noret;\n", NIL);
|
|
Wrapper_print(f,f_wrappers);
|
|
|
|
Setattr(n,"wrap:name", wname);
|
|
|
|
/* Now register the function with the interpreter. */
|
|
if (!Getattr(n,"sym:overloaded")) {
|
|
if (exporting_destructor && !no_collection) {
|
|
Printf(f_init,
|
|
"((swig_chicken_clientdata *)(SWIGTYPE%s->clientdata))->destroy = (swig_chicken_destructor) %s;\n",
|
|
swigtype_ptr, wname);
|
|
} else {
|
|
addMethod(scmname, wname);
|
|
}
|
|
|
|
/* Only export if we are not in a class, or if in a class memberfunction */
|
|
if (!in_class || member_name) {
|
|
String *method_def;
|
|
String *clos_name;
|
|
if (in_class)
|
|
clos_name = NewString(member_name);
|
|
else
|
|
clos_name = chickenNameMapping(scmname, (char *)"");
|
|
|
|
if (!any_specialized_arg) {
|
|
method_def = NewString("");
|
|
Printv(method_def, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")", NIL);
|
|
} else {
|
|
method_def = buildClosFunctionCall(function_arg_types, clos_name, chickenPrimitiveName(scmname));
|
|
}
|
|
Printv(clos_methods, method_def, "\n", NIL);
|
|
Delete(clos_name);
|
|
Delete(method_def);
|
|
}
|
|
|
|
if (have_constructor && !has_constructor_args && any_specialized_arg) {
|
|
has_constructor_args = 1;
|
|
constructor_arg_types = Copy(function_arg_types);
|
|
}
|
|
} else {
|
|
/* add function_arg_types to overload hash */
|
|
List *flist = Getattr(overload_parameter_lists, scmname);
|
|
if (!flist) {
|
|
flist = NewList();
|
|
Setattr(overload_parameter_lists, scmname, flist);
|
|
}
|
|
|
|
Append(flist, Copy(function_arg_types));
|
|
|
|
if (!Getattr(n,"sym:nextSibling")) {
|
|
dispatchFunction(n);
|
|
}
|
|
}
|
|
|
|
|
|
Delete(wname);
|
|
Delete(get_pointers);
|
|
Delete(cleanup);
|
|
Delete(declfunc);
|
|
Delete(mangle);
|
|
Delete(function_arg_types);
|
|
DelWrapper(f);
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::variableWrapper(Node *n) {
|
|
char *name = GetChar(n,"name");
|
|
char *iname = GetChar(n,"sym:name");
|
|
SwigType *t = Getattr(n,"type");
|
|
ParmList *l = Getattr(n,"parms");
|
|
|
|
char var_name[256];
|
|
String *wname = NewString("");
|
|
String *mangle = NewString("");
|
|
String *tm;
|
|
String *tm2 = NewString("");;
|
|
String *argnum = NewString("0");
|
|
String *arg = NewString("argv[0]");
|
|
Wrapper *f;
|
|
String *overname = 0;
|
|
String *scmname;
|
|
|
|
int num_required;
|
|
int num_arguments;
|
|
|
|
scmname = NewString(iname);
|
|
Replaceall(scmname, "_", "-");
|
|
|
|
Printf(mangle, "\"%s\"", SwigType_manglestr(t));
|
|
|
|
if (Getattr(n,"sym:overloaded")) {
|
|
overname = Getattr(n,"sym:overname");
|
|
} else {
|
|
if (!addSymbol(iname,n)) return SWIG_ERROR;
|
|
}
|
|
|
|
f = NewWrapper();
|
|
|
|
/* Attach the standard typemaps */
|
|
emit_attach_parmmaps(l,f);
|
|
Setattr(n,"wrap:parms",l);
|
|
|
|
/* Get number of required and total arguments */
|
|
num_arguments = emit_num_arguments(l);
|
|
num_required = emit_num_required(l);
|
|
|
|
// evaluation function names
|
|
Append(wname, Swig_name_wrapper(iname));
|
|
if (overname) {
|
|
Append(wname, overname);
|
|
}
|
|
|
|
strcpy(var_name, Char(Swig_name_wrapper(iname)));
|
|
|
|
// Check for interrupts
|
|
Printv (f->code, "C_trace(\"",scmname,"\");\n", NIL);
|
|
|
|
if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) {
|
|
|
|
Printv(f->def,
|
|
"static ",
|
|
"void ",wname,"(C_word, C_word, C_word, C_word) C_noret;\n",
|
|
NIL);
|
|
Printv(f->def,
|
|
"static "
|
|
"void ",wname,"(C_word argc, C_word closure, "
|
|
"C_word continuation, C_word value) {\n",
|
|
NIL);
|
|
|
|
Wrapper_add_local(f, "resultobj", "C_word resultobj");
|
|
|
|
Printf(f->code, "if (argc!=2 && argc!=3) C_bad_argc(argc,2);\n");
|
|
|
|
/* Check for a setting of the variable value */
|
|
if (!Getattr(n,"feature:immutable")) {
|
|
Printf(f->code, "if (argc > 2) {\n");
|
|
if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) {
|
|
Replaceall(tm,"$source","value");
|
|
Replaceall(tm,"$target",name);
|
|
Replaceall(tm,"$input","value");
|
|
Printv(f->code, tm, "\n",NIL);
|
|
}
|
|
else {
|
|
Swig_warning(WARN_TYPEMAP_VARIN_UNDEF, input_file, line_number,
|
|
"Unable to set variable of type %s.\n",
|
|
SwigType_str(t,0));
|
|
}
|
|
Printf(f->code, "}\n");
|
|
}
|
|
|
|
String *varname;
|
|
if (SwigType_istemplate((char*)name)) {
|
|
varname = SwigType_namestr((char *)name);
|
|
} else {
|
|
varname = name;
|
|
}
|
|
|
|
// Now return the value of the variable - regardless
|
|
// of evaluating or setting.
|
|
if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
|
|
Replaceall(tm,"$source",varname);
|
|
Replaceall(tm,"$varname",varname);
|
|
Replaceall(tm,"$target","resultobj");
|
|
Replaceall(tm,"$result","resultobj");
|
|
Printf(f->code, "%s\n", tm);
|
|
}
|
|
else {
|
|
Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number,
|
|
"Unable to read variable of type %s\n", SwigType_str(t,0));
|
|
}
|
|
|
|
if (Getattr(n, "tmap:varout:chickenfastproxy")) {
|
|
Printv(f->code,"{\n",
|
|
"C_word func;\n",
|
|
"SWIG_Chicken_FindCreateProxy(func, resultobj);\n",
|
|
"if (C_swig_is_closurep(func))\n",
|
|
" ((C_proc3)(void *)C_block_item(func, 0))(3,func,continuation,resultobj);\n",
|
|
"else\n",
|
|
" C_kontinue(continuation, resultobj);\n",
|
|
"}\n", NIL);
|
|
} else {
|
|
Printf(f->code," C_kontinue (continuation, resultobj);\n");
|
|
}
|
|
|
|
/* Error handling code */
|
|
#ifdef USE_FAIL
|
|
Printf(f->code,"fail:\n");
|
|
Printf(f->code,"swig_panic (\"failure in "
|
|
"'%s' SWIG wrapper\");\n", proc_name);
|
|
#endif
|
|
Printf(f->code,"}\n");
|
|
|
|
Wrapper_print(f, f_wrappers);
|
|
|
|
/* Now register the variable with the interpreter. */
|
|
addMethod(scmname, wname);
|
|
|
|
if (!in_class || member_name) {
|
|
String *clos_name;
|
|
if (in_class)
|
|
clos_name = NewString(member_name);
|
|
else
|
|
clos_name = chickenNameMapping(scmname, (char *)"");
|
|
|
|
Node *class_node = classLookup(t);
|
|
if (class_node && Getattr(n, "tmap:varout:chickenfastproxy")) {
|
|
Printv(clos_methods, "(define (", clos_name, " . lst) (if (null? lst) (", chickenPrimitiveName(scmname), ") (",
|
|
chickenPrimitiveName(scmname), " (slot-ref (car lst) 'swig-this))))\n", NIL);
|
|
} else {
|
|
/* Simply re-export the procedure */
|
|
Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
|
|
}
|
|
Delete(clos_name);
|
|
}
|
|
} else {
|
|
Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
|
|
"Unsupported variable type %s (ignored).\n",
|
|
SwigType_str(t,0));
|
|
}
|
|
|
|
Delete(wname);
|
|
Delete(argnum);
|
|
Delete(arg);
|
|
Delete(tm2);
|
|
Delete(mangle);
|
|
DelWrapper(f);
|
|
return SWIG_OK;
|
|
}
|
|
|
|
/* ------------------------------------------------------------
|
|
* constantWrapper()
|
|
* ------------------------------------------------------------ */
|
|
|
|
int
|
|
CHICKEN::constantWrapper(Node *n)
|
|
{
|
|
|
|
char *name = GetChar(n,"name");
|
|
char *iname = GetChar(n,"sym:name");
|
|
SwigType *t = Getattr(n,"type");
|
|
ParmList *l = Getattr(n,"parms");
|
|
String *value = Getattr(n,"value");
|
|
|
|
String *proc_name = NewString("");
|
|
char var_name[256];
|
|
String *wname = NewString("");
|
|
String *mangle = NewString("");
|
|
String *tm;
|
|
String *tm2 = NewString("");
|
|
String *source = NewString("");
|
|
String *argnum = NewString("0");
|
|
String *arg = NewString("argv[0]");
|
|
Wrapper *f;
|
|
String *overname = 0;
|
|
String *scmname;
|
|
String *rvalue;
|
|
SwigType *nctype;
|
|
|
|
int num_required;
|
|
int num_arguments;
|
|
|
|
scmname = NewString(iname);
|
|
Replaceall(scmname, "_", "-");
|
|
|
|
Printf(source, "swig_const_%s", iname);
|
|
Replaceall(source, "::", "__");
|
|
|
|
Printf(mangle, "\"%s\"", SwigType_manglestr(t));
|
|
|
|
if (Getattr(n,"sym:overloaded")) {
|
|
overname = Getattr(n,"sym:overname");
|
|
} else {
|
|
if (!addSymbol(iname,n)) return SWIG_ERROR;
|
|
}
|
|
|
|
Append(wname, Swig_name_wrapper(iname));
|
|
if (overname) {
|
|
Append(wname, overname);
|
|
}
|
|
|
|
nctype = NewString(t);
|
|
if (SwigType_isconst(nctype)) {
|
|
Delete(SwigType_pop(nctype));
|
|
}
|
|
|
|
if (SwigType_type(nctype) == T_STRING) {
|
|
rvalue = NewStringf("\"%s\"", value);
|
|
} else if (SwigType_type(nctype) == T_CHAR) {
|
|
rvalue = NewStringf("\'%s\'", value);
|
|
} else {
|
|
rvalue = NewString(value);
|
|
}
|
|
|
|
/* Special hook for member pointer */
|
|
if (SwigType_type(t) == T_MPOINTER) {
|
|
Printf(f_header, "static %s = %s;\n", SwigType_str(t,wname), rvalue);
|
|
value = wname;
|
|
}
|
|
if ((tm = Swig_typemap_lookup_new("constcode", n, name, 0))) {
|
|
Replaceall(tm,"$source",rvalue);
|
|
Replaceall(tm,"$target",source);
|
|
Replaceall(tm,"$result",source);
|
|
Replaceall(tm,"$value",rvalue);
|
|
Printf(f_header, "%s\n", tm);
|
|
}
|
|
else {
|
|
Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number,
|
|
"Unsupported constant value.\n");
|
|
return SWIG_NOWRAP;
|
|
}
|
|
|
|
f = NewWrapper();
|
|
|
|
/* Attach the standard typemaps */
|
|
emit_attach_parmmaps(l,f);
|
|
Setattr(n,"wrap:parms",l);
|
|
|
|
/* Get number of required and total arguments */
|
|
num_arguments = emit_num_arguments(l);
|
|
num_required = emit_num_required(l);
|
|
|
|
// evaluation function names
|
|
|
|
strcpy(var_name, Char(Swig_name_wrapper(iname)));
|
|
|
|
// Check for interrupts
|
|
Printv (f->code, "C_trace(\"",scmname,"\");\n", NIL);
|
|
|
|
if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) {
|
|
|
|
Printv(f->def,
|
|
"static ",
|
|
"void ",wname,"(C_word, C_word, C_word) C_noret;\n",
|
|
NIL);
|
|
|
|
Printv(f->def,
|
|
"static ",
|
|
"void ",wname,"(C_word argc, C_word closure, "
|
|
"C_word continuation) {\n",
|
|
NIL);
|
|
|
|
Wrapper_add_local(f, "resultobj", "C_word resultobj");
|
|
|
|
Printf(f->code, "if (argc!=2) C_bad_argc(argc,2);\n");
|
|
|
|
// Return the value of the variable
|
|
if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
|
|
|
|
Replaceall(tm,"$source",source);
|
|
Replaceall(tm,"$varname",source);
|
|
Replaceall(tm,"$target","resultobj");
|
|
Replaceall(tm,"$result","resultobj");
|
|
Printf(f->code, "%s\n", tm);
|
|
}
|
|
else {
|
|
Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number,
|
|
"Unable to read variable of type %s\n", SwigType_str(t,0));
|
|
}
|
|
|
|
if (Getattr(n, "tmap:varout:chickenfastproxy")) {
|
|
Printv(f->code,"{\n",
|
|
"C_word func;\n",
|
|
"SWIG_Chicken_FindCreateProxy(func, resultobj);\n",
|
|
"if (C_swig_is_closurep(func))\n",
|
|
" ((C_proc3)(void *)C_block_item(func, 0))(3,func,continuation,resultobj);\n",
|
|
"else\n",
|
|
" C_kontinue(continuation, resultobj);\n",
|
|
"}\n", NIL);
|
|
} else {
|
|
Printf(f->code," C_kontinue (continuation, resultobj);\n");
|
|
}
|
|
|
|
/* Error handling code */
|
|
#ifdef USE_FAIL
|
|
Printf(f->code,"fail:\n");
|
|
Printf(f->code,"swig_panic (\"failure in "
|
|
"'%s' SWIG wrapper\");\n", proc_name);
|
|
#endif
|
|
Printf(f->code,"}\n");
|
|
|
|
Wrapper_print(f, f_wrappers);
|
|
|
|
/* Now register the variable with the interpreter. */
|
|
addMethod(scmname, wname);
|
|
|
|
if (!in_class || member_name) {
|
|
String *clos_name;
|
|
if (in_class)
|
|
clos_name = NewString(member_name);
|
|
else
|
|
clos_name = chickenNameMapping(scmname, (char *)"");
|
|
Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
|
|
Delete(clos_name);
|
|
}
|
|
|
|
} else {
|
|
Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
|
|
"Unsupported variable type %s (ignored).\n",
|
|
SwigType_str(t,0));
|
|
}
|
|
|
|
Delete(wname);
|
|
Delete(nctype);
|
|
Delete(proc_name);
|
|
Delete(argnum);
|
|
Delete(arg);
|
|
Delete(tm2);
|
|
Delete(mangle);
|
|
Delete(source);
|
|
Delete(rvalue);
|
|
DelWrapper(f);
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::classHandler(Node *n)
|
|
{
|
|
/* Create new strings for building up a wrapper function */
|
|
have_constructor = 0;
|
|
constructor_dispatch = 0;
|
|
constructor_name = 0;
|
|
|
|
class_name = NewString("");
|
|
short_class_name = NewString("");
|
|
Printv(class_name, "<", Getattr(n,"sym:name"), ">", NIL);
|
|
Printv(short_class_name, Getattr(n,"sym:name"), NIL);
|
|
Replaceall(class_name, "_", "-");
|
|
Replaceall(short_class_name, "_", "-");
|
|
|
|
if (!addSymbol(class_name,n)) return SWIG_ERROR;
|
|
|
|
/* Handle inheritance */
|
|
String *base_class = NewString("<");
|
|
List *baselist = Getattr(n,"bases");
|
|
if (baselist && Len(baselist)) {
|
|
Iterator base = First(baselist);
|
|
while (base.item) {
|
|
Printv(base_class, Getattr(base.item, "sym:name"),NIL);
|
|
base = Next(base);
|
|
if (base.item) {
|
|
Printf(base_class, "> <");
|
|
}
|
|
}
|
|
}
|
|
Printf(base_class, ">");
|
|
Replaceall(base_class, "_", "-");
|
|
|
|
String *scmmod = NewString(module);
|
|
Replaceall(scmmod, "_", "-");
|
|
|
|
Printv(clos_class_defines,"(define ", class_name, "\n",
|
|
" (make <swig-metaclass-", scmmod, "> 'name \"", short_class_name, "\"\n", NIL);
|
|
Delete(scmmod);
|
|
|
|
if (Len(base_class) > 2) {
|
|
Printv(clos_class_defines," 'direct-supers (list ", base_class, ")\n", NIL);
|
|
} else {
|
|
Printv(clos_class_defines," 'direct-supers (list <object>)\n", NIL);
|
|
}
|
|
|
|
Printf(clos_class_defines, " 'direct-slots (list 'swig-this\n");
|
|
|
|
String *mangled_classname = Swig_name_mangle(Getattr(n, "sym:name"));
|
|
|
|
SwigType *ct = NewStringf("p.%s", Getattr(n, "name"));
|
|
swigtype_ptr = SwigType_manglestr(ct);
|
|
|
|
Printf(f_runtime, "static swig_chicken_clientdata _swig_chicken_clientdata%s = { 0 };\n",
|
|
mangled_classname);
|
|
Printv(f_init, "SWIG_TypeClientData(SWIGTYPE", swigtype_ptr,", (void *) &_swig_chicken_clientdata", mangled_classname, ");\n", NIL);
|
|
SwigType_remember(ct);
|
|
|
|
/* Emit all of the members */
|
|
|
|
in_class = 1;
|
|
Language::classHandler(n);
|
|
in_class = 0;
|
|
|
|
Printf(clos_class_defines, ")))\n\n");
|
|
|
|
if (have_constructor) {
|
|
Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n",
|
|
" (swig-initialize obj initargs ", NIL);
|
|
if (constructor_arg_types) {
|
|
String *initfunc_name = NewStringf("%s@@SWIG@initmethod", class_name);
|
|
String *func_call = buildClosFunctionCall(constructor_arg_types, initfunc_name, chickenPrimitiveName(constructor_name));
|
|
Printf(clos_methods, "%s)\n)\n", initfunc_name);
|
|
Printf(clos_methods, "(declare (hide %s))\n", initfunc_name);
|
|
Printf(clos_methods, "%s\n", func_call);
|
|
Delete(func_call);
|
|
Delete(initfunc_name);
|
|
Delete(constructor_arg_types);
|
|
constructor_arg_types = 0;
|
|
} else if (constructor_dispatch) {
|
|
Printf(clos_methods, "%s)\n)\n", constructor_dispatch);
|
|
Delete(constructor_dispatch);
|
|
constructor_dispatch = 0;
|
|
} else {
|
|
Printf(clos_methods, "%s)\n)\n", chickenPrimitiveName(constructor_name));
|
|
}
|
|
Delete(constructor_name);
|
|
constructor_name = 0;
|
|
} else {
|
|
Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n",
|
|
" (swig-initialize obj initargs (lambda x #f)))\n",
|
|
NIL);
|
|
}
|
|
|
|
/* export class initialization function */
|
|
if (clos) {
|
|
String *funcname = NewString(mangled_classname);
|
|
Printf(funcname, "_swig_chicken_setclosclass");
|
|
String *closfuncname = NewString(funcname);
|
|
Replaceall(closfuncname, "_", "-");
|
|
|
|
Printv(f_wrappers, "static void ", funcname, "(C_word,C_word,C_word,C_word) C_noret;\n",
|
|
"static void ", funcname, "(C_word argc, C_word closure, C_word continuation, C_word cl) {\n",
|
|
" C_trace(\"", funcname, "\");\n",
|
|
" if (argc!=3) C_bad_argc(argc,3);\n",
|
|
" swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) SWIGTYPE", swigtype_ptr,"->clientdata;\n",
|
|
" cdata->gc_proxy_create = CHICKEN_new_gc_root();\n",
|
|
" CHICKEN_gc_root_set(cdata->gc_proxy_create, cl);\n",
|
|
" C_kontinue(continuation, C_SCHEME_UNDEFINED);\n",
|
|
"}\n", NIL);
|
|
addMethod(closfuncname, funcname);
|
|
|
|
Printv(clos_methods, "(", chickenPrimitiveName(closfuncname), " (lambda (x) (make ", class_name, " 'swig-this x)))\n\n", NIL);
|
|
|
|
Delete(closfuncname);
|
|
Delete(funcname);
|
|
}
|
|
|
|
Delete(mangled_classname);
|
|
Delete(swigtype_ptr);
|
|
swigtype_ptr = 0;
|
|
|
|
Delete(class_name);
|
|
Delete(short_class_name);
|
|
class_name = 0;
|
|
short_class_name = 0;
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::memberfunctionHandler(Node *n)
|
|
{
|
|
String *iname = Getattr(n, "sym:name");
|
|
String *proc = NewString(iname);
|
|
Replaceall(proc, "_", "-");
|
|
|
|
member_name = chickenNameMapping(proc, short_class_name);
|
|
Language::memberfunctionHandler(n);
|
|
Delete(member_name);
|
|
member_name = NULL;
|
|
Delete(proc);
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::staticmemberfunctionHandler(Node *n)
|
|
{
|
|
String *iname = Getattr(n, "sym:name");
|
|
String *proc = NewString(iname);
|
|
Replaceall(proc, "_", "-");
|
|
|
|
member_name = NewStringf("%s-%s", short_class_name, proc);
|
|
Language::staticmemberfunctionHandler(n);
|
|
Delete(member_name);
|
|
member_name = NULL;
|
|
Delete(proc);
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::membervariableHandler(Node *n)
|
|
{
|
|
String *iname = Getattr(n,"sym:name");
|
|
//String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));
|
|
|
|
Language::membervariableHandler(n);
|
|
|
|
String *proc = NewString(iname);
|
|
Replaceall(proc,"_","-");
|
|
|
|
//Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab"));
|
|
Node *class_node = classLookup(Getattr(n, "type"));
|
|
|
|
String *getfunc = NewStringf("%s-%s-get", short_class_name, proc);
|
|
String *setfunc = NewStringf("%s-%s-set", short_class_name, proc);
|
|
|
|
Printv(clos_class_defines," (list '", proc, " ':swig-virtual ':swig-get ", chickenPrimitiveName(getfunc), NIL);
|
|
|
|
if (!Getattr(n,"feature:immutable")) {
|
|
if (class_node) {
|
|
Printv(clos_class_defines, " ':swig-set (lambda (x y) (", chickenPrimitiveName(setfunc), " x (slot-ref y 'swig-this))))\n", NIL);
|
|
} else {
|
|
Printv(clos_class_defines, " ':swig-set ", chickenPrimitiveName(setfunc), ")\n", NIL);
|
|
}
|
|
} else {
|
|
Printf(clos_class_defines, ")\n");
|
|
}
|
|
|
|
Delete(proc);
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::staticmembervariableHandler(Node *n)
|
|
{
|
|
String *iname = Getattr(n, "sym:name");
|
|
String *proc = NewString(iname);
|
|
Replaceall(proc, "_", "-");
|
|
|
|
member_name = NewStringf("%s-%s", short_class_name, proc);
|
|
Language::staticmembervariableHandler(n);
|
|
Delete(member_name);
|
|
member_name = NULL;
|
|
Delete(proc);
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::constructorHandler(Node *n)
|
|
{
|
|
have_constructor = 1;
|
|
has_constructor_args = 0;
|
|
|
|
|
|
exporting_constructor = true;
|
|
Language::constructorHandler(n);
|
|
exporting_constructor = false;
|
|
|
|
has_constructor_args = 1;
|
|
|
|
String *iname = Getattr(n,"sym:name");
|
|
constructor_name = Swig_name_construct(iname);
|
|
Replaceall(constructor_name, "_", "-");
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int CHICKEN::destructorHandler(Node *n) {
|
|
exporting_destructor = true;
|
|
Language::destructorHandler(n);
|
|
exporting_destructor = false;
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int CHICKEN::importDirective(Node *n) {
|
|
String *modname = Getattr(n, "module");
|
|
if (modname && clos_uses) {
|
|
|
|
// Find the module node for this imported module. It should be the
|
|
// first child but search just in case.
|
|
Node* mod = firstChild(n);
|
|
while (mod && Strcmp(nodeType(mod), "module") != 0)
|
|
mod = nextSibling(mod);
|
|
|
|
if (mod) {
|
|
String *name = Getattr(mod, "name");
|
|
if (name) {
|
|
Printf(closprefix, "(declare (uses %s))\n", name);
|
|
}
|
|
}
|
|
}
|
|
|
|
return Language::importDirective(n);
|
|
}
|
|
|
|
String *CHICKEN::buildClosFunctionCall(List *types, String_or_char *closname, String_or_char *funcname) {
|
|
String *method_signature = NewString("");
|
|
String *func_args = NewString("");
|
|
String *func_call = NewString("");
|
|
|
|
Iterator arg_type;
|
|
int arg_count = 0;
|
|
int optional_arguments = 0;
|
|
|
|
for (arg_type = First(types); arg_type.item; arg_type = Next(arg_type)) {
|
|
if (Strcmp(arg_type.item, "^^##optional$$") == 0) {
|
|
optional_arguments = 1;
|
|
} else {
|
|
Printf(method_signature, " (arg%i %s)", arg_count, arg_type.item);
|
|
arg_type = Next(arg_type);
|
|
if (!arg_type.item) break;
|
|
|
|
String *arg = NewStringf("arg%i", arg_count);
|
|
String *access_arg = Copy(arg_type.item);
|
|
|
|
Replaceall(access_arg, "$input", arg);
|
|
Printf(func_args, " %s", access_arg);
|
|
|
|
Delete(arg);
|
|
Delete(access_arg);
|
|
}
|
|
arg_count++;
|
|
}
|
|
|
|
if (optional_arguments) {
|
|
Printf(func_call, "(define-method (%s %s . args) (apply %s %s args))",
|
|
closname, method_signature, funcname, func_args);
|
|
} else {
|
|
Printf(func_call, "(define-method (%s %s) (%s %s))",
|
|
closname, method_signature, funcname, func_args);
|
|
}
|
|
|
|
Delete(method_signature);
|
|
Delete(func_args);
|
|
|
|
return func_call;
|
|
}
|
|
|
|
extern "C" {
|
|
|
|
/* compares based on non-primitive names */
|
|
static int compareTypeListsHelper(const DOH *a, const DOH *b, int opt_equal) {
|
|
List *la = (List *) a;
|
|
List *lb = (List *) b;
|
|
|
|
Iterator ia = First(la);
|
|
Iterator ib = First(lb);
|
|
|
|
while (ia.item && ib.item) {
|
|
int ret = Strcmp(ia.item, ib.item);
|
|
if (ret) return ret;
|
|
ia = Next(Next(ia));
|
|
ib = Next(Next(ib));
|
|
}
|
|
|
|
if (opt_equal && ia.item && Strcmp(ia.item, "^^##optional$$") == 0)
|
|
return 0;
|
|
if (ia.item)
|
|
return -1;
|
|
if (opt_equal && ib.item && Strcmp(ib.item, "^^##optional$$") == 0)
|
|
return 0;
|
|
if (ib.item)
|
|
return 1;
|
|
|
|
return 0;
|
|
}
|
|
|
|
static int compareTypeLists(const DOH *a, const DOH *b) {
|
|
return compareTypeListsHelper(a, b, 0);
|
|
}
|
|
}
|
|
|
|
void
|
|
CHICKEN::dispatchFunction(Node *n)
|
|
{
|
|
/* Last node in overloaded chain */
|
|
|
|
int maxargs;
|
|
String *tmp = NewString("");
|
|
String *dispatch =
|
|
Swig_overload_dispatch(n,"%s (2+$numargs,closure,"
|
|
"continuation$commaargs);", &maxargs);
|
|
|
|
/* Generate a dispatch wrapper for all overloaded functions */
|
|
|
|
Wrapper *f = NewWrapper();
|
|
String *iname = Getattr(n,"sym:name");
|
|
String *wname = NewString("");
|
|
String *scmname = NewString(iname);
|
|
Replaceall(scmname, "_", "-");
|
|
|
|
Append(wname, Swig_name_wrapper(iname));
|
|
|
|
Printv(f->def, "static void real_", wname,
|
|
"(C_word, C_word, C_word, C_word) C_noret;\n", NIL);
|
|
|
|
Printv(f->def,
|
|
"static void real_",
|
|
wname,
|
|
"(C_word oldargc, C_word closure, C_word continuation, C_word args) {",
|
|
NIL);
|
|
|
|
Wrapper_add_local(f,"argc","int argc");
|
|
Printf(tmp,"C_word argv[%d]", maxargs+1);
|
|
Wrapper_add_local(f,"argv",tmp);
|
|
Wrapper_add_local(f,"ii","int ii");
|
|
Wrapper_add_local(f,"t","C_word t = args");
|
|
Printf(f->code,"if (!C_swig_is_list (args)) {\n");
|
|
Printf(f->code," swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "
|
|
"\"Argument #1 must be a list of overloaded arguments\");\n");
|
|
Printf(f->code,"}\n");
|
|
Printf(f->code,"argc = C_unfix (C_i_length (args));\n");
|
|
Printf(f->code,"for (ii = 0; (ii < argc) && (ii < %d); ii++, t = C_block_item (t, 1)) {\n",maxargs);
|
|
Printf(f->code,"argv[ii] = C_block_item (t, 0);\n");
|
|
Printf(f->code,"}\n");
|
|
|
|
Printv(f->code,dispatch,"\n",NIL);
|
|
Printf(f->code,"swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE,"
|
|
"\"No matching function for overloaded '%s'\");\n", iname);
|
|
Printv(f->code,"}\n",NIL);
|
|
Wrapper_print(f,f_wrappers);
|
|
addMethod(scmname, wname);
|
|
|
|
DelWrapper(f);
|
|
f = NewWrapper();
|
|
|
|
/* varargs */
|
|
Printv(f->def, "void ", wname,
|
|
"(C_word, C_word, C_word, ...) C_noret;\n", NIL);
|
|
Printv(f->def, "void ", wname,
|
|
"(C_word c, C_word t0, C_word t1, ...) {",
|
|
NIL);
|
|
Printv(f->code,
|
|
"C_word t2;\n",
|
|
"va_list v;\n",
|
|
"C_word *a, c2 = c;\n",
|
|
"C_save_rest (t1, c2, 2);\n",
|
|
"a = C_alloc((c-2)*3);\n",
|
|
"t2 = C_restore_rest (a, C_rest_count (0));\n",
|
|
"real_", wname, " (3, t0, t1, t2);\n", NIL);
|
|
Printv(f->code,"}\n",NIL);
|
|
Wrapper_print(f,f_wrappers);
|
|
|
|
/* Now deal with overloaded function when exporting clos */
|
|
if (clos) {
|
|
List *flist = Getattr(overload_parameter_lists, scmname);
|
|
if (flist) {
|
|
Delattr(overload_parameter_lists, scmname);
|
|
|
|
SortList(flist, compareTypeLists);
|
|
|
|
String *clos_name;
|
|
int construct = 0;
|
|
if (have_constructor && !has_constructor_args) {
|
|
has_constructor_args = 1;
|
|
constructor_dispatch = NewStringf("%s@SWIG@new@dispatch", short_class_name);
|
|
clos_name = Copy(constructor_dispatch);
|
|
construct = 1;
|
|
Printf(clos_methods, "(declare (hide %s))\n", clos_name);
|
|
} else if (in_class)
|
|
clos_name = NewString(member_name);
|
|
else
|
|
clos_name = chickenNameMapping(scmname, (char *)"");
|
|
|
|
Iterator f;
|
|
List *prev = 0;
|
|
int all_primitive = 1;
|
|
|
|
/* first check for duplicates and an empty call */
|
|
String *newlist = NewList();
|
|
for (f = First(flist); f.item; f = Next(f)) {
|
|
/* check if cur is a duplicate of prev */
|
|
if (prev && compareTypeListsHelper(f.item, prev, 1) == 0) {
|
|
Delete(f.item);
|
|
} else {
|
|
Append(newlist, f.item);
|
|
prev = f.item;
|
|
Iterator j;
|
|
for (j = First(f.item); j.item; j = Next(j)) {
|
|
if (Strcmp(j.item, "^^##optional$$") != 0 && Strcmp(j.item, "<top>") != 0)
|
|
all_primitive = 0;
|
|
}
|
|
}
|
|
}
|
|
Delete(flist);
|
|
flist = newlist;
|
|
|
|
if (all_primitive) {
|
|
Printf(clos_methods, "(define %s %s)\n", clos_name, chickenPrimitiveName(scmname));
|
|
} else {
|
|
for (f = First(flist); f.item; f = Next(f)) {
|
|
/* now export clos code for argument */
|
|
String *func_call = buildClosFunctionCall(f.item, clos_name, chickenPrimitiveName(scmname));
|
|
Printf(clos_methods, "%s\n", func_call);
|
|
Delete(f.item);
|
|
Delete(func_call);
|
|
}
|
|
}
|
|
|
|
Delete(clos_name);
|
|
Delete(flist);
|
|
}
|
|
}
|
|
|
|
DelWrapper(f);
|
|
Delete(dispatch);
|
|
Delete(tmp);
|
|
Delete(wname);
|
|
}
|
|
|
|
int
|
|
CHICKEN::isPointer(SwigType *t)
|
|
{
|
|
return SwigType_ispointer(SwigType_typedef_resolve_all(t));
|
|
}
|
|
|
|
void
|
|
CHICKEN::addMethod(String *scheme_name, String *function)
|
|
{
|
|
String *sym = NewString("");
|
|
if (clos) {
|
|
Append(sym, "primitive:");
|
|
}
|
|
Append(sym, scheme_name);
|
|
|
|
/* add symbol to Chicken internal symbol table */
|
|
if (hide_primitive) {
|
|
Printv(f_init, "{\n",
|
|
" C_word *p0 = a;\n",
|
|
" *(a++)=C_CLOSURE_TYPE|1;\n",
|
|
" *(a++)=(C_word)", function, ";\n",
|
|
" C_mutate(return_vec++, (C_word)p0);\n",
|
|
"}\n", NIL);
|
|
} else {
|
|
Printf(f_sym_size, "+C_SIZEOF_INTERNED_SYMBOL(%d)", Len(sym));
|
|
Printf(f_init, "sym = C_intern (&a, %d, \"%s\");\n",
|
|
Len(sym), sym);
|
|
Printv(f_init,
|
|
"C_mutate ((C_word*)sym+1, (*a=C_CLOSURE_TYPE|1, a[1]=(C_word)",
|
|
function, ", tmp=(C_word)a, a+=2, tmp));\n", NIL);
|
|
}
|
|
|
|
if (hide_primitive) {
|
|
Setattr(primitive_names, scheme_name, NewStringf("(vector-ref swig-init-return %i)", num_methods));
|
|
} else {
|
|
Setattr(primitive_names, scheme_name, Copy(sym));
|
|
}
|
|
|
|
num_methods++;
|
|
|
|
Delete(sym);
|
|
}
|
|
|
|
String *
|
|
CHICKEN::chickenPrimitiveName(String *name) {
|
|
String *value = Getattr(primitive_names, name);
|
|
if (value)
|
|
return value;
|
|
else {
|
|
Swig_error(input_file, line_number, "Internal Error: attempting to reference non-existant primitive name %s\n", name);
|
|
return NewString("#f");
|
|
}
|
|
}
|
|
|
|
int
|
|
CHICKEN::validIdentifier(String *s)
|
|
{
|
|
char *c = Char(s);
|
|
/* Check whether we have an R5RS identifier.*/
|
|
/* <identifier> --> <initial> <subsequent>* | <peculiar identifier> */
|
|
/* <initial> --> <letter> | <special initial> */
|
|
if (!(isalpha(*c) || (*c == '!') || (*c == '$') || (*c == '%')
|
|
|| (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
|
|
|| (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
|
|
|| (*c == '^') || (*c == '_') || (*c == '~'))) {
|
|
/* <peculiar identifier> --> + | - | ... */
|
|
if ((strcmp(c, "+") == 0)
|
|
|| strcmp(c, "-") == 0
|
|
|| strcmp(c, "...") == 0) return 1;
|
|
else return 0;
|
|
}
|
|
/* <subsequent> --> <initial> | <digit> | <special subsequent> */
|
|
while (*c) {
|
|
if (!(isalnum(*c) || (*c == '!') || (*c == '$') || (*c == '%')
|
|
|| (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
|
|
|| (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
|
|
|| (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+')
|
|
|| (*c == '-') || (*c == '.') || (*c == '@'))) return 0;
|
|
c++;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
/* ------------------------------------------------------------
|
|
* closNameMapping()
|
|
* Maps the identifier from C++ to the CLOS based on command
|
|
* line paramaters and such.
|
|
* If class_name = "" that means the mapping is for a function or
|
|
* variable not attached to any class.
|
|
* ------------------------------------------------------------ */
|
|
String *CHICKEN::chickenNameMapping(String *name, String_or_char *class_name) {
|
|
String *n = NewString("");
|
|
|
|
if (Strcmp(class_name, "") == 0) {
|
|
// not part of a class, so no class name to prefix
|
|
if (clossymnameprefix) {
|
|
Printf(n, "%s%s", clossymnameprefix, name);
|
|
} else {
|
|
Printf(n, "%s", name);
|
|
}
|
|
} else {
|
|
if (useclassprefix) {
|
|
Printf(n, "%s-%s", class_name, name);
|
|
} else {
|
|
if (clossymnameprefix) {
|
|
Printf(n, "%s%s", clossymnameprefix, name);
|
|
} else {
|
|
Printf(n, "%s", name);
|
|
}
|
|
}
|
|
}
|
|
return n;
|
|
}
|
|
|
|
String *CHICKEN::runtimeCode() {
|
|
String *s = Swig_include_sys("chickenrun.swg");
|
|
if (!s) {
|
|
Printf(stderr, "*** Unable to open 'chickenrun.swg'\n");
|
|
s = NewString("");
|
|
}
|
|
return s;
|
|
}
|
|
|
|
String *CHICKEN::defaultExternalRuntimeFilename() {
|
|
return NewString("swigchickenrun.h");
|
|
}
|