Merge new set of GOOPS changes by John Lenz.
GOOPS objects are now manipulated directly by the C code. Some fixes to typemap-GOOPS interaction. Remove the file argument to -scmstub and -goops. The Scheme files are now always called MODULE.scm or MODULE-primitive.scm, where MODULE is the module name and "primitive" can be changed by the -primsuffix option. The Scheme files are now placed in the directory given by the -outdir option, or the current directory. (Patch by John Lenz, slightly modified.) git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@5255 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Matthias Köppe
parent
a1c8f41baf
commit
5af411c153
1 changed files with 137 additions and 127 deletions
|
|
@ -56,11 +56,11 @@ Guile Options (available with -guile)\n\
|
|||
`ltdlmod' for Guile's old dynamic module\n\
|
||||
convention (Guile <= 1.4), or `hobbit' for hobbit\n\
|
||||
modules.\n\
|
||||
-scmstub <file> - Output Scheme <file> with module declaration and\n\
|
||||
-scmstub - Output Scheme file with module declaration and\n\
|
||||
exports; only with `passive' and `simple' linkage\n\
|
||||
-gh - Use the gh_ Guile API. (Guile <= 1.8, default) \n\
|
||||
-scm - Use the scm Guile API. (Guile >= 1.6) \n\
|
||||
-goops <file> - Export GOOPS class definitions to <file>\n\
|
||||
-shadow - Export GOOPS class definitions\n\
|
||||
-emitslotaccessors - Emit accessor methods for all GOOPS slots\n\
|
||||
-primsuffix <suffix> - Name appended to primitive module when exporting\n\
|
||||
GOOPS classes. (default = \"primitive\")\n\
|
||||
|
|
@ -86,10 +86,10 @@ static enum {
|
|||
GUILE_LSTYLE_HOBBIT // use (hobbit4d link)
|
||||
} linkage = GUILE_LSTYLE_SIMPLE;
|
||||
|
||||
static File *procdoc = 0;
|
||||
static File *scmstub = 0;
|
||||
static File *procdoc = 0;
|
||||
static bool scmstub = false;
|
||||
static String *scmtext;
|
||||
static File *goopsfile = 0;
|
||||
static bool goops = false;
|
||||
static String *goopstext;
|
||||
static String *goopscode;
|
||||
static String *goopsexport;
|
||||
|
|
@ -236,24 +236,12 @@ public:
|
|||
Swig_mark_arg (i);
|
||||
}
|
||||
else if (strcmp (argv[i], "-scmstub") == 0) {
|
||||
if (argv[i + 1]) {
|
||||
scmstub = NewFile(argv[i + 1], (char *) "w");
|
||||
Swig_mark_arg (i);
|
||||
Swig_mark_arg (i + 1);
|
||||
i++;
|
||||
} else {
|
||||
Swig_arg_error();
|
||||
}
|
||||
scmstub = true;
|
||||
Swig_mark_arg(i);
|
||||
}
|
||||
else if (strcmp (argv[i], "-goops") == 0) {
|
||||
if (argv[i + 1]) {
|
||||
goopsfile = NewFile(argv[i + 1], (char *) "w");
|
||||
Swig_mark_arg (i);
|
||||
Swig_mark_arg (i + 1);
|
||||
i++;
|
||||
} else {
|
||||
Swig_arg_error();
|
||||
}
|
||||
else if (strcmp (argv[i], "-shadow") == 0) {
|
||||
goops = true;
|
||||
Swig_mark_arg(i);
|
||||
}
|
||||
else if (strcmp(argv[i], "-gh") == 0) {
|
||||
use_scm_interface = 0;
|
||||
|
|
@ -300,15 +288,15 @@ public:
|
|||
primsuffix = NewString("primitive");
|
||||
|
||||
//goops support can only be enabled if passive or module linkage is used
|
||||
if (goopsfile) {
|
||||
if (goops) {
|
||||
if (linkage != GUILE_LSTYLE_PASSIVE && linkage != GUILE_LSTYLE_MODULE) {
|
||||
Printf(stderr, "guile: GOOPS support requires passive or module linkage\n");
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
if (goopsfile) {
|
||||
// -goops implies -emit-setters
|
||||
if (goops) {
|
||||
// -shadow implies -emit-setters
|
||||
emit_setters = 1;
|
||||
}
|
||||
|
||||
|
|
@ -435,14 +423,6 @@ public:
|
|||
Delete(procdoc);
|
||||
procdoc = NULL;
|
||||
}
|
||||
if (scmstub) {
|
||||
Delete(scmstub);
|
||||
scmstub = NULL;
|
||||
}
|
||||
if (goopsfile) {
|
||||
Delete(goopsfile);
|
||||
goopsfile = NULL;
|
||||
}
|
||||
Delete(goopscode);
|
||||
Delete(goopsexport);
|
||||
Delete(goopstext);
|
||||
|
|
@ -468,7 +448,7 @@ public:
|
|||
}
|
||||
|
||||
Printv(module_func,module_name,NIL);
|
||||
if (goopsfile)
|
||||
if (goops)
|
||||
Replaceall(module_func,"-", "_");
|
||||
|
||||
switch (linkage) {
|
||||
|
|
@ -518,7 +498,7 @@ public:
|
|||
Printf (f_init, "SCM\n%s (void)\n{\n", module_func);
|
||||
{
|
||||
String *mod = NewString(module_name);
|
||||
if (goopsfile)
|
||||
if (goops)
|
||||
Printv(mod,"-",primsuffix,NIL);
|
||||
Replaceall(mod,"/", " ");
|
||||
Printf(f_init, " SCM module = scm_c_define_module(\"%s\",\n", mod);
|
||||
|
|
@ -549,32 +529,55 @@ public:
|
|||
|
||||
if (scmstub) {
|
||||
/* Emit Scheme stub if requested */
|
||||
String *mod = NewString(module_name);
|
||||
if (goopsfile)
|
||||
Printv(mod,"-",primsuffix,NIL);
|
||||
String *primitive_name = NewString(module_name);
|
||||
if (goops)
|
||||
Printv(primitive_name,"-",primsuffix,NIL);
|
||||
|
||||
String *mod = NewString(primitive_name);
|
||||
Replaceall(mod, "/", " ");
|
||||
Printf (scmstub, ";;; -*- buffer-read-only: t -*- vi: set ro: */\n");
|
||||
Printf (scmstub, ";;; Automatically generated by SWIG; do not edit.\n\n");
|
||||
|
||||
String *fname = NewStringf("%s%s.scm",
|
||||
SWIG_output_directory(),
|
||||
primitive_name);
|
||||
Delete(primitive_name);
|
||||
File *scmstubfile = NewFile(fname, (char *) "w");
|
||||
if (!scmstubfile) {
|
||||
Printf(stderr,"*** Can't open '%s' for writing\n", fname);
|
||||
SWIG_exit(EXIT_FAILURE);
|
||||
}
|
||||
Delete(fname);
|
||||
|
||||
Printf (scmstubfile, ";;; -*- buffer-read-only: t -*- vi: set ro: */\n");
|
||||
Printf (scmstubfile, ";;; Automatically generated by SWIG; do not edit.\n\n");
|
||||
if (linkage == GUILE_LSTYLE_SIMPLE
|
||||
|| linkage == GUILE_LSTYLE_PASSIVE)
|
||||
Printf (scmstub, "(define-module (%s))\n\n", mod);
|
||||
|| linkage == GUILE_LSTYLE_PASSIVE)
|
||||
Printf (scmstubfile, "(define-module (%s))\n\n", mod);
|
||||
Delete(mod);
|
||||
Printf (scmstub, "%s", scmtext);
|
||||
Printf (scmstubfile, "%s", scmtext);
|
||||
if ((linkage == GUILE_LSTYLE_SIMPLE
|
||||
|| linkage == GUILE_LSTYLE_PASSIVE)
|
||||
&& Len(exported_symbols) > 0) {
|
||||
String *ex = NewString(exported_symbols);
|
||||
Replaceall(ex, ", ", "\n ");
|
||||
Replaceall(ex, "\"", "");
|
||||
Chop(ex);
|
||||
Printf(scmstub, "\n(export %s)\n", ex);
|
||||
Delete(ex);
|
||||
|| linkage == GUILE_LSTYLE_PASSIVE)
|
||||
&& Len(exported_symbols) > 0) {
|
||||
String *ex = NewString(exported_symbols);
|
||||
Replaceall(ex, ", ", "\n ");
|
||||
Replaceall(ex, "\"", "");
|
||||
Chop(ex);
|
||||
Printf(scmstubfile, "\n(export %s)\n", ex);
|
||||
Delete(ex);
|
||||
}
|
||||
}
|
||||
|
||||
if (goopsfile) {
|
||||
if (goops) {
|
||||
String *mod = NewString(module_name);
|
||||
Replaceall(mod, "/", " ");
|
||||
|
||||
String *fname = NewStringf("%s%s.scm", SWIG_output_directory(),
|
||||
module_name);
|
||||
File *goopsfile = NewFile(fname, (char *)"w");
|
||||
if (!goopsfile) {
|
||||
Printf(stderr,"*** Can't open '%s' for writing\n", fname);
|
||||
SWIG_exit(EXIT_FAILURE);
|
||||
}
|
||||
Delete(fname);
|
||||
Printf (goopsfile, ";;; -*- buffer-read-only: t -*- vi: set ro: */\n");
|
||||
Printf (goopsfile, ";;; Automatically generated by SWIG; do not edit.\n\n");
|
||||
Printf (goopsfile, "(define-module (%s))\n", mod);
|
||||
|
|
@ -594,6 +597,7 @@ public:
|
|||
Delete(ex);
|
||||
}
|
||||
Delete(mod);
|
||||
Delete(goopsfile);
|
||||
}
|
||||
|
||||
Delete(module_func);
|
||||
|
|
@ -966,14 +970,14 @@ public:
|
|||
if (use_scm_interface) {
|
||||
/* GOOPS support uses the MEMBER-set and MEMBER-get functions,
|
||||
so ignore only_setters in this case. */
|
||||
if (only_setters && !goopsfile)
|
||||
if (only_setters && !goops)
|
||||
Printf(f_init, "scm_c_make_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
|
||||
proc_name, numreq, numargs-numreq, wname);
|
||||
else
|
||||
Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
|
||||
proc_name, numreq, numargs-numreq, wname);
|
||||
} else {
|
||||
if (only_setters && !goopsfile)
|
||||
if (only_setters && !goops)
|
||||
Printf(f_init, "scm_make_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
|
||||
proc_name, numreq, numargs-numreq, wname);
|
||||
else
|
||||
|
|
@ -1014,7 +1018,10 @@ public:
|
|||
/* Register the function */
|
||||
if (use_scm_interface) {
|
||||
if (exporting_destructor) {
|
||||
Printf(f_init, "SWIG_TypeClientData(SWIGTYPE%s, (void *) %s);\n", swigtype_ptr, wname);
|
||||
Printf(f_init,
|
||||
"((swig_guile_clientdata *)(SWIGTYPE%s->clientdata))->destroy = (guile_destructor) %s;\n",
|
||||
swigtype_ptr, wname);
|
||||
//Printf(f_init, "SWIG_TypeClientData(SWIGTYPE%s, (void *) %s);\n", swigtype_ptr, wname);
|
||||
} else {
|
||||
Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
|
||||
proc_name, numreq, numargs-numreq, wname);
|
||||
|
|
@ -1068,18 +1075,10 @@ public:
|
|||
String *wrapargs = NewString("");
|
||||
buildGoopsArguments(Getattr(n, "parms"), args, wrapargs);
|
||||
|
||||
String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));
|
||||
String *goops_name = goopsNameMapping(proc_name, (char *)"");
|
||||
if (Getattr(known_classes, pb)) {
|
||||
Printv(goopscode, "(define-method (", goops_name, args, ")\n", NIL);
|
||||
Printv(goopscode, " (make <", pb, "> #:init-smob (", primRenamer ? "primitive:" : "", NIL);
|
||||
Printv(goopscode, proc_name, wrapargs, ")))\n", NIL);
|
||||
} else {
|
||||
Printv(goopscode, "(define-method (", goops_name, args, ")\n", NIL);
|
||||
Printv(goopscode, primRenamer ? " (primitive:" : " (", proc_name, wrapargs, "))\n", NIL);
|
||||
}
|
||||
Printv(goopscode, "(define-method (", goops_name, args, ")\n", NIL);
|
||||
Printv(goopscode, primRenamer ? " (primitive:" : " (", proc_name, wrapargs, "))\n", NIL);
|
||||
Printf(goopsexport, "%s ", goops_name);
|
||||
Delete(pb);
|
||||
Delete(goops_name);
|
||||
Delete(wrapargs);
|
||||
Delete(args);
|
||||
|
|
@ -1237,23 +1236,8 @@ public:
|
|||
if (primRenamer)
|
||||
Printv(primitive_name, "primitive:", NIL);
|
||||
Printv(primitive_name, proc_name, NIL);
|
||||
if (Getattr(known_classes, class_name)) {
|
||||
/* Create a procedure or p-w-s that handles the GOOPS object */
|
||||
if (!Getattr(n, "feature:immutable")) {
|
||||
Printv(goopscode, "(define ", goops_name, " (make-procedure-with-setter\n",
|
||||
"\t(lambda () (make <", class_name, "> #:init-smob (", primitive_name, ")))\n",
|
||||
"\t(lambda (new-value) (", primitive_name, " (slot-ref new-value 'smob))))\n",
|
||||
NIL);
|
||||
}
|
||||
else {
|
||||
Printv(goopscode, "(define (", goops_name, ")\n",
|
||||
" (make <", class_name, "> #:init-smob (", primitive_name, ")))");
|
||||
}
|
||||
Printf(goopscode, "\n");
|
||||
} else {
|
||||
/* Simply re-export the procedure */
|
||||
Printv(goopscode, "(define ", goops_name, " ", primitive_name, ")\n", NIL);
|
||||
}
|
||||
/* Simply re-export the procedure */
|
||||
Printv(goopscode, "(define ", goops_name, " ", primitive_name, ")\n", NIL);
|
||||
Printf(goopsexport, "%s ", goops_name);
|
||||
Delete(primitive_name);
|
||||
Delete(class_name);
|
||||
|
|
@ -1456,9 +1440,20 @@ public:
|
|||
} else {
|
||||
Printv(goopscode,"(<swig>)\n", NIL);
|
||||
}
|
||||
SwigType *t = NewStringf("p.%s", Getattr(n, "name"));
|
||||
swigtype_ptr = SwigType_manglestr(t);
|
||||
Delete(t);
|
||||
SwigType *ct = NewStringf("p.%s", Getattr(n, "name"));
|
||||
swigtype_ptr = SwigType_manglestr(ct);
|
||||
|
||||
String *mangled_classname = Swig_name_mangle(Getattr(n, "sym:name"));
|
||||
/* Export clientdata structure */
|
||||
if (use_scm_interface) {
|
||||
Printf(f_runtime, "static swig_guile_clientdata _swig_guile_clientdata%s = { NULL, SCM_EOL };\n",
|
||||
mangled_classname);
|
||||
|
||||
Printv(f_init, "SWIG_TypeClientData(SWIGTYPE", swigtype_ptr,
|
||||
", (void *) &_swig_guile_clientdata", mangled_classname, ");\n", NIL);
|
||||
SwigType_remember(ct);
|
||||
}
|
||||
Delete(ct);
|
||||
|
||||
/* Emit all of the members */
|
||||
goops_class_methods = NewString("");
|
||||
|
|
@ -1472,10 +1467,40 @@ public:
|
|||
if (have_constructor)
|
||||
Printv(goopscode," #:new-function ", primRenamer ? "primitive:" : "",
|
||||
"new-", short_class_name, "\n", NIL);
|
||||
|
||||
Printf(goopscode,")\n%s\n", goops_class_methods);
|
||||
Delete(goops_class_methods);
|
||||
goops_class_methods = 0;
|
||||
|
||||
|
||||
/* export class initialization function */
|
||||
if (goops) {
|
||||
/* export the wrapper function */
|
||||
String *funcName = NewString(mangled_classname);
|
||||
Printf(funcName, "_swig_guile_setgoopsclass");
|
||||
String *guileFuncName = NewString(funcName);
|
||||
Replaceall(guileFuncName, "_", "-");
|
||||
|
||||
Printv(f_wrappers, "static SCM ", funcName, "(SCM cl) \n", NIL);
|
||||
Printf(f_wrappers, "#define FUNC_NAME %s\n{\n", guileFuncName);
|
||||
Printv(f_wrappers, " ((swig_guile_clientdata *)(SWIGTYPE", swigtype_ptr,
|
||||
"->clientdata))->goops_class = cl;\n", NIL);
|
||||
Printf(f_wrappers, " return SCM_UNSPECIFIED;\n");
|
||||
Printf(f_wrappers, "}\n#undef FUNC_NAME\n\n");
|
||||
|
||||
Printf(f_init, "scm_c_define_gsubr(\"%s\", 1, 0, 0, (swig_guile_proc) %s);\n",
|
||||
guileFuncName, funcName);
|
||||
Printf(exported_symbols, "\"%s\", ", guileFuncName);
|
||||
|
||||
/* export the call to the wrapper function */
|
||||
Printf(goopscode, "(%s%s %s)\n\n", primRenamer ? "primitive:" : "", guileFuncName, class_name);
|
||||
|
||||
Delete(guileFuncName);
|
||||
Delete(funcName);
|
||||
}
|
||||
|
||||
Delete(mangled_classname);
|
||||
|
||||
Delete(swigtype_ptr);
|
||||
swigtype_ptr = 0;
|
||||
|
||||
|
|
@ -1495,34 +1520,42 @@ public:
|
|||
void buildGoopsArguments(ParmList *l, String *args, String *wrapargs) {
|
||||
Parm *p;
|
||||
Node *search;
|
||||
int i;
|
||||
int argnum = 0;
|
||||
|
||||
/* input arguments */
|
||||
for (i=0, p=l; p; i++) {
|
||||
while (checkAttribute(p,"tmap:in:numinputs","0")) {
|
||||
if (Getattr(p, "tmap:in:next")) {
|
||||
p = Getattr(p,"tmap:in:next");
|
||||
} else {
|
||||
break;
|
||||
}
|
||||
for (p=l; p; p = nextSibling(p)) {
|
||||
while (p && checkAttribute(p,"tmap:in:numinputs","0")) {
|
||||
p = Getattr(p,"tmap:in:next");
|
||||
}
|
||||
|
||||
if (!p) break;
|
||||
|
||||
SwigType *pt = Getattr(p,"type");
|
||||
String *pn = Getattr(p,"name");
|
||||
SwigType *pb = SwigType_typedef_resolve_all(SwigType_base(pt));
|
||||
|
||||
String *argname;
|
||||
argnum++;
|
||||
if (pn)
|
||||
argname = pn;
|
||||
else {
|
||||
/* Anonymous arg */
|
||||
argname = NewStringf("arg%d", argnum);
|
||||
}
|
||||
|
||||
if (strcmp("void", Char(pt)) != 0) {
|
||||
/* do input conversion */
|
||||
if ((search = Getattr(known_classes, pb))) {
|
||||
Printv(wrapargs, " (slot-ref ", pn, " 'smob)", NIL);
|
||||
Printv(args, " (", pn, " <", pb, ">)", NIL);
|
||||
Printv(wrapargs, " (slot-ref ", argname, " 'swig-smob)", NIL);
|
||||
Printv(args, " (", argname, " <", pb, ">)", NIL);
|
||||
} else {
|
||||
Printv(wrapargs, " ", pn, NIL);
|
||||
Printv(args, " ", pn, NIL);
|
||||
Printv(wrapargs, " ", argname, NIL);
|
||||
Printv(args, " ", argname, NIL);
|
||||
}
|
||||
}
|
||||
if (!pn) {
|
||||
Delete(argname);
|
||||
}
|
||||
|
||||
p = nextSibling(p);
|
||||
}
|
||||
|
||||
Replaceall(args, "_", "-");
|
||||
|
|
@ -1534,7 +1567,6 @@ public:
|
|||
* ------------------------------------------------------------ */
|
||||
int memberfunctionHandler(Node *n) {
|
||||
String *iname = Getattr(n,"sym:name");
|
||||
SwigType *d = Getattr(n,"type");
|
||||
String *args;
|
||||
String *wrapargs;
|
||||
|
||||
|
|
@ -1547,21 +1579,12 @@ public:
|
|||
String *proc = NewString(iname);
|
||||
Replaceall(proc,"_", "-");
|
||||
|
||||
String *pb = SwigType_typedef_resolve_all(SwigType_base(d));
|
||||
String *goops_name = goopsNameMapping(proc, short_class_name);
|
||||
if (Getattr(known_classes, pb)) {
|
||||
Printv(goops_class_methods,
|
||||
"(define-method (", goops_name, " (swig_smob ", class_name, ")", args, ")\n",
|
||||
" (make <", pb, "> #:init-smob (", primRenamer ? "primitive:" : "", short_class_name, "-", proc,
|
||||
" (slot-ref swig_smob 'smob)", wrapargs, ")))\n", NIL);
|
||||
} else {
|
||||
Printv(goops_class_methods,
|
||||
Printv(goops_class_methods,
|
||||
"(define-method (", goops_name, " (swig_smob ", class_name, ")", args, ")\n",
|
||||
primRenamer ? " (primitive:" : " (", short_class_name, "-", proc,
|
||||
" (slot-ref swig_smob 'smob)", wrapargs, "))\n", NIL);
|
||||
}
|
||||
" (slot-ref swig_smob 'swig-smob)", wrapargs, "))\n", NIL);
|
||||
Printf(goopsexport, "%s ", goops_name);
|
||||
Delete(pb);
|
||||
Delete(goops_name);
|
||||
|
||||
Delete(wrapargs);
|
||||
|
|
@ -1576,8 +1599,6 @@ public:
|
|||
int membervariableHandler(Node *n)
|
||||
{
|
||||
String *iname = Getattr(n,"sym:name");
|
||||
String *search;
|
||||
String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));
|
||||
|
||||
if (emit_setters) {
|
||||
struct_member = 1;
|
||||
|
|
@ -1591,29 +1612,18 @@ public:
|
|||
struct_member = 0;
|
||||
}
|
||||
|
||||
bool class_found = false;
|
||||
if ((search = Getattr(known_classes, pb))) {
|
||||
class_found = true;
|
||||
}
|
||||
|
||||
String *proc = NewString(iname);
|
||||
Replaceall(proc,"_", "-");
|
||||
String *goops_name = goopsNameMapping(proc, short_class_name);
|
||||
|
||||
Printv(goopscode, " (", goops_name, " #:allocation", NIL);
|
||||
if (class_found) {
|
||||
Printv(goopscode, " #:swig-virtual-class", NIL);
|
||||
} else {
|
||||
Printv(goopscode, " #:swig-virtual", NIL);
|
||||
}
|
||||
Printv(goopscode, " (", goops_name, " #:allocation #:virtual", NIL);
|
||||
Printv(goopscode, " #:slot-ref ", primRenamer ? "primitive:" : "",
|
||||
short_class_name, "-", proc, "-get", NIL);
|
||||
if (!Getattr(n,"feature:immutable")) {
|
||||
Printv(goopscode, " #:slot-set! ", primRenamer ? "primitive:" : "",
|
||||
short_class_name, "-", proc, "-set", NIL);
|
||||
}
|
||||
if (class_found) {
|
||||
Printv(goopscode, " #:class <", pb, ">", NIL);
|
||||
} else {
|
||||
Printf(goopscode, " #:slot-set! (lambda (obj value) (error \"Immutable slot\"))");
|
||||
}
|
||||
if (emit_slot_accessors) {
|
||||
if (Getattr(n, "feature:immutable")) {
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue