6116a681bc
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@4426 626c5289-ae23-0410-ae9c-e8d60b6d4f22
2073 lines
55 KiB
C++
2073 lines
55 KiB
C++
/********************************************************************
|
|
* CHICKEN module for SWIG
|
|
*
|
|
* Author : Jonah Beckford
|
|
*
|
|
* 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"
|
|
|
|
#ifndef MACSWIG
|
|
#include "swigconfig.h"
|
|
#endif
|
|
|
|
#include <ctype.h>
|
|
|
|
static const char *chicken_usage = (char*)"\
|
|
\
|
|
CHICKEN Options (available with -chicken)\n\
|
|
-help - Print this help.\n\
|
|
-prefix name - Set a prefix to be prepended to all names.\n\
|
|
Defaults to the name of the module.\n\
|
|
-noprefix - Don't use a prefix.\n\
|
|
-mixed - Convert mixed case (ex. aMethodName) into \n\
|
|
dash seperated, lower case (ex. a-method-name).\n\
|
|
-noclos - Don't generate clos TinyCLOS code.\n\
|
|
-nogeneric - Don't generate (make-generic) definitions.\n\
|
|
-ldflags - Print runtime libraries to link with.\n\
|
|
\n"
|
|
;
|
|
|
|
#define SCMCLOS_MEMBER 0x2
|
|
#define SCMCLOS_STATIC_MEMBER 0x4
|
|
|
|
static String *prefix=0;
|
|
static int noprefix=0;
|
|
static String *module=0;
|
|
static char *chicken_path=(char*)"chicken";
|
|
static int clos = 1;
|
|
static int generic = 1;
|
|
static int mixed = 0;
|
|
static int num_methods = 0;
|
|
|
|
static File *f_runtime = 0;
|
|
static File *f_header = 0;
|
|
static File *f_wrappers = 0;
|
|
static File *f_init_helper = 0;
|
|
static File *f_sym_size = 0;
|
|
static File *f_init = 0;
|
|
static File *f_scm = 0;
|
|
static File *f_scm_stubs = 0;
|
|
static File *f_clos = 0;
|
|
static File *f_generic = 0;
|
|
|
|
static String *clos_indent = 0;
|
|
|
|
/* C++ Support + Clos Classes */
|
|
static int in_class = 0;
|
|
static int classic = 0;
|
|
static int have_constructor;
|
|
|
|
static String *class_name = 0;
|
|
static String *short_class_name = 0;
|
|
static String *real_classname;
|
|
|
|
static Hash *known_classes = 0;
|
|
|
|
class CHICKEN : public Language {
|
|
public:
|
|
|
|
virtual void main(int argc, char *argv[]);
|
|
virtual int top(Node *n);
|
|
virtual int importDirective(Node *n);
|
|
virtual int insertDirective(Node *n);
|
|
virtual int functionWrapper(Node *n);
|
|
/* ------------------------------------------------------------
|
|
* variableWrapper()
|
|
*
|
|
* Create a link to a C variable. This creates a single function
|
|
* _wrap_swig_var_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. Either way, we return the variables value.
|
|
* ------------------------------------------------------------ */
|
|
virtual int variableWrapper(Node *n);
|
|
virtual int constantWrapper(Node *n);
|
|
virtual int classDeclaration(Node *n);
|
|
virtual int classHandler(Node *n);
|
|
virtual int memberfunctionHandler(Node *n);
|
|
virtual int membervariableHandler(Node *n);
|
|
virtual int memberconstantHandler(Node *n);
|
|
virtual int staticmemberfunctionHandler(Node *n);
|
|
virtual int staticmembervariableHandler(Node *n);
|
|
virtual int destructorHandler(Node *n);
|
|
virtual int constructorHandler(Node *n);
|
|
virtual int validIdentifier(String *s);
|
|
|
|
protected:
|
|
void addMethod(String *, String *scheme_name, String *function);
|
|
void throwUnhandledChickenTypeError(SwigType *d);
|
|
/* Return true iff T is a pointer type */
|
|
int isPointer(SwigType *t);
|
|
void dispatchFunction(Node *n);
|
|
/* Output CHICKEN code into the clos file */
|
|
String* chickenCode(String *code, const String *indent);
|
|
void namify(String *scmname);
|
|
/* search for a typemap("TYPEMAP") SEARCHCLASS */
|
|
String* singleSearch(const char *typemap, char *argname,
|
|
SwigType *searchClass);
|
|
/* do a recursive search for a typemap("TYPEMAP") SEARCHCLASS.
|
|
example: typename can be "in" or "out"; argname can be "result"
|
|
for output typemaps or Getattr(parm, "name") for an input
|
|
parameter, and 'n' may be a class definition or anything else. */
|
|
String* recurseSearch(const char *typemap, char *argname, Node *n);
|
|
void selectOutOneOrMany(String *tm, int is_many);
|
|
};
|
|
|
|
/* -----------------------------------------------------------------------
|
|
* swig_chicken() - Instantiate module
|
|
* ----------------------------------------------------------------------- */
|
|
|
|
extern "C" Language *
|
|
swig_chicken(void) {
|
|
return new 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, stderr);
|
|
SWIG_exit(0);
|
|
}
|
|
else if (strcmp(argv[i], "-prefix") == 0) {
|
|
if (argv[i + 1]) {
|
|
prefix = NewString(argv [i + 1]);
|
|
Swig_mark_arg(i);
|
|
Swig_mark_arg(i + 1);
|
|
i++;
|
|
}
|
|
else {
|
|
Swig_arg_error();
|
|
}
|
|
}
|
|
else if (strcmp(argv[i],"-noprefix") == 0) {
|
|
noprefix = 1;
|
|
Swig_mark_arg(i);
|
|
}
|
|
else if (strcmp(argv[i],"-mixed") == 0) {
|
|
mixed = 1;
|
|
Swig_mark_arg(i);
|
|
}
|
|
else if (strcmp(argv[i],"-noclos") == 0) {
|
|
clos = 0;
|
|
Swig_mark_arg(i);
|
|
}
|
|
else if (strcmp(argv[i],"-nogeneric") == 0) {
|
|
generic = 0;
|
|
Swig_mark_arg(i);
|
|
}
|
|
else if (strcmp(argv[i], "-ldflags") == 0) {
|
|
printf("%s\n", SWIG_CHICKEN_RUNTIME);
|
|
SWIG_exit(EXIT_SUCCESS);
|
|
}
|
|
}
|
|
}
|
|
|
|
// 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)
|
|
{
|
|
if (!CPlusPlus) {
|
|
clos = 0;
|
|
generic = 0;
|
|
}
|
|
|
|
known_classes = NewHash();
|
|
|
|
/* Initialize all of the output files */
|
|
String *outfile = Getattr(n,"outfile");
|
|
|
|
f_runtime = NewFile(outfile,"w");
|
|
if (!f_runtime) {
|
|
Printf(stderr,"*** Can't open '%s'\n", outfile);
|
|
SWIG_exit(EXIT_FAILURE);
|
|
}
|
|
f_sym_size = NewString("");
|
|
f_init_helper = NewString("\n");
|
|
f_init = NewString("");
|
|
f_header = NewString("");
|
|
f_wrappers = NewString("");
|
|
|
|
/* 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_helper",f_init_helper);
|
|
Swig_register_filebyname("init",f_init);
|
|
|
|
Printf(f_runtime, "/* -*- buffer-read-only: t -*- vi: set ro: */\n");
|
|
Swig_banner(f_runtime);
|
|
|
|
if (NoInclude) {
|
|
Printf(f_runtime, "#define SWIG_NOINCLUDE\n");
|
|
}
|
|
|
|
/* Set module name */
|
|
module = Copy(Getattr(n,"name"));
|
|
|
|
/* Set prefix. If a prefix has been specified make sure it ends
|
|
in a '-' */
|
|
if (noprefix) {
|
|
prefix = NewString("");
|
|
}
|
|
else {
|
|
if (!prefix) {
|
|
prefix = Copy(module);
|
|
}
|
|
if (Len(prefix) && ((Char(prefix)) [Len(prefix) - 1] != ':')) {
|
|
Append(prefix, ":");
|
|
}
|
|
}
|
|
|
|
char filen[256];
|
|
|
|
sprintf(filen,"%s%s.scm", Swig_file_dirname(outfile), Char(module));
|
|
if ((f_scm = NewFile(filen,"w")) == 0) {
|
|
Printf(stderr,"Unable to open %s\n", filen);
|
|
SWIG_exit(EXIT_FAILURE);
|
|
}
|
|
f_scm_stubs = NewString("");
|
|
|
|
Swig_register_filebyname("chicken",f_scm);
|
|
|
|
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);
|
|
Printv(f_scm,"(cond-expand ((or chicken-compile-shared shared)) (else (declare (unit ", module, "))))\n\n", NIL);
|
|
#ifdef JONAH_IS_CRAZY
|
|
Printv(f_scm,"(declare \n",
|
|
tab4, "(foreign-declare \"void* ", module,
|
|
"_swig_get_type(char*);\"))\n", NIL);
|
|
#endif
|
|
#ifndef INIT_BINDING
|
|
Printv(f_scm,"(declare \n",
|
|
tab4, "(hide swig-init)\n",
|
|
tab4, "(foreign-declare \"C_extern void ", module,
|
|
"_swig_init(int,C_word,C_word) C_noret;\"))\n", NIL);
|
|
Printv(f_scm,"(define swig-init (##core#primitive \"", module,
|
|
"_swig_init\"))\n", NIL);
|
|
Printv(f_scm,"(swig-init)\n\n", NIL);
|
|
#endif
|
|
#ifdef JONAH_IS_CRAZY
|
|
Printv(f_scm,"(define-record swig-",prefix,"tag class name ptr str)\n",
|
|
"(define-record-printer (swig-",prefix,"tag tag out)\n",
|
|
tab4, "(fprintf out \"#<tag ~S>(~A)\" (swig-",prefix,
|
|
"tag-str tag)\n",
|
|
tab8, "(swig-",prefix,"tag-ptr tag)))\n", NIL);
|
|
#endif
|
|
|
|
// Include some information in the code
|
|
Printf(f_header,"\n/*-----------------------------------------------\n @(target):= %s.so\n\
|
|
------------------------------------------------*/\n", module);
|
|
|
|
|
|
if (generic) {
|
|
sprintf(filen,"%s%s_generic.scm", Swig_file_dirname(outfile),
|
|
Char(module));
|
|
if ((f_generic = NewFile(filen,"w")) == 0) {
|
|
Printf(stderr,"Unable to open %s\n", filen);
|
|
SWIG_exit (EXIT_FAILURE);
|
|
}
|
|
|
|
Swig_register_filebyname("generic",f_generic);
|
|
|
|
Printv(f_generic,
|
|
";; -*- 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 (clos) {
|
|
sprintf(filen,"%s%s_clos.scm", Swig_file_dirname(outfile),
|
|
Char(module));
|
|
if ((f_clos = NewFile(filen,"w")) == 0) {
|
|
Printf(stderr,"Unable to open %s\n", filen);
|
|
SWIG_exit (EXIT_FAILURE);
|
|
}
|
|
|
|
Swig_register_filebyname("clos",f_clos);
|
|
|
|
Printv(f_clos,
|
|
";; -*- 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);
|
|
Printf (f_clos, "(declare (uses extras))\n");
|
|
}
|
|
|
|
Printf(f_header,"#define SWIG_name \"%s\"\n", module);
|
|
|
|
Printf(f_wrappers,"#ifdef __cplusplus\n");
|
|
Printf(f_wrappers,"extern \"C\" {\n");
|
|
Printf(f_wrappers,"#endif\n\n");
|
|
|
|
#ifdef JONAH_IS_CRAZY
|
|
Printv(f_init_helper,
|
|
"#ifdef __cplusplus\n",
|
|
"extern \"C\"\n",
|
|
"#endif\n",
|
|
"SWIGEXPORT(void *) ", module, "_swig_get_type (char *type) {\n",
|
|
"int i;\n",
|
|
"for (i = 0; swig_types_initial[i]; i++) {\n",
|
|
"if (strcmp (type, swig_types[i]->name) == 0) ",
|
|
"return swig_types[i];\n",
|
|
"}\n",
|
|
"return NULL;\n",
|
|
"}\n\n",
|
|
NIL);
|
|
#endif
|
|
Printf(f_init_helper,
|
|
"static void swig_init_helper (C_word continuation) C_noret;\n");
|
|
Printf(f_init_helper,
|
|
"static void swig_init_helper (C_word continuation) {\n");
|
|
Printf(f_init_helper, "C_word sym;\n");
|
|
Printf(f_init_helper, "C_word tmp;\n");
|
|
Printf(f_init_helper, "C_word *a = C_alloc (2*$nummethods$symsize);\n");
|
|
|
|
#ifdef INIT_BINDING
|
|
{
|
|
String *tmp = NewString("");
|
|
String *tmp2 = NewString("swig-init");
|
|
Printv(tmp, module, "_swig_init", NIL);
|
|
addMethod(tmp, tmp2, tmp);
|
|
Delete(tmp);
|
|
Delete(tmp2);
|
|
}
|
|
#endif
|
|
|
|
/* emit code */
|
|
Language::top(n);
|
|
|
|
/* Close language module */
|
|
|
|
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_helper, "C_kontinue (continuation, C_SCHEME_TRUE);\n");
|
|
Printf(f_init_helper, "}\n");
|
|
char buftmp[20];
|
|
sprintf(buftmp, "%d", num_methods);
|
|
Replaceall(f_init_helper, "$nummethods", buftmp);
|
|
Replaceall(f_init_helper, "$symsize", f_sym_size);
|
|
|
|
Printv(f_scm, f_scm_stubs, "\n",NIL);
|
|
Close(f_scm);
|
|
Delete(f_scm);
|
|
|
|
if (clos) {
|
|
Close(f_clos);
|
|
Delete(f_clos);
|
|
}
|
|
|
|
if (generic) {
|
|
Close(f_generic);
|
|
Delete(f_generic);
|
|
}
|
|
|
|
Delete(prefix);
|
|
Delete(known_classes);
|
|
|
|
/* Close all of the files */
|
|
Dump(f_header,f_runtime);
|
|
Dump(f_wrappers,f_runtime);
|
|
Wrapper_pretty_print(f_init_helper,f_runtime);
|
|
Wrapper_pretty_print(f_init,f_runtime);
|
|
Delete(f_header);
|
|
Delete(f_wrappers);
|
|
Delete(f_sym_size);
|
|
Delete(f_init_helper);
|
|
Delete(f_init);
|
|
Close(f_runtime);
|
|
Delete(f_runtime);
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::importDirective(Node *n)
|
|
{
|
|
String *modname = Getattr(n,"module");
|
|
if (modname) {
|
|
Printf(f_scm,"(declare (uses %s))\n", modname);
|
|
}
|
|
return Language::importDirective(n);
|
|
}
|
|
|
|
int
|
|
CHICKEN::insertDirective(Node *n)
|
|
{
|
|
String *code = Getattr(n,"code");
|
|
Replaceall(code, "$module", module);
|
|
return Language::insertDirective(n);
|
|
}
|
|
|
|
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;
|
|
char source[64];
|
|
Wrapper *f;
|
|
String *mangle = NewString("");
|
|
String *known_alloca;
|
|
String *known_alloca_plus;
|
|
String *get_pointers;
|
|
String *cleanup;
|
|
String *outarg;
|
|
String *tm;
|
|
String *am;
|
|
String *overname = 0;
|
|
String *declfunc = 0;
|
|
String *scmname;
|
|
String *closparam;
|
|
String *closargs;
|
|
String *closwrapargs;
|
|
|
|
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("");
|
|
known_alloca = NewString("");
|
|
known_alloca_plus = NewString("");
|
|
get_pointers = NewString("");
|
|
cleanup = NewString("");
|
|
outarg = NewString("");
|
|
declfunc = NewString("");
|
|
closargs = NewString("");
|
|
closwrapargs = NewString("");
|
|
scmname = NewString(iname);
|
|
namify(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, module);
|
|
Append(wname, Swig_name_wrapper(iname));
|
|
if (overname) {
|
|
Append(wname, overname);
|
|
}
|
|
|
|
// Check for interrupts
|
|
Printv (f->code, "C_check_for_interrupt;\n",
|
|
"C_trace(\"",scmname,"\");\n", NIL);
|
|
|
|
Printv(f->def,
|
|
#ifndef BINDING
|
|
"static ",
|
|
#endif
|
|
"void ", wname,
|
|
" (int argc, C_word closure, C_word continuation",
|
|
NIL);
|
|
Printv(declfunc,
|
|
"void ", wname,
|
|
"(int,C_word,C_word",
|
|
NIL);
|
|
|
|
/* Calculate fixed alloca code */
|
|
int result_list_len = 0;
|
|
int has_void_return = 0;
|
|
int will_alloca = 0;
|
|
for (p = l; p;) {
|
|
if ((tm = Getattr(p,"tmap:argout:chicken_words"))) {
|
|
Replaceall(tm,"$typename", mangle);
|
|
if (strcmp(Char(tm), "void") == 0) continue;
|
|
if (strcmp(Char(tm), "0") != 0) will_alloca = 1;
|
|
if (result_list_len) {
|
|
Printf(known_alloca_plus, " + ");
|
|
} else {
|
|
Printf(known_alloca, "%s /*%s*/", tm, Getattr(p,"lname"));
|
|
}
|
|
Printf(known_alloca_plus, "3+%s /*%s*/", tm, Getattr(p,"lname"));
|
|
result_list_len++;
|
|
p = Getattr(p,"tmap:argout:next");
|
|
} else {
|
|
p = nextSibling(p);
|
|
}
|
|
}
|
|
if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
|
|
if ((am = Getattr(n,"tmap:out:chicken_words"))) {
|
|
Replaceall(am,"$typename", mangle);
|
|
if (strcmp(Char(am), "void") == 0) {
|
|
has_void_return = 1;
|
|
}
|
|
else {
|
|
if (strcmp(Char(am), "0") != 0) will_alloca = 1;
|
|
if (result_list_len) {
|
|
Printf(known_alloca_plus, " + ");
|
|
} else {
|
|
Printf(known_alloca, "%s /*result*/", am);
|
|
}
|
|
Printf(known_alloca_plus, "3+%s /*result*/", am);
|
|
result_list_len++;
|
|
}
|
|
}
|
|
}
|
|
|
|
/* Generate known_space code */
|
|
if (result_list_len > 1 || (will_alloca && result_list_len == 1)) {
|
|
if (result_list_len == 1) {
|
|
Wrapper_add_local(f,"known_space", "C_word *known_space");
|
|
Printf(f->code, " known_space = C_alloc (%s);\n",
|
|
known_alloca);
|
|
}
|
|
else {
|
|
Wrapper_add_local(f,"known_space", "C_word *known_space");
|
|
Printf(f->code, " /* allocate space for fixed-size scheme objects "
|
|
"used for output */\n");
|
|
Printf(f->code, " known_space = C_alloc (%s); "
|
|
"/* The '3' in 3+... is to alloc a C_pair "
|
|
"in the Scheme list 'resultobj' */ \n",
|
|
known_alloca_plus);
|
|
}
|
|
}
|
|
|
|
/* 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 *pn = Getattr(p,"name");
|
|
String *ln = Getattr(p,"lname");
|
|
SwigType *pb = SwigType_base(pt);
|
|
|
|
sprintf(source,"scm%d",i+1);
|
|
|
|
Printf(f->def, ", C_word scm%d", i+1);
|
|
Printf(declfunc,",C_word");
|
|
|
|
closparam = NewString("");
|
|
Printf(closparam, "%%%d", i+1);
|
|
Printv(closargs, " ", closparam, NIL);
|
|
|
|
/* Look for an clos input conversion */
|
|
int gotwrap = 0;
|
|
Node *search;
|
|
String *tm = 0;
|
|
if ((search = Getattr(known_classes, pb)) ||
|
|
(tm = singleSearch("clos_in", Char(pn), pb))) {
|
|
/* search for typemap("clos_in") CLASS_OR_BASE_CLASS */
|
|
if (tm || (tm = recurseSearch("clos_in", Char(pn), search))) {
|
|
String *cn = NewString("");
|
|
Printv(cn, "<", prefix, pb, ">", NIL);
|
|
namify(cn);
|
|
|
|
Replaceall(tm, "$class", cn);
|
|
Replaceall(tm, "$input", closparam);
|
|
|
|
Printv(closwrapargs, " ", tm, NIL);
|
|
|
|
gotwrap = 1;
|
|
Delete(cn);
|
|
}
|
|
else {
|
|
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
|
|
"Unable to find \"%%typemap(clos_in) %s *\" "
|
|
"or typemaps for any superclasses.\n",
|
|
SwigType_str(pb,0));
|
|
}
|
|
}
|
|
if (!gotwrap) {
|
|
Printv(closwrapargs, " ", closparam, NIL);
|
|
}
|
|
Delete(closparam);
|
|
|
|
/* 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)
|
|
Printv(get_pointers, "if (", source, ") {\n", NIL);
|
|
Printv(get_pointers,tm,"\n", NIL);
|
|
if (i >= num_required)
|
|
Printv(get_pointers, "}\n", NIL);
|
|
|
|
} 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;
|
|
}
|
|
p = nextSibling(p);
|
|
}
|
|
|
|
/* finish argument marshalling */
|
|
|
|
Printf(f->def, ") {");
|
|
Printf(declfunc, ")");
|
|
|
|
/* 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);
|
|
}
|
|
}
|
|
|
|
/* Want outputs done in reverse order */
|
|
List *l_out = NewList();
|
|
|
|
/* Return the function value */
|
|
if (has_void_return && result_list_len == 1) {
|
|
/* do absolutely nothing since result will be initted elsewhere
|
|
by one argout */
|
|
}
|
|
else if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
|
|
Replaceall(tm,"$source", "result");
|
|
Replaceall(tm,"$target", "resultobj");
|
|
Replaceall(tm,"$result", "resultobj");
|
|
if (Getattr(n,"feature:new")) {
|
|
Replaceall(tm,"$owner","1");
|
|
} else {
|
|
Replaceall(tm,"$owner","0");
|
|
}
|
|
selectOutOneOrMany(tm, result_list_len > 1);
|
|
Append(l_out, 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 argument output code */
|
|
for (p = l; p;) {
|
|
if ((tm = Getattr(p,"tmap:argout"))) {
|
|
Replaceall(tm,"$source",Getattr(p,"lname"));
|
|
Replaceall(tm,"$target","resultobj");
|
|
Replaceall(tm,"$arg",Getattr(p,"emit:input"));
|
|
Replaceall(tm,"$input",Getattr(p,"emit:input"));
|
|
selectOutOneOrMany(tm, result_list_len > 1);
|
|
Append(l_out, tm);
|
|
p = Getattr(p,"tmp:argout:next");
|
|
} else {
|
|
p = nextSibling(p);
|
|
}
|
|
}
|
|
|
|
/* Emit the function call */
|
|
emit_action(n,f);
|
|
|
|
/* Output argument output code */
|
|
int i_out;
|
|
if (result_list_len > 1) {
|
|
Printv(f->code, "resultobj = C_SCHEME_UNDEFINED;\n", NIL);
|
|
}
|
|
for (i_out = Len(l_out); i_out > 0; ) {
|
|
Printv(f->code, (String *) Getitem(l_out, --i_out), "\n", NIL);
|
|
}
|
|
|
|
/* Output cleanup code */
|
|
Printv(f->code,cleanup,NIL);
|
|
|
|
/* Look to see if there is any newfree cleanup code */
|
|
if (Getattr(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);
|
|
}
|
|
|
|
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,
|
|
#ifndef BINDING
|
|
"static ",
|
|
#endif
|
|
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")) {
|
|
addMethod(iname, scmname, wname);
|
|
|
|
/* Create a binding for this function */
|
|
#ifdef BINDING
|
|
Printv(f_scm, "(declare (foreign-declare \"C_extern ",
|
|
declfunc, " C_noret;\"))\n", NIL);
|
|
Printv(f_scm, "(define ", prefix, scmname,
|
|
" (##core#primitive \"", module, "_wrap_", iname,
|
|
"\"))\n\n", NIL);
|
|
#endif
|
|
}
|
|
else {
|
|
if (!Getattr(n,"sym:nextSibling")) {
|
|
dispatchFunction(n);
|
|
}
|
|
}
|
|
|
|
/* Look for typemap(clos_out) */
|
|
closparam = NewString("");
|
|
Printv(closparam, "(", prefix, scmname, closwrapargs, ")", NIL);
|
|
Node *search;
|
|
String *pb = SwigType_base(d);
|
|
tm = 0;
|
|
if ((search = Getattr(known_classes, pb)) ||
|
|
(tm = singleSearch("clos_out", Char(closparam), pb))) {
|
|
/* search for typemap("clos_out") CLASS_OR_BASE_CLASS */
|
|
if (tm || (tm = recurseSearch("clos_out", Char(closparam), search))) {
|
|
String *cn = NewString("");
|
|
Printv(cn, "<", prefix, pb, ">", NIL);
|
|
namify(cn);
|
|
|
|
Replaceall(tm, "$class", cn);
|
|
|
|
Delete(closparam);
|
|
Delete(cn);
|
|
|
|
closparam = Copy(tm);
|
|
}
|
|
else {
|
|
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
|
|
"Unable to find \"%%typemap(clos_out) %s *\" "
|
|
"or typemaps for any superclasses.\n",
|
|
SwigType_str(pb,0));
|
|
}
|
|
}
|
|
|
|
/* Dump clos code if enabled and not in a non-static member function */
|
|
if (!Getattr(n,"sym:overloaded")) {
|
|
if (clos &&
|
|
(!(clos & SCMCLOS_MEMBER) || (clos & SCMCLOS_STATIC_MEMBER))) {
|
|
Printv(f_clos, "(define (+", prefix, scmname, "+", closargs, ")\n",
|
|
tab4, closparam, ")\n", NIL);
|
|
}
|
|
}
|
|
Delete(closparam);
|
|
|
|
Delete(wname);
|
|
Delete(l_out);
|
|
Delete(known_alloca);
|
|
Delete(known_alloca_plus);
|
|
Delete(get_pointers);
|
|
Delete(cleanup);
|
|
Delete(outarg);
|
|
Delete(declfunc);
|
|
Delete(mangle);
|
|
Delete(closwrapargs);
|
|
Delete(closargs);
|
|
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");
|
|
SwigType *pb = SwigType_base(t);
|
|
ParmList *l = Getattr(n,"parms");
|
|
|
|
String *proc_name = NewString("");
|
|
char var_name[256];
|
|
String *wname = NewString("");
|
|
String *mangle = NewString("");
|
|
String *tm;
|
|
String *am;
|
|
String *tm2 = NewString("");;
|
|
String *argnum = NewString("0");
|
|
String *arg = NewString("argv[0]");
|
|
String *known_alloca = NewString("");
|
|
Wrapper *f;
|
|
String *overname = 0;
|
|
String *scmname;
|
|
String *closparam;
|
|
String *closargs;
|
|
String *closwrapargs;
|
|
|
|
int num_required;
|
|
int num_arguments;
|
|
|
|
scmname = NewString(iname);
|
|
namify(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, module);
|
|
Append(wname, Swig_name_wrapper(iname));
|
|
if (overname) {
|
|
Append(wname, overname);
|
|
}
|
|
|
|
strcpy(var_name, Char(Swig_name_wrapper(iname)));
|
|
|
|
// Build the name for scheme.
|
|
Printv(proc_name, iname,NIL);
|
|
namify(proc_name);
|
|
|
|
// Check for interrupts
|
|
Printv (f->code, "C_check_for_interrupt;\n",
|
|
"C_trace(\"",scmname,"\");\n", NIL);
|
|
|
|
closargs = NewString("");
|
|
closwrapargs = NewString("");
|
|
|
|
if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) {
|
|
|
|
closparam = NewString("(car %value)");
|
|
Printv(closargs, " . %value", NIL);
|
|
|
|
Printv(f->def,
|
|
#ifndef BINDING
|
|
"static ",
|
|
#endif
|
|
"void ",wname,"(int, C_word, C_word, C_word) C_noret;\n",
|
|
NIL);
|
|
Printv(f->def,
|
|
#ifndef BINDING
|
|
"static "
|
|
#endif
|
|
"void ",wname,"(int argc, C_word closure, "
|
|
"C_word continuation, C_word value) {\n",
|
|
NIL);
|
|
|
|
Wrapper_add_local(f, "resultobj", "C_word resultobj");
|
|
|
|
/* 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");
|
|
}
|
|
|
|
/* Look for an clos input conversion */
|
|
int gotwrap = 0;
|
|
Node *search;
|
|
String *tm = 0;
|
|
if ((search = Getattr(known_classes, pb)) ||
|
|
(tm = singleSearch("clos_in", Char(name), pb))) {
|
|
/* search for typemap("clos_in") CLASS_OR_BASE_CLASS */
|
|
if (tm || (tm = recurseSearch("clos_in", Char(name), search))) {
|
|
String *cn = NewString("");
|
|
Printv(cn, "<", prefix, pb, ">", NIL);
|
|
namify(cn);
|
|
|
|
Replaceall(tm, "$class", cn);
|
|
Replaceall(tm, "$input", closparam);
|
|
|
|
Printv(closwrapargs, " ", tm, NIL);
|
|
|
|
gotwrap = 1;
|
|
Delete(cn);
|
|
}
|
|
else {
|
|
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
|
|
"Unable to find \"%%typemap(clos_in) %s *\" "
|
|
"or typemaps for any superclasses.\n",
|
|
SwigType_str(pb,0));
|
|
}
|
|
}
|
|
if (!gotwrap) {
|
|
Printv(closwrapargs, " ", closparam, NIL);
|
|
}
|
|
Delete(closparam);
|
|
|
|
// Now return the value of the variable - regardless
|
|
// of evaluating or setting.
|
|
if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
|
|
/* Calculate fixed alloca code */
|
|
if ((am = Getattr(n,"tmap:varout:chicken_words"))) {
|
|
Replaceall(am,"$typename", mangle);
|
|
if (strcmp(Char(am), "0") != 0) {
|
|
Wrapper_add_local(f,"known_space", "C_word *known_space");
|
|
|
|
Printf(f->code,
|
|
" known_space = C_alloc (%s);\n",
|
|
am);
|
|
}
|
|
}
|
|
|
|
selectOutOneOrMany(tm, 0);
|
|
Replaceall(tm,"$source",name);
|
|
Replaceall(tm,"$varname",name);
|
|
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,
|
|
"Can't find varout with type %s\n", SwigType_str(t,0));
|
|
}
|
|
Printf(f->code,"\nC_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(iname, scmname, wname);
|
|
|
|
/* Look for typemap(clos_out) */
|
|
closparam = NewString("");
|
|
Printv(closparam, "(if (= (length %value) 0)\n",
|
|
tab4, "(", prefix, scmname, ")\n",
|
|
tab4, "(", prefix, scmname, closwrapargs, "))", NIL);
|
|
tm = 0;
|
|
if ((search = Getattr(known_classes, pb)) ||
|
|
(tm = singleSearch("clos_out", Char(closparam), pb))) {
|
|
/* search for typemap("clos_out") CLASS_OR_BASE_CLASS */
|
|
if (tm || (tm = recurseSearch("clos_out",
|
|
Char(closparam), search))) {
|
|
String *cn = NewString("");
|
|
Printv(cn, "<", prefix, pb, ">", NIL);
|
|
namify(cn);
|
|
|
|
Replaceall(tm, "$class", cn);
|
|
|
|
Delete(closparam);
|
|
Delete(cn);
|
|
|
|
closparam = Copy(tm);
|
|
}
|
|
else {
|
|
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
|
|
"Unable to find \"%%typemap(clos_out) %s *\" "
|
|
"or typemaps for any superclasses.\n",
|
|
SwigType_str(pb,0));
|
|
}
|
|
}
|
|
|
|
/* Create a binding for this variable */
|
|
#ifdef BINDING
|
|
Printv(f_scm, "(declare (foreign-declare \"C_extern ",
|
|
wname, "(int,C_word,C_word,C_word)"
|
|
" C_noret;\"))\n", NIL);
|
|
Printv(f_scm, "(define ", prefix, scmname,
|
|
" (##core#primitive \"", module, "_wrap_", iname,
|
|
"\"))\n\n", NIL);
|
|
#endif
|
|
|
|
/* Create a clos for this variable (if enabled and not in a
|
|
non-static member variable) */
|
|
if (clos &&
|
|
(!(clos & SCMCLOS_MEMBER) || (clos & SCMCLOS_STATIC_MEMBER))) {
|
|
Printv(f_clos, "(define (+", prefix, scmname, "+", closargs, ")\n",
|
|
tab4, closparam, ")\n", NIL);
|
|
}
|
|
Delete(closparam);
|
|
} else {
|
|
Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
|
|
"Unsupported variable type %s (ignored).\n",
|
|
SwigType_str(t,0));
|
|
}
|
|
|
|
Delete(wname);
|
|
Delete(known_alloca);
|
|
Delete(proc_name);
|
|
Delete(argnum);
|
|
Delete(arg);
|
|
Delete(tm2);
|
|
Delete(mangle);
|
|
Delete(closwrapargs);
|
|
Delete(closargs);
|
|
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 *am;
|
|
String *tm2 = NewString("");
|
|
String *source = NewString("");
|
|
String *argnum = NewString("0");
|
|
String *arg = NewString("argv[0]");
|
|
String *known_alloca = NewString("");
|
|
Wrapper *f;
|
|
String *overname = 0;
|
|
String *scmname;
|
|
|
|
int num_required;
|
|
int num_arguments;
|
|
|
|
scmname = NewString(iname);
|
|
namify(scmname);
|
|
|
|
Printf(mangle, "\"%s\"", SwigType_manglestr(t));
|
|
Printf(source, "swig_const_%s", name);
|
|
Replaceall(source, "::", "__");
|
|
|
|
if (Getattr(n,"sym:overloaded")) {
|
|
overname = Getattr(n,"sym:overname");
|
|
} else {
|
|
if (!addSymbol(iname,n)) return SWIG_ERROR;
|
|
}
|
|
|
|
Append(wname, module);
|
|
Append(wname, Swig_name_wrapper(iname));
|
|
if (overname) {
|
|
Append(wname, overname);
|
|
}
|
|
|
|
/* Special hook for member pointer */
|
|
if (SwigType_type(t) == T_MPOINTER) {
|
|
Printf(f_header, "static %s = %s;\n", SwigType_str(t,wname), value);
|
|
value = wname;
|
|
}
|
|
if ((tm = Swig_typemap_lookup_new("constcode", n, name, 0))) {
|
|
Replaceall(tm,"$source",value);
|
|
Replaceall(tm,"$target",source);
|
|
Replaceall(tm,"$result",source);
|
|
Replaceall(tm,"$value",value);
|
|
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)));
|
|
|
|
// Build the name for scheme.
|
|
Printv(proc_name, iname,NIL);
|
|
namify(proc_name);
|
|
|
|
// Check for interrupts
|
|
Printv (f->code, "C_check_for_interrupt;\n",
|
|
"C_trace(\"",scmname,"\");\n", NIL);
|
|
|
|
if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) {
|
|
|
|
Printv(f->def,
|
|
#ifndef BINDING
|
|
"static ",
|
|
#endif
|
|
"void ",wname,"(int, C_word, C_word) C_noret;\n",
|
|
NIL);
|
|
|
|
Printv(f->def,
|
|
#ifndef BINDING
|
|
"static ",
|
|
#endif
|
|
"void ",wname,"(int argc, C_word closure, "
|
|
"C_word continuation) {\n",
|
|
NIL);
|
|
|
|
Wrapper_add_local(f, "resultobj", "C_word resultobj");
|
|
|
|
// Return the value of the variable
|
|
if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
|
|
/* Calculate fixed alloca code */
|
|
if ((am = Getattr(n,"tmap:varout:chicken_words"))) {
|
|
Replaceall(am,"$typename", mangle);
|
|
if (strcmp(Char(am), "0") != 0) {
|
|
Wrapper_add_local(f,"known_space", "C_word *known_space");
|
|
|
|
Printf(f->code,
|
|
" known_space = C_alloc (%s);\n",
|
|
am);
|
|
}
|
|
}
|
|
|
|
selectOutOneOrMany(tm, 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,
|
|
"Can't find varout with type %s\n", SwigType_str(t,0));
|
|
}
|
|
Printf(f->code,"\nC_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(iname, scmname, wname);
|
|
|
|
/* Create a binding for this variable */
|
|
#ifdef BINDING
|
|
Printv(f_scm, "(declare (foreign-declare \"C_extern ",
|
|
wname, "(int argc, C_word closure, C_word continuation, "
|
|
"C_word value)"
|
|
" C_noret;\"))\n", NIL);
|
|
Printv(f_scm, "(define ", prefix, scmname,
|
|
" (##core#primitive \"", module, "_wrap_", iname,
|
|
"\"))\n\n", NIL);
|
|
#endif
|
|
|
|
} else {
|
|
Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
|
|
"Unsupported variable type %s (ignored).\n",
|
|
SwigType_str(t,0));
|
|
}
|
|
|
|
Delete(wname);
|
|
Delete(known_alloca);
|
|
Delete(proc_name);
|
|
Delete(argnum);
|
|
Delete(arg);
|
|
Delete(tm2);
|
|
Delete(mangle);
|
|
Delete(source);
|
|
DelWrapper(f);
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::classDeclaration(Node *n)
|
|
{
|
|
String *importname;
|
|
Node *mod;
|
|
if (clos) {
|
|
mod = Getattr(n,"module");
|
|
if (mod) {
|
|
String *iname = Getattr(n, "sym:name");
|
|
importname = NewString(prefix);
|
|
Printv(importname, iname, NIL);
|
|
Setattr(n,"chicken:proxy",importname);
|
|
Setattr(known_classes, iname, n);
|
|
}
|
|
}
|
|
return Language::classDeclaration(n);
|
|
}
|
|
|
|
int
|
|
CHICKEN::classHandler(Node *n)
|
|
{
|
|
int oldclassic = classic;
|
|
|
|
/* Create new strings for building up a wrapper function */
|
|
have_constructor = 0;
|
|
|
|
if (Getattr(n,"cplus:exceptionclass")) {
|
|
classic = 1;
|
|
}
|
|
|
|
clos_indent = (String *) tab4;
|
|
|
|
class_name = NewString("");
|
|
short_class_name = NewString("");
|
|
Printv(class_name, "<", prefix, Getattr(n,"sym:name"), ">", NIL);
|
|
namify(class_name);
|
|
Printv(short_class_name, Getattr(n,"sym:name"), NIL);
|
|
namify(short_class_name);
|
|
real_classname = Getattr(n,"name");
|
|
|
|
if (!addSymbol(class_name,n)) return SWIG_ERROR;
|
|
|
|
#ifdef JONAH_IS_CRAZY
|
|
Printv(f_scm,"(set! swig-",prefix,"tag:",Getattr(n,"sym:name"),"\n",
|
|
tab4,"(make-swig-",prefix,"tag ",
|
|
"1000 \"_p_",Getattr(n,"sym:name"),"\"\n",
|
|
tab8,"((foreign-lambda* c-pointer ()\n",
|
|
tab8, tab4, "\"return (",module,
|
|
"_swig_get_type (\\\"_p_",Getattr(n,"sym:name"),"\\\"));\"))\n",
|
|
tab8, "\"",Getattr(n,"sym:name")," *\"))\n", NIL);
|
|
#endif
|
|
|
|
if (clos) {
|
|
|
|
/* Handle inheritance */
|
|
String *base_class = NewString("<");
|
|
List *baselist = Getattr(n,"bases");
|
|
if (baselist && Len(baselist)) {
|
|
Node *base = Firstitem(baselist);
|
|
while (base) {
|
|
String *bname = Copy(Getattr(base, "chicken:proxy"));
|
|
if (!bname) {
|
|
base = Nextitem(baselist);
|
|
continue;
|
|
}
|
|
namify(bname);
|
|
Printv(base_class,bname,NIL);
|
|
Delete(bname);
|
|
base = Nextitem(baselist);
|
|
if (base) {
|
|
Printf(base_class, "> <");
|
|
}
|
|
}
|
|
}
|
|
Printf(base_class, ">");
|
|
|
|
Printv(f_clos,"\n(define-class ", class_name, " ", NIL);
|
|
|
|
if (Len(base_class) > 2) {
|
|
Printv(f_clos,"(", base_class, ") ())\n", NIL);
|
|
} else {
|
|
Printv(f_clos,"(<object>) (this))\n", NIL);
|
|
}
|
|
|
|
}
|
|
|
|
/* Emit all of the members */
|
|
|
|
in_class = 1;
|
|
Language::classHandler(n);
|
|
in_class = 0;
|
|
|
|
if (clos) {
|
|
char apply[] = "apply ";
|
|
|
|
if (have_constructor) {
|
|
Printv(f_clos, "(define-method (initialize (obj ", class_name,
|
|
") initargs)\n",
|
|
tab4, "(call-next-method)\n",
|
|
tab4, "(if (and (list? initargs) (= (length initargs) 2) (eq? (car initargs) (quote this)))\n",
|
|
tab8, "(slot-set! obj (quote this) (cadr initargs))\n",
|
|
tab8, "(begin\n",
|
|
tab8, tab4, "(slot-set! obj (quote this) (", apply, prefix, "new-", short_class_name, "\n",
|
|
tab8, tab8, " (map (lambda (arg) (if (instance? arg) (slot-ref arg (quote this)) arg)) initargs)))\n",
|
|
tab8, tab4, "(set-finalizer! obj\n",
|
|
tab8, tab8, "(lambda (deadobj) (", prefix, "delete-", short_class_name,
|
|
" (slot-ref deadobj (quote this))))))))\n",
|
|
NIL);
|
|
}
|
|
else {
|
|
Printv(f_clos, "(define-method (initialize (obj ", class_name,
|
|
") initargs)\n",
|
|
tab4, "(call-next-method)\n",
|
|
tab4, "(if (and (list? initargs) (= (length initargs) 2) (eq? (car initargs) (quote this)))\n",
|
|
tab8, "(slot-set! obj (quote this) (cadr initargs))\n",
|
|
tab8, "(slot-set! obj (quote this) #f)))\n",
|
|
NIL);
|
|
}
|
|
}
|
|
|
|
Delete(class_name);
|
|
Delete(short_class_name);
|
|
class_name = 0;
|
|
short_class_name = 0;
|
|
|
|
classic = oldclassic;
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::memberfunctionHandler(Node *n)
|
|
{
|
|
String *iname = Getattr(n,"sym:name");
|
|
SwigType *d = Getattr(n,"type");
|
|
ParmList *l = Getattr(n,"parms");
|
|
int oldclos;
|
|
String *scmname;
|
|
String *args;
|
|
String *wrapargs;
|
|
String *closparam;
|
|
int i;
|
|
Parm *p;
|
|
String *tm;
|
|
|
|
scmname = NewString(iname);
|
|
namify(scmname);
|
|
|
|
/* input arguments */
|
|
args = NewString("");
|
|
wrapargs = NewString("");
|
|
for (i=0, p=l; p; i++) {
|
|
while (checkAttribute(p,"tmap:in:numinputs","0")) {
|
|
p = Getattr(p,"tmap:in:next");
|
|
}
|
|
|
|
SwigType *pt = Getattr(p,"type");
|
|
String *pn = Getattr(p,"name");
|
|
SwigType *pb = SwigType_base(pt);
|
|
|
|
if (strcmp("void", Char(pt)) != 0) {
|
|
String *arg = NewString("");
|
|
|
|
/* make name of argument */
|
|
if (pn && Len(pn)) {
|
|
Printf(arg, "%%%s", pn);
|
|
}
|
|
else {
|
|
Printf(arg, "%%%d", i+1);
|
|
}
|
|
|
|
Printv(args, " ", arg, NIL);
|
|
|
|
/* do input conversion */
|
|
int gotwrap = 0;
|
|
Node *search;
|
|
String *tm = 0;
|
|
if ((search = Getattr(known_classes, pb)) ||
|
|
(tm = singleSearch("clos_in", Char(pn), pb))) {
|
|
/* search for typemap("clos_in") CLASS_OR_BASE_CLASS */
|
|
if (tm || (tm = recurseSearch("clos_in", Char(pn), search))) {
|
|
String *cn = NewString("");
|
|
Printv(cn, "<", prefix, pb, ">", NIL);
|
|
namify(cn);
|
|
|
|
Replaceall(tm, "$class", cn);
|
|
Replaceall(tm, "$input", arg);
|
|
|
|
Printv(wrapargs, " ", tm, NIL);
|
|
|
|
gotwrap = 1;
|
|
Delete(cn);
|
|
}
|
|
else {
|
|
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
|
|
"Unable to find \"%%typemap(clos_in) %s *\" "
|
|
"or typemaps for any superclasses.\n",
|
|
SwigType_str(pb,0));
|
|
}
|
|
}
|
|
if (!gotwrap) {
|
|
Printv(wrapargs, " ", arg, NIL);
|
|
}
|
|
|
|
Delete(arg);
|
|
}
|
|
|
|
p = nextSibling(p);
|
|
}
|
|
|
|
/* Create the default member function */
|
|
oldclos = clos; /* Disable clos'ing when wrapping member
|
|
functions */
|
|
if (clos) clos = clos | SCMCLOS_MEMBER;
|
|
Language::memberfunctionHandler(n);
|
|
clos = oldclos;
|
|
|
|
/* return value */
|
|
closparam = NewString("");
|
|
if (Getattr(n,"sym:overloaded")) {
|
|
Printv(closparam, "(apply ", prefix, short_class_name, "-", scmname, "\n",
|
|
tab8, "(cons (slot-ref obj (quote this))\n",
|
|
tab8, tab4, "(map (lambda (arg) (if (instance? arg) (slot-ref arg (quote this)) arg)) args)))", NIL);
|
|
}
|
|
else {
|
|
Printv(closparam, "(", prefix, short_class_name, "-", scmname,
|
|
" (slot-ref obj (quote this))", wrapargs, ")", NIL);
|
|
}
|
|
Node *search;
|
|
String *pb = SwigType_base(d);
|
|
tm = 0;
|
|
if ((search = Getattr(known_classes, pb)) ||
|
|
(tm = singleSearch("clos_out", Char(closparam), pb))) {
|
|
/* search for typemap("clos_out") CLASS_OR_BASE_CLASS */
|
|
if (tm || (tm = recurseSearch("clos_out", Char(closparam), search))) {
|
|
String *cn = NewString("");
|
|
Printv(cn, "<", prefix, pb, ">", NIL);
|
|
namify(cn);
|
|
|
|
Replaceall(tm, "$class", cn);
|
|
|
|
Delete(closparam);
|
|
Delete(cn);
|
|
|
|
closparam = Copy(tm);
|
|
}
|
|
else {
|
|
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
|
|
"Unable to find \"%%typemap(clos_out) %s *\" "
|
|
"or typemaps for any superclasses.\n",
|
|
SwigType_str(pb,0));
|
|
}
|
|
}
|
|
|
|
/* print */
|
|
if (!Getattr(n,"sym:nextSibling")) {
|
|
if (clos) {
|
|
if (Getattr(n,"feature:clos")) {
|
|
String *scmcode = chickenCode(Getattr(n,"feature:clos"),tab4);
|
|
Printv(f_clos,scmcode,"\n",NIL);
|
|
}
|
|
else if (Getattr(n,"sym:overloaded")) {
|
|
Printv(f_clos, "(define-method (-", iname,
|
|
"- (obj ", class_name, ") . args)\n",
|
|
tab4, closparam, ")\n", NIL);
|
|
}
|
|
else {
|
|
Printv(f_clos, "(define-method (-", iname,
|
|
"- (obj ", class_name, ")", args, ")\n",
|
|
tab4, closparam, ")\n", NIL);
|
|
}
|
|
}
|
|
if (generic) {
|
|
Printv(f_generic, "(define -", iname,
|
|
"- (make-generic \"", iname, "\")) ;; class ",
|
|
class_name, "\n", NIL);
|
|
}
|
|
}
|
|
|
|
Delete(closparam);
|
|
Delete(wrapargs);
|
|
Delete(args);
|
|
Delete(scmname);
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::membervariableHandler(Node *n)
|
|
{
|
|
String *iname = Getattr(n,"sym:name");
|
|
|
|
int oldclos = clos;
|
|
if (clos) clos = clos | SCMCLOS_MEMBER;
|
|
Language::membervariableHandler(n);
|
|
clos = oldclos;
|
|
|
|
if (clos) {
|
|
int immutable = 0;
|
|
if (!Getattr(n,"feature:immutable")) {
|
|
Printv(f_clos, "(define-method (-set-", iname,
|
|
"!- (obj ", class_name, ") %value)\n",
|
|
tab4, "(", prefix, real_classname, "-", iname,
|
|
"-set (slot-ref obj (quote this)) %value))\n", NIL);
|
|
if (generic) {
|
|
Printv(f_generic, "(define -set-", iname,
|
|
"!- (make-generic \"set-", iname, "!\")) ;; class ",
|
|
class_name, "\n", NIL);
|
|
}
|
|
} else {
|
|
immutable = 1;
|
|
}
|
|
Printv(f_clos, "(define-method (-get-", iname,
|
|
"- (obj ", class_name, "))\n",
|
|
tab4, "(", prefix, real_classname, "-", iname,
|
|
"-get (slot-ref obj (quote this))))\n", NIL);
|
|
if (generic) {
|
|
Printv(f_generic, "(define -get-", iname,
|
|
"- (make-generic \"get-", iname, "\")) ;; class ",
|
|
class_name, "\n", NIL);
|
|
}
|
|
}
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::memberconstantHandler(Node *n)
|
|
{
|
|
int oldclos = clos;
|
|
if (clos) clos = clos | SCMCLOS_MEMBER;
|
|
Language::memberconstantHandler(n);
|
|
clos = oldclos;
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::staticmemberfunctionHandler(Node *n)
|
|
{
|
|
int oldclos = clos;
|
|
if (clos) clos = clos | SCMCLOS_STATIC_MEMBER;
|
|
Language::staticmemberfunctionHandler(n);
|
|
clos = oldclos;
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::staticmembervariableHandler(Node *n)
|
|
{
|
|
int oldclos = clos;
|
|
if (clos) clos = clos | SCMCLOS_STATIC_MEMBER;
|
|
Language::staticmembervariableHandler(n);
|
|
clos = oldclos;
|
|
|
|
return SWIG_OK;
|
|
|
|
}
|
|
|
|
int
|
|
CHICKEN::destructorHandler(Node *n)
|
|
{
|
|
int oldclos = clos;
|
|
|
|
if (clos) clos = clos | SCMCLOS_MEMBER;
|
|
Language::destructorHandler(n);
|
|
clos = oldclos;
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int
|
|
CHICKEN::constructorHandler(Node *n)
|
|
{
|
|
int oldclos = clos;
|
|
|
|
if (clos) clos = clos | SCMCLOS_MEMBER;
|
|
Language::constructorHandler(n);
|
|
clos = oldclos;
|
|
|
|
if (clos) {
|
|
have_constructor = 1;
|
|
}
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
void
|
|
CHICKEN::dispatchFunction(Node *n)
|
|
{
|
|
/* Last node in overloaded chain */
|
|
|
|
int maxargs;
|
|
String *tmp = NewString("");
|
|
String *dispatch =
|
|
Swig_overload_dispatch(n,"%s (2+argc,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);
|
|
|
|
namify(scmname);
|
|
Append(wname, module);
|
|
Append(wname, Swig_name_wrapper(iname));
|
|
|
|
#ifndef BINDING
|
|
Printv(f->def, "static void real_", wname,
|
|
"(int, C_word, C_word, C_word) C_noret;\n", NIL);
|
|
#endif
|
|
|
|
Printv(f->def,
|
|
#ifdef BINDING
|
|
"void ",
|
|
#else
|
|
"static void real_",
|
|
#endif
|
|
wname,
|
|
"(int, 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(iname,scmname, wname);
|
|
|
|
/* Create a binding for this function */
|
|
#ifdef BINDING
|
|
Printv(f_scm, "(declare (foreign-declare \"C_extern ",
|
|
module, wname, "(int, C_word, C_word, C_word) C_noret;\"))\n", NIL);
|
|
Printv(f_scm, "(define swig-", prefix, scmname,
|
|
"-prim (##core#primitive \"", module, "_wrap_", iname,
|
|
"\"))\n", NIL);
|
|
Printv(f_scm, "(define (", prefix, scmname,
|
|
" . args) (swig-", prefix, scmname, "-prim args))\n\n", NIL);
|
|
#else
|
|
|
|
DelWrapper(f);
|
|
f = NewWrapper();
|
|
|
|
/* varargs */
|
|
Printv(f->def, "void ", wname,
|
|
"(int, C_word, C_word, ...) C_noret;\n", NIL);
|
|
Printv(f->def, "void ", wname,
|
|
"(int 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",
|
|
"C_check_for_interrupt;\n",
|
|
"if (!C_demand (c*C_SIZEOF_PAIR+0)) {\n",
|
|
"C_save_and_reclaim((void*)swig_tr2r, (void*)real_", wname, ", 2, t0, t1);\n",
|
|
"}\n",
|
|
"else {\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",
|
|
"}\n", NIL);
|
|
Printv(f->code,"}\n",NIL);
|
|
Wrapper_print(f,f_wrappers);
|
|
#endif
|
|
|
|
/* Create a clos for this function (if enabled and not in a
|
|
non-static member function) */
|
|
if (clos &&
|
|
(!(clos & SCMCLOS_MEMBER) || (clos & SCMCLOS_STATIC_MEMBER))) {
|
|
Printv(f_clos, "(define (+", prefix, scmname, "+ . args)\n",
|
|
tab4, "(apply ", prefix, scmname, " args))\n", NIL);
|
|
}
|
|
DelWrapper(f);
|
|
Delete(dispatch);
|
|
Delete(tmp);
|
|
Delete(wname);
|
|
}
|
|
|
|
void
|
|
CHICKEN::throwUnhandledChickenTypeError(SwigType *d)
|
|
{
|
|
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
|
|
"Unable to handle type %s.\n", SwigType_str(d,0));
|
|
}
|
|
|
|
int
|
|
CHICKEN::isPointer(SwigType *t)
|
|
{
|
|
return SwigType_ispointer(SwigType_typedef_resolve_all(t));
|
|
}
|
|
|
|
void
|
|
CHICKEN::addMethod(String *, String *scheme_name, String *function)
|
|
{
|
|
#ifndef BINDING
|
|
/* unless Chicken is run in case-sensitive mode, all symbols need
|
|
to be lowercase. Also, the symbols need the prefix. */
|
|
String *sym = NewString(prefix);
|
|
Append(sym, scheme_name);
|
|
char *s = Char(sym);
|
|
const int L = Len(sym);
|
|
for (int i=0; i < L; i++, s++) {
|
|
*s = tolower(*s);
|
|
}
|
|
|
|
/* add symbol to Chicken internal symbol table */
|
|
Printf(f_sym_size, "+C_SIZEOF_INTERNED_SYMBOL(%d)", Len(sym));
|
|
Printf(f_init_helper, "sym = C_intern (&a, %d, \"%s\");\n",
|
|
Len(sym), sym);
|
|
Printv(f_init_helper,
|
|
"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);
|
|
num_methods++;
|
|
Delete(sym);
|
|
#endif
|
|
}
|
|
|
|
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;
|
|
}
|
|
|
|
String *
|
|
CHICKEN::chickenCode(String *code, const String *indent) {
|
|
String *out = NewString("");
|
|
String *temp;
|
|
if (!indent) indent = "";
|
|
|
|
temp = NewString(code);
|
|
|
|
/* Split the input text into lines */
|
|
List *clist = DohSplit(temp,'\n',-1);
|
|
Delete(temp);
|
|
int initial = 0;
|
|
String *s;
|
|
|
|
/* Get the initial indentation */
|
|
for (s = Firstitem(clist); s; s = Nextitem(clist)) {
|
|
if (Len(s)) {
|
|
char *c = Char(s);
|
|
while (*c) {
|
|
if (!isspace(*c)) break;
|
|
initial++;
|
|
c++;
|
|
}
|
|
if (*c && !isspace(*c)) break;
|
|
else {
|
|
initial = 0;
|
|
}
|
|
}
|
|
}
|
|
while (s) {
|
|
if (Len(s) > initial) {
|
|
char *c = Char(s);
|
|
c += initial;
|
|
Printv(out,indent,c,"\n",NIL);
|
|
} else {
|
|
Printv(out,"\n",NIL);
|
|
}
|
|
s = Nextitem(clist);
|
|
}
|
|
Delete(clist);
|
|
return out;
|
|
}
|
|
|
|
String *
|
|
CHICKEN::singleSearch(const char *typemap, char *argname,
|
|
SwigType *searchClass)
|
|
{
|
|
String *tm;
|
|
char *source = "$input";
|
|
char *target = "$1";
|
|
/* search for search-class typemap */
|
|
SwigType *type = Copy(searchClass);
|
|
SwigType_add_pointer(type);
|
|
tm = Swig_typemap_lookup(typemap, type, argname, argname,
|
|
source, target, 0);
|
|
Delete(type);
|
|
|
|
return tm;
|
|
}
|
|
|
|
String *
|
|
CHICKEN::recurseSearch(const char *typemap, char *argname, Node *n)
|
|
{
|
|
String *tm;
|
|
tm = singleSearch(typemap, argname, Getattr(n, "name"));
|
|
if (tm) {
|
|
return tm;
|
|
}
|
|
|
|
/* recurse through base classes */
|
|
List *baselist = Getattr(n,"bases");
|
|
if (baselist && Len(baselist)) {
|
|
Node *base = Firstitem(baselist);
|
|
while (base) {
|
|
tm = recurseSearch(typemap, argname, base);
|
|
if (tm) break;
|
|
base = Nextitem(baselist);
|
|
}
|
|
}
|
|
return tm;
|
|
}
|
|
|
|
void
|
|
CHICKEN::namify(String *scmname)
|
|
{
|
|
Replaceall(scmname,"_to_", "->");
|
|
Replaceall(scmname,"_", "-");
|
|
|
|
/* Convert mixed-case to lower case with dashes */
|
|
if (mixed) {
|
|
int changedcase;
|
|
int i;
|
|
|
|
/* insert "-" in all places with switches in case, and lowercase
|
|
any upcase chars */
|
|
do {
|
|
char *s = Char(scmname);
|
|
const int l = Len(scmname);
|
|
int case_is_set = 0;
|
|
int was_uppercase = 0;
|
|
int pseudo_first = 0;
|
|
|
|
changedcase = 0;
|
|
for (i=0; i < l; ++i, ++s) {
|
|
int is_uppercase = -1; /* -1 = neither, 0 = lower, 1 = upper */
|
|
if (isalpha(*s) && !isdigit(*s)) {
|
|
is_uppercase = ((*s) >= 'A' && (*s) <= 'Z') ? 1 : 0;
|
|
}
|
|
if (i == 0 || !isalpha(*s) || isdigit(*s)) {
|
|
case_is_set = 0;
|
|
pseudo_first = 1;
|
|
}
|
|
if (case_is_set) {
|
|
if (is_uppercase >= 0 && was_uppercase != is_uppercase) {
|
|
*s = tolower(*s);
|
|
Insert(scmname, i, "-");
|
|
changedcase = 1;
|
|
break;
|
|
}
|
|
}
|
|
else if (is_uppercase >= 0) {
|
|
/* use currentcase, or lowercase if first char */
|
|
if (pseudo_first) {
|
|
pseudo_first = 0;
|
|
/* only if first two chars are upper case will we say that
|
|
the first char is upper case (like JavaBean property
|
|
naming rules) */
|
|
was_uppercase = 0;
|
|
const char *t = s + 1;
|
|
if (l >= i+2 && isalpha(*t) && !isdigit(*t) &&
|
|
((*t) >= 'A' && (*t) <= 'Z')) {
|
|
was_uppercase = 1;
|
|
}
|
|
}
|
|
else {
|
|
was_uppercase = is_uppercase;
|
|
}
|
|
case_is_set = 1;
|
|
}
|
|
if (is_uppercase == 1) {
|
|
*s = tolower(*s);
|
|
}
|
|
}
|
|
}
|
|
while (changedcase);
|
|
}
|
|
}
|
|
|
|
void
|
|
CHICKEN::selectOutOneOrMany(String *tm, int is_many)
|
|
{
|
|
char *s = Char(tm);
|
|
const char IFMANY[] = "/*if MANY*/";
|
|
const char IFONE[] = "/*if ONE*/";
|
|
const char ELSE[] = "/*else*/";
|
|
const char ENDIF[] = "/*endif*/";
|
|
enum { NONE, ONE, MANY } mode = NONE;
|
|
|
|
while (s) {
|
|
int displayline = 1;
|
|
|
|
/* set nextline */
|
|
char * nextline = strstr(s, "\n");
|
|
if (nextline) nextline += strlen("\n");
|
|
|
|
/* set displayline if necessary */
|
|
if (is_many && mode == ONE) displayline = 0;
|
|
if (!is_many && mode == MANY) displayline = 0;
|
|
|
|
/* which control line are we on? */
|
|
if (strncmp(s, IFMANY, sizeof(IFMANY) - 1) == 0) {
|
|
mode = MANY;
|
|
displayline = 0;
|
|
}
|
|
else if (strncmp(s, IFONE, sizeof(IFONE) - 1) == 0) {
|
|
mode = ONE;
|
|
displayline = 0;
|
|
}
|
|
else if (strncmp(s, ELSE, sizeof(ELSE) - 1) == 0) {
|
|
if (mode == ONE) mode = MANY;
|
|
else if (mode == MANY) mode = ONE;
|
|
displayline = 0;
|
|
}
|
|
else if (strncmp (s, ENDIF, sizeof(ENDIF) - 1) == 0) {
|
|
mode = NONE;
|
|
displayline = 0;
|
|
}
|
|
|
|
/* display line */
|
|
if (displayline) {
|
|
/* advance to next line */
|
|
s = nextline;
|
|
}
|
|
/* or don't display line */
|
|
else {
|
|
if (!nextline) {
|
|
memset(s, ' ', strlen(s)); /* truncate this (last) line */
|
|
s = 0;
|
|
}
|
|
else {
|
|
memset(s, ' ', nextline - s); /* remove this line */
|
|
s = nextline;
|
|
}
|
|
}
|
|
};
|
|
};
|