Major clean up in the Guile module.
Started new typemap-based procedure documentation system. git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@707 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Matthias Köppe
parent
1dca4eca55
commit
3768eb73db
2 changed files with 163 additions and 365 deletions
|
|
@ -1,175 +1,48 @@
|
|||
/* typemaps.i --- guile-specific typemaps
|
||||
Copyright (C) 2000 Matthias Koeppe <mkoeppe@saturn.Math.Uni-Magdeburg.DE>
|
||||
/* typemaps.i --- guile-specific typemaps -*- c -*-
|
||||
Copyright (C) 2000 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
|
||||
|
||||
$Header$ */
|
||||
|
||||
#define MK_SIMPLE_MAP(f) $target = f ($source)
|
||||
/* Basic types */
|
||||
|
||||
#define SIMPLE_IN_MAP_SET(op) \
|
||||
%typemap (guile, op) bool { MK_SIMPLE_MAP (gh_scm2bool); } \
|
||||
%typemap (guile, op) char { MK_SIMPLE_MAP (gh_scm2char); } \
|
||||
%typemap (guile, op) int { MK_SIMPLE_MAP (gh_scm2int); } \
|
||||
%typemap (guile, op) short { MK_SIMPLE_MAP (gh_scm2int); } \
|
||||
%typemap (guile, op) long { MK_SIMPLE_MAP (gh_scm2long); } \
|
||||
%typemap (guile, op) ptrdiff_t { MK_SIMPLE_MAP (gh_scm2long); } \
|
||||
%typemap (guile, op) unsigned int { MK_SIMPLE_MAP (gh_scm2ulong); } \
|
||||
%typemap (guile, op) unsigned short { MK_SIMPLE_MAP (gh_scm2ulong); } \
|
||||
%typemap (guile, op) unsigned long { MK_SIMPLE_MAP (gh_scm2ulong); } \
|
||||
%typemap (guile, op) size_t { MK_SIMPLE_MAP (gh_scm2ulong); } \
|
||||
%typemap (guile, op) float { MK_SIMPLE_MAP (gh_scm2double); } \
|
||||
%typemap (guile, op) double { MK_SIMPLE_MAP (gh_scm2double); } \
|
||||
%typemap (guile, op) char * { MK_SIMPLE_MAP (GSWIG_scm2str); }
|
||||
#define SIMPLE_MAP(C_NAME, SCM_TO_C, C_TO_SCM, SCM_NAME) \
|
||||
%typemap (guile, in) C_NAME "$target = SCM_TO_C($source);"; \
|
||||
%typemap (guile, varin) C_NAME "$target = SCM_TO_C($source);"; \
|
||||
%typemap (guile, out) C_NAME "$target = C_TO_SCM($source);"; \
|
||||
%typemap (guile, varout) C_NAME "$target = C_TO_SCM($source);"; \
|
||||
%typemap (guile, indoc) C_NAME "($ARG <SCM_NAME>)"; \
|
||||
%typemap (guile, outdoc) C_NAME "<SCM_NAME>"; \
|
||||
%typemap (guile, in) C_NAME *INPUT (C_NAME temp) \
|
||||
{ temp = (C_NAME) C_TO_SCM($source); $target = &temp; } \
|
||||
%typemap (guile, indoc) C_NAME *INPUT "($arg <SCM_NAME>)"; \
|
||||
%typemap (guile, ignore) C_NAME *OUTPUT (C_NAME temp) \
|
||||
{ $target = &temp; } \
|
||||
%typemap (guile, argout) C_NAME *OUTPUT \
|
||||
"GUILE_APPEND_RESULT(C_TO_SCM(*$target));"; \
|
||||
%typemap (guile, argoutdoc) C_NAME *OUTPUT "($ARG <SCM_NAME>)"; \
|
||||
%typemap (guile, in) C_NAME *BOTH = C_NAME *INPUT; \
|
||||
%typemap (guile, indoc) C_NAME *BOTH = C_NAME *INPUT; \
|
||||
%typemap (guile, argout) C_NAME *BOTH = C_NAME *OUTPUT; \
|
||||
%typemap (guile, argoutdoc) C_NAME *BOTH = C_NAME *OUTPUT
|
||||
|
||||
#define SIMPLE_OUT_MAP_SET(op) \
|
||||
%typemap (guile, op) bool { MK_SIMPLE_MAP (gh_bool2scm); } \
|
||||
%typemap (guile, op) char { MK_SIMPLE_MAP (gh_char2scm); } \
|
||||
%typemap (guile, op) int { MK_SIMPLE_MAP (gh_int2scm); } \
|
||||
%typemap (guile, op) short { MK_SIMPLE_MAP (gh_int2scm); } \
|
||||
%typemap (guile, op) long { MK_SIMPLE_MAP (gh_long2scm); } \
|
||||
%typemap (guile, op) ptrdiff_t { MK_SIMPLE_MAP (gh_long2scm); } \
|
||||
%typemap (guile, op) unsigned int { MK_SIMPLE_MAP (gh_ulong2scm); } \
|
||||
%typemap (guile, op) unsigned short { MK_SIMPLE_MAP (gh_ulong2scm); } \
|
||||
%typemap (guile, op) unsigned long { MK_SIMPLE_MAP (gh_ulong2scm); } \
|
||||
%typemap (guile, op) size_t { MK_SIMPLE_MAP (gh_ulong2scm); } \
|
||||
%typemap (guile, op) float { MK_SIMPLE_MAP (gh_double2scm); } \
|
||||
%typemap (guile, op) double { MK_SIMPLE_MAP (gh_double2scm); } \
|
||||
%typemap (guile, op) char * { MK_SIMPLE_MAP (gh_str02scm); }
|
||||
SIMPLE_MAP(bool, gh_scm2bool, gh_bool2scm, boolean);
|
||||
SIMPLE_MAP(char, gh_scm2char, gh_char2scm, char);
|
||||
SIMPLE_MAP(unsigned char, gh_scm2char, gh_char2scm, char);
|
||||
SIMPLE_MAP(int, gh_scm2int, gh_int2scm, integer);
|
||||
SIMPLE_MAP(short, gh_scm2int, gh_int2scm, integer);
|
||||
SIMPLE_MAP(long, gh_scm2long, gh_long2scm, integer);
|
||||
SIMPLE_MAP(ptrdiff_t, gh_scm2long, gh_long2scm, integer);
|
||||
SIMPLE_MAP(unsigned int, gh_scm2ulong, gh_ulong2scm, integer);
|
||||
SIMPLE_MAP(unsigned short, gh_scm2ulong, gh_ulong2scm, integer);
|
||||
SIMPLE_MAP(unsigned long, gh_scm2ulong, gh_ulong2scm, integer);
|
||||
SIMPLE_MAP(size_t, gh_scm2ulong, gh_ulong2scm, integer);
|
||||
SIMPLE_MAP(float, gh_scm2double, gh_double2scm, real);
|
||||
SIMPLE_MAP(double, gh_scm2double, gh_double2scm, real);
|
||||
SIMPLE_MAP(char *, GSWIG_scm2str, gh_str02scm, string);
|
||||
|
||||
/*
|
||||
* Declaration start here
|
||||
*/
|
||||
/* Void */
|
||||
|
||||
SIMPLE_IN_MAP_SET (in)
|
||||
SIMPLE_IN_MAP_SET (varin)
|
||||
|
||||
SIMPLE_OUT_MAP_SET (out)
|
||||
SIMPLE_OUT_MAP_SET (varout)
|
||||
|
||||
/* INPUT/OUTPUT/BOTH typemaps */
|
||||
|
||||
%typemap(guile,in) double *INPUT(double temp)
|
||||
{
|
||||
temp = gh_scm2double($source);
|
||||
$target = &temp;
|
||||
}
|
||||
|
||||
%typemap(guile,in) float *INPUT(float temp)
|
||||
{
|
||||
temp = (float) gh_scm2double($source);
|
||||
$target = &temp;
|
||||
}
|
||||
|
||||
%typemap(guile,in) int *INPUT(int temp)
|
||||
{
|
||||
temp = (int) gh_scm2int($source);
|
||||
$target = &temp;
|
||||
}
|
||||
|
||||
%typemap(guile,in) short *INPUT(short temp)
|
||||
{
|
||||
temp = (short) gh_scm2int($source);
|
||||
$target = &temp;
|
||||
}
|
||||
|
||||
%typemap(guile,in) long *INPUT(long temp),
|
||||
ptrdiff_t *INPUT(long temp)
|
||||
{
|
||||
temp = (long) gh_scm2long($source);
|
||||
$target = &temp;
|
||||
}
|
||||
|
||||
%typemap(guile,in) unsigned int *INPUT(unsigned int temp)
|
||||
{
|
||||
temp = (unsigned int) gh_scm2ulong($source);
|
||||
$target = &temp;
|
||||
}
|
||||
|
||||
%typemap(guile,in) unsigned short *INPUT(unsigned short temp)
|
||||
{
|
||||
temp = (unsigned short) gh_scm2ulong($source);
|
||||
$target = &temp;
|
||||
}
|
||||
|
||||
%typemap(guile,in) unsigned long *INPUT(unsigned long temp),
|
||||
size_t *INPUT(unsigned long temp)
|
||||
{
|
||||
temp = (unsigned long) gh_scm2ulong($source);
|
||||
$target = &temp;
|
||||
}
|
||||
%typemap(guile,in) unsigned char *INPUT(unsigned char temp)
|
||||
{
|
||||
temp = (unsigned char) gh_scm2char($source);
|
||||
$target = &temp;
|
||||
}
|
||||
|
||||
%typemap(guile,ignore) int *OUTPUT(int temp),
|
||||
short *OUTPUT(short temp),
|
||||
long *OUTPUT(long temp),
|
||||
ptrdiff_t *OUTPUT(ptrdiff_t temp),
|
||||
unsigned int *OUTPUT(unsigned int temp),
|
||||
unsigned short *OUTPUT(unsigned short temp),
|
||||
unsigned long *OUTPUT(unsigned long temp),
|
||||
size_t *OUTPUT(size_t temp),
|
||||
unsigned char *OUTPUT(unsigned char temp),
|
||||
float *OUTPUT(float temp),
|
||||
double *OUTPUT(double temp)
|
||||
{
|
||||
$target = &temp;
|
||||
}
|
||||
|
||||
%typemap(guile,argout) int *OUTPUT,
|
||||
short *OUTPUT
|
||||
{
|
||||
GUILE_APPEND_RESULT(gh_int2scm(*$target));
|
||||
}
|
||||
|
||||
%typemap(guile,argout) long *OUTPUT,
|
||||
ptrdiff_t *OUTPUT
|
||||
{
|
||||
GUILE_APPEND_RESULT(gh_long2scm(*$target));
|
||||
}
|
||||
|
||||
%typemap(guile,argout) unsigned int *OUTPUT,
|
||||
unsigned short *OUTPUT,
|
||||
unsigned long *OUTPUT,
|
||||
size_t *OUTPUT
|
||||
{
|
||||
GUILE_APPEND_RESULT(gh_ulong2scm(*$target));
|
||||
}
|
||||
|
||||
%typemap(guile,argout) unsigned char *OUTPUT
|
||||
{
|
||||
GUILE_APPEND_RESULT(gh_char2scm(*$target));
|
||||
}
|
||||
|
||||
%typemap(guile,argout) float *OUTPUT,
|
||||
double *OUTPUT
|
||||
{
|
||||
GUILE_APPEND_RESULT(gh_double2scm(*$target));
|
||||
}
|
||||
|
||||
%typemap(guile,in) int *BOTH = int *INPUT;
|
||||
%typemap(guile,in) short *BOTH = short *INPUT;
|
||||
%typemap(guile,in) long *BOTH = long *INPUT;
|
||||
%typemap(guile,in) ptrdiff_t *BOTH = ptrdiff_t *INPUT;
|
||||
%typemap(guile,in) unsigned *BOTH = unsigned *INPUT;
|
||||
%typemap(guile,in) unsigned short *BOTH = unsigned short *INPUT;
|
||||
%typemap(guile,in) unsigned long *BOTH = unsigned long *INPUT;
|
||||
%typemap(guile,in) size_t *BOTH = size_t *INPUT;
|
||||
%typemap(guile,in) unsigned char *BOTH = unsigned char *INPUT;
|
||||
%typemap(guile,in) float *BOTH = float *INPUT;
|
||||
%typemap(guile,in) double *BOTH = double *INPUT;
|
||||
|
||||
%typemap(guile,argout) int *BOTH = int *OUTPUT;
|
||||
%typemap(guile,argout) short *BOTH = short *OUTPUT;
|
||||
%typemap(guile,argout) long *BOTH = long *OUTPUT;
|
||||
%typemap(guile,argout) ptrdiff_t *BOTH = ptrdiff_t *OUTPUT;
|
||||
%typemap(guile,argout) unsigned *BOTH = unsigned *OUTPUT;
|
||||
%typemap(guile,argout) unsigned short *BOTH = unsigned short *OUTPUT;
|
||||
%typemap(guile,argout) unsigned long *BOTH = unsigned long *OUTPUT;
|
||||
%typemap(guile,argout) size_t *BOTH = size_t *OUTPUT;
|
||||
%typemap(guile,argout) unsigned char *BOTH = unsigned char *OUTPUT;
|
||||
%typemap(guile,argout) float *BOTH = float *OUTPUT;
|
||||
%typemap(guile,argout) double *BOTH = double *OUTPUT;
|
||||
%typemap (guile, out) void "gswig_result = GH_UNSPECIFIED;";
|
||||
%typemap (guile, outdoc) void "";
|
||||
|
||||
/* typemaps.i ends here */
|
||||
|
|
|
|||
|
|
@ -387,21 +387,36 @@ guile_typemap_lookup(const char *op, SwigType *type, String_or_char *pname, Stri
|
|||
return tm;
|
||||
}
|
||||
|
||||
// ----------------------------------------------------------------------
|
||||
// GUILE::create_function(char *name, char *iname, SwigType *d,
|
||||
// ParmList *l)
|
||||
//
|
||||
// Create a function declaration and register it with the interpreter.
|
||||
// ----------------------------------------------------------------------
|
||||
/* Lookup a typemap, replace all relevant parameters and write it to
|
||||
the given generalized file. */
|
||||
|
||||
static void
|
||||
mreplace (DOHString *s, DOHString_or_char *argnum, DOHString_or_char *arg, DOHString_or_char *proc_name)
|
||||
static int
|
||||
guile_do_typemap(DOHFile *file, const char *op,
|
||||
SwigType *type, String_or_char *arg,
|
||||
String_or_char *source, String_or_char *target,
|
||||
int argnum, DOHString *name, Wrapper *f,
|
||||
int nonewline_p)
|
||||
{
|
||||
Replace(s,"$argnum",argnum, DOH_REPLACE_ANY);
|
||||
Replace(s,"$arg", arg, DOH_REPLACE_ANY);
|
||||
Replace(s,"$name", proc_name, DOH_REPLACE_ANY);
|
||||
char *tm;
|
||||
if ((tm = guile_typemap_lookup(op, type, arg,
|
||||
source, target, f))) {
|
||||
String *s = NewString(tm);
|
||||
char argnum_s[10];
|
||||
sprintf(argnum_s, "%d", argnum);
|
||||
Replace(s,"$argnum", argnum_s, DOH_REPLACE_ANY);
|
||||
Replace(s,"$arg", arg, DOH_REPLACE_ANY);
|
||||
/* FIXME: Produce all-uppercase version of arg */
|
||||
Replace(s,"$ARG", arg, DOH_REPLACE_ANY);
|
||||
Replace(s,"$name", name, DOH_REPLACE_ANY);
|
||||
if (nonewline_p)
|
||||
Printv(file, s, 0);
|
||||
else Printv(file, s, "\n", 0);
|
||||
Delete(s);
|
||||
return 1;
|
||||
}
|
||||
else return 0;
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
throw_unhandled_guile_type_error (SwigType *d)
|
||||
{
|
||||
|
|
@ -409,20 +424,26 @@ throw_unhandled_guile_type_error (SwigType *d)
|
|||
error_count++;
|
||||
}
|
||||
|
||||
// ----------------------------------------------------------------------
|
||||
// GUILE::create_function(char *name, char *iname, SwigType *d,
|
||||
// ParmList *l)
|
||||
//
|
||||
// Create a function declaration and register it with the interpreter.
|
||||
// ----------------------------------------------------------------------
|
||||
|
||||
void
|
||||
GUILE::create_function (char *name, char *iname, SwigType *d, ParmList *l)
|
||||
{
|
||||
Parm *p;
|
||||
DOHString *proc_name = 0;
|
||||
char source[256], target[256], argnum[256], arg[256];
|
||||
char *tm;
|
||||
Wrapper *f;
|
||||
DOHString *cleanup;
|
||||
DOHString *outarg;
|
||||
|
||||
f = NewWrapper();
|
||||
outarg = NewString("");
|
||||
cleanup = NewString("");
|
||||
char source[256], target[256];
|
||||
Wrapper *f = NewWrapper();;
|
||||
String *cleanup = NewString("");
|
||||
String *outarg = NewString("");
|
||||
String *signature = NewString("");
|
||||
String *returns = NewString("");
|
||||
int returns_list = 0;
|
||||
String *tmp = NewString("");
|
||||
|
||||
// Make a wrapper name for this
|
||||
char * wname = new char [strlen (prefix) + strlen (iname) + 2];
|
||||
|
|
@ -432,7 +453,7 @@ GUILE::create_function (char *name, char *iname, SwigType *d, ParmList *l)
|
|||
proc_name = NewString(iname);
|
||||
Replace(proc_name,"_", "-", DOH_REPLACE_ANY);
|
||||
|
||||
// Now write the wrapper function itself....this is pretty ugly
|
||||
/* Now write the wrapper function itself */
|
||||
|
||||
Printv(f->def, "static SCM\n", wname," (", 0);
|
||||
|
||||
|
|
@ -453,30 +474,42 @@ GUILE::create_function (char *name, char *iname, SwigType *d, ParmList *l)
|
|||
|
||||
Printf(f->def, ")\n{\n");
|
||||
|
||||
// Define the scheme name in C
|
||||
/* Define the scheme name in C */
|
||||
/* FIXME: This is only needed for the code in exception.i since
|
||||
typemaps can always use $name. I propose to define a new macro
|
||||
SWIG_exception_in(ERROR, MESSAGE, FUNCTION) and use it instead of
|
||||
SWIG_exception(ERROR, MESSAGE). */
|
||||
|
||||
Printv(f->def, "#define SCHEME_NAME \"", proc_name, "\"\n", 0);
|
||||
|
||||
|
||||
// Declare return variable and arguments
|
||||
|
||||
int pcount = emit_args (d, l, f);
|
||||
emit_args (d, l, f);
|
||||
int numargs = 0;
|
||||
int numopt = 0;
|
||||
|
||||
Wrapper_add_local (f,"gswig_result", "SCM gswig_result");
|
||||
|
||||
if (!guile_do_typemap(returns, "outdoc", d, name,
|
||||
(char*)"result", (char*)"gswig_result",
|
||||
0, proc_name, f, 1)) {
|
||||
String *s = NewString(SwigType_str(d, 0));
|
||||
Chop(s);
|
||||
Printf(returns, "<%s>", s);
|
||||
Delete(s);
|
||||
}
|
||||
|
||||
/* Now write code to extract the parameters */
|
||||
|
||||
i = 0;
|
||||
int j = 0;
|
||||
for (p = l; p; p=Getnext(p)) {
|
||||
Printv(signature, "(", proc_name, 0);
|
||||
|
||||
for (p = l, i = 0; p; p=Getnext(p), i++) {
|
||||
SwigType *pt = Gettype(p);
|
||||
String *pn = Getname(p);
|
||||
|
||||
// Produce names of source and target
|
||||
sprintf(source,"s_%d",i);
|
||||
sprintf(target,"%s", Char(Getlname(p)));
|
||||
sprintf(argnum,"%d",i);
|
||||
|
||||
// Handle parameter types.
|
||||
|
||||
|
|
@ -484,10 +517,9 @@ GUILE::create_function (char *name, char *iname, SwigType *d, ParmList *l)
|
|||
Printv(f->code, "/* ", pn, " ignored... */\n", 0);
|
||||
else {
|
||||
++numargs;
|
||||
if ((tm = guile_typemap_lookup ("in",
|
||||
pt, pn, source, target, f))) {
|
||||
Printv(f->code,tm,"\n",0);
|
||||
mreplace (f->code, argnum, pn, proc_name);
|
||||
if (guile_do_typemap(f->code, "in", pt, pn,
|
||||
source, target, numargs, proc_name, f, 0)) {
|
||||
/* nothing to do */
|
||||
}
|
||||
else if (is_a_pointer(pt)) {
|
||||
get_pointer (iname, i, pt, f, proc_name, numargs);
|
||||
|
|
@ -495,35 +527,48 @@ GUILE::create_function (char *name, char *iname, SwigType *d, ParmList *l)
|
|||
else {
|
||||
throw_unhandled_guile_type_error (pt);
|
||||
}
|
||||
++j;
|
||||
/* Add to signature */
|
||||
Printf(signature, " ");
|
||||
if (!guile_do_typemap(signature, "indoc", pt, pn,
|
||||
source, target, numargs, proc_name, f, 1)) {
|
||||
String *s = NewString(SwigType_str(pt, 0));
|
||||
Chop(s);
|
||||
Printf(signature, "(%s <%s>)", pn, s);
|
||||
Delete(s);
|
||||
}
|
||||
}
|
||||
|
||||
// Check if there are any constraints.
|
||||
/* Check if there are any constraints. */
|
||||
|
||||
if ((tm = guile_typemap_lookup ("check",
|
||||
pt, pn, source, target, f))) {
|
||||
Printv(f->code,tm,"\n",0);
|
||||
mreplace (f->code, argnum, arg, proc_name);
|
||||
guile_do_typemap(f->code, "check", pt, pn,
|
||||
source, target, numargs, proc_name, f, 0);
|
||||
|
||||
/* Pass output arguments back to the caller. */
|
||||
|
||||
guile_do_typemap(outarg, "argout", pt, pn,
|
||||
source, target, numargs, proc_name, f, 0);
|
||||
|
||||
/* Document output arguments */
|
||||
Clear(tmp);
|
||||
if (guile_do_typemap(tmp, "argoutdoc", pt, pn,
|
||||
source, target, numargs, proc_name, f, 1)) {
|
||||
if (Len(returns) == 0) { /* unspecified -> singleton */
|
||||
Printv(returns, tmp, 0);
|
||||
}
|
||||
else { /* append to list */
|
||||
Printv(returns, " ", tmp, 0);
|
||||
returns_list = 1;
|
||||
}
|
||||
}
|
||||
|
||||
// free up any memory allocated for the arguments.
|
||||
|
||||
// Pass output arguments back to the caller.
|
||||
|
||||
if ((tm = guile_typemap_lookup ("argout",
|
||||
pt, pn, source, target, f))) {
|
||||
Printv(outarg,tm,"\n",0);
|
||||
mreplace (outarg, argnum, arg, proc_name);
|
||||
}
|
||||
|
||||
// Free up any memory allocated for the arguments.
|
||||
|
||||
if ((tm = guile_typemap_lookup ("freearg",
|
||||
pt, pn, source, target, f))) {
|
||||
Printv(cleanup, tm, "\n", 0);
|
||||
mreplace (cleanup, argnum, arg, proc_name);
|
||||
}
|
||||
i++;
|
||||
guile_do_typemap(cleanup, "freearg", pt, pn,
|
||||
source, target, numargs, proc_name, f, 0);
|
||||
}
|
||||
|
||||
Printv(signature, ")\n", 0);
|
||||
|
||||
// Now write code to make the function call
|
||||
Printv(f->code, tab4, "gh_defer_ints();\n", 0);
|
||||
emit_func_call (name, d, l, f);
|
||||
|
|
@ -531,12 +576,10 @@ GUILE::create_function (char *name, char *iname, SwigType *d, ParmList *l)
|
|||
|
||||
// Now have return value, figure out what to do with it.
|
||||
|
||||
if (SwigType_type(d) == T_VOID)
|
||||
Printv(f->code, tab4, "gswig_result = GH_UNSPECIFIED;\n", 0);
|
||||
else if ((tm = guile_typemap_lookup ("out",
|
||||
d, name, (char*)"result", (char*)"gswig_result", f))) {
|
||||
Printv(f->code,tm,"\n",0);
|
||||
mreplace (f->code, argnum, arg, proc_name);
|
||||
if (guile_do_typemap(f->code, "out", d, name,
|
||||
(char*)"result", (char*)"gswig_result",
|
||||
0, proc_name, f, 0)) {
|
||||
/* nothing */
|
||||
}
|
||||
else if (is_a_pointer(d)) {
|
||||
SwigType_remember(d);
|
||||
|
|
@ -560,24 +603,18 @@ GUILE::create_function (char *name, char *iname, SwigType *d, ParmList *l)
|
|||
// Look for any remaining cleanup
|
||||
|
||||
if (NewObject) {
|
||||
if ((tm = guile_typemap_lookup ("newfree",
|
||||
d, iname, (char*)"result", (char*)"", f))) {
|
||||
Printv(f->code,tm,"\n",0);
|
||||
mreplace (f->code, argnum, arg, proc_name);
|
||||
}
|
||||
guile_do_typemap(f->code, "newfree", d, iname,
|
||||
(char*)"result", (char*)"", 0, proc_name, f, 0);
|
||||
}
|
||||
|
||||
// Free any memory allocated by the function being wrapped..
|
||||
|
||||
if ((tm = guile_typemap_lookup ("ret",
|
||||
d, name, (char*)"result", (char*)"", f))) {
|
||||
Printv(f->code,tm,"\n",0);
|
||||
mreplace (f->code, argnum, arg, proc_name);
|
||||
}
|
||||
guile_do_typemap(f->code, "ret", d, name,
|
||||
(char*)"result", (char*)"", 0, proc_name, f, 0);
|
||||
|
||||
// Wrap things up (in a manner of speaking)
|
||||
|
||||
Printv(f->code, tab4, "return gswig_result;\n", 0);
|
||||
Printv(f->code, "return gswig_result;\n", 0);
|
||||
|
||||
// Undefine the scheme name
|
||||
|
||||
|
|
@ -598,9 +635,20 @@ GUILE::create_function (char *name, char *iname, SwigType *d, ParmList *l)
|
|||
Printf (f_init, "\t gh_new_procedure(\"%s\", %s, %d, %d, 0);\n",
|
||||
proc_name, wname, numargs-numopt, numopt);
|
||||
}
|
||||
/* Register procedure documentation */
|
||||
Printv(signature, "Returns ", 0);
|
||||
if (Len(returns)==0) Printv(signature, "unspecified", 0);
|
||||
else if (returns_list) Printv(signature, "list (", returns, ")", 0);
|
||||
else Printv(signature, returns, 0);
|
||||
Printv(signature, "\n", 0);
|
||||
printf("%s\n", Char(signature));
|
||||
|
||||
Delete(proc_name);
|
||||
Delete(outarg);
|
||||
Delete(cleanup);
|
||||
Delete(signature);
|
||||
Delete(returns);
|
||||
Delete(tmp);
|
||||
DelWrapper(f);
|
||||
}
|
||||
|
||||
|
|
@ -787,15 +835,14 @@ GUILE::declare_const (char *name, char *, SwigType *type, char *value)
|
|||
DelWrapper(f);
|
||||
}
|
||||
|
||||
#if 0
|
||||
// ----------------------------------------------------------------------
|
||||
// GUILE::usage_var(char *iname, SwigType *t, String &usage)
|
||||
//
|
||||
// Produces a usage string for a Guile variable.
|
||||
// ----------------------------------------------------------------------
|
||||
|
||||
void
|
||||
GUILE::usage_var (char *iname, SwigType *t, DOHString *usage)
|
||||
static void
|
||||
usage_var (char *iname, SwigType *t, DOHString *usage)
|
||||
{
|
||||
|
||||
Printv(usage, "(", iname, " [value])", 0);
|
||||
|
|
@ -804,136 +851,14 @@ GUILE::usage_var (char *iname, SwigType *t, DOHString *usage)
|
|||
}
|
||||
}
|
||||
|
||||
// ---------------------------------------------------------------------------
|
||||
// GUILE::usage_func(char *iname, SwigType *t, ParmList *l, String &usage)
|
||||
//
|
||||
// Produces a usage string for a function in Guile
|
||||
// ---------------------------------------------------------------------------
|
||||
|
||||
void
|
||||
GUILE::usage_func (char *iname, SwigType *d, ParmList *l, DOHString *usage)
|
||||
{
|
||||
|
||||
Parm *p;
|
||||
|
||||
// Print the function name.
|
||||
|
||||
Printv(usage,"(",iname,0);
|
||||
|
||||
// Now go through and print parameters
|
||||
|
||||
for (p = l; p != 0; p = Getnext(p)) {
|
||||
SwigType *pt = Gettype(p);
|
||||
char *pn = Getname(p);
|
||||
|
||||
if (Getignore(p))
|
||||
continue;
|
||||
|
||||
// Print the type. If the parameter has been named, use that as well.
|
||||
|
||||
if (SwigType_type(pt) != T_VOID) {
|
||||
|
||||
// Print the type.
|
||||
Printv(usage, " <", SwigType_Getname(pt), 0);
|
||||
if (SwigType_is_pointer(pt)) {
|
||||
/* for (int j = 0; j < (pt->is_pointer - pt->implicit_ptr); j++) {*/
|
||||
for (int j = 0; j < SwigType_is_pointer(pt); j++) {
|
||||
Putc('*', usage);
|
||||
}
|
||||
}
|
||||
Putc('>',usage);
|
||||
|
||||
// Print the name if it exists.
|
||||
if (strlen (pn) > 0) {
|
||||
Printv(usage," ", pn, 0);
|
||||
}
|
||||
}
|
||||
}
|
||||
Putc(')', usage);
|
||||
}
|
||||
|
||||
|
||||
// ---------------------------------------------------------------------------
|
||||
// GUILE::usage_returns(char *iname, SwigType *t, ParmList *l, String &usage)
|
||||
//
|
||||
// Produces a usage string for a function in Guile
|
||||
// ---------------------------------------------------------------------------
|
||||
|
||||
void
|
||||
GUILE::usage_returns (char *iname, SwigType *d, ParmList *l, DOHString *usage)
|
||||
{
|
||||
Parm *p;
|
||||
DOHString *param;
|
||||
int have_param = 0, j;
|
||||
|
||||
Clear(usage);
|
||||
Printf(usage,"returns ");
|
||||
param = NewString("");
|
||||
|
||||
// go through and see if any are output.
|
||||
|
||||
for (p = l; p != 0; p = Getnext(p)) {
|
||||
SwigType *pt = Gettype(p);
|
||||
char *pn = Getname(p);
|
||||
|
||||
if (strcmp (pn,"BOTH") && strcmp (pn,"OUTPUT"))
|
||||
continue;
|
||||
|
||||
// Print the type. If the parameter has been named, use that as well.
|
||||
|
||||
if (SwigType_type(pt) != T_VOID) {
|
||||
++have_param;
|
||||
|
||||
// Print the type.
|
||||
Printv(param," $", SwigType_Getname(pt), 0);
|
||||
if (SwigType_is_pointer(pt)) {
|
||||
/* for (j = 0; j < (pt->is_pointer - pt->implicit_ptr - 1); j++) { */
|
||||
for (j = 0; j < SwigType_is_pointer(pt) - 1; j++) {
|
||||
Putc('*', param);
|
||||
}
|
||||
}
|
||||
Printf(param,"# ");
|
||||
}
|
||||
}
|
||||
|
||||
// See if we stick on the function return type.
|
||||
if ((SwigType_type(d) != T_VOID) || (have_param == 0)) {
|
||||
++have_param;
|
||||
if (SwigType_type(d) == T_VOID)
|
||||
Insert(param,0," unspecified ");
|
||||
else {
|
||||
Insert(param,0,"# ");
|
||||
Insert(param,0, SwigType_str(d,0));
|
||||
Insert(param,0," $");
|
||||
}
|
||||
}
|
||||
|
||||
// Kill extra white space.
|
||||
// param.strip(); - DB: Not supported right now
|
||||
Replace(param,"$", "<", DOH_REPLACE_ANY);
|
||||
Replace(param,"#", ">", DOH_REPLACE_ANY);
|
||||
Replace(param,"><", "> <", DOH_REPLACE_ANY);
|
||||
|
||||
// If there are multiple return values put them in a list.
|
||||
if (have_param > 1) {
|
||||
Insert(param,0,"(");
|
||||
Append(param,")");
|
||||
}
|
||||
Printv(usage,param,0);
|
||||
Delete(param);
|
||||
}
|
||||
|
||||
// ----------------------------------------------------------------------
|
||||
// GUILE::usage_const(char *iname, SwigType *type, char *value, String &usage)
|
||||
//
|
||||
// Produces a usage string for a Guile constant
|
||||
// ----------------------------------------------------------------------
|
||||
|
||||
void
|
||||
GUILE::usage_const (char *iname, SwigType *, char *value, DOHString *usage)
|
||||
static void
|
||||
usage_const (char *iname, SwigType *, char *value, DOHString *usage)
|
||||
{
|
||||
Printv(usage, "(", iname, " ", value, ")", 0);
|
||||
}
|
||||
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue