jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge new set of GOOPS changes by John Lenz.

Browse source 
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/SWIG@5255 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Matthias Köppe 2003-11-02 23:15:59 +00:00
commit c7340a0bf3
1 changed files with 137 additions and 127 deletions
Download patch file Download diff file Expand all files Collapse all files

264
Source/Modules/guile.cxx
View file

@ -56,11 +56,11 @@ Guile Options (available with -guile)\n\
`ltdlmod' for Guile's old dynamic module\n\ `ltdlmod' for Guile's old dynamic module\n\
convention (Guile <= 1.4), or `hobbit' for hobbit\n\ convention (Guile <= 1.4), or `hobbit' for hobbit\n\
modules.\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\ exports; only with `passive' and `simple' linkage\n\
-gh - Use the gh_ Guile API. (Guile <= 1.8, default) \n\ -gh - Use the gh_ Guile API. (Guile <= 1.8, default) \n\
-scm - Use the scm Guile API. (Guile >= 1.6) \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\ -emitslotaccessors - Emit accessor methods for all GOOPS slots\n\
-primsuffix <suffix> - Name appended to primitive module when exporting\n\ -primsuffix <suffix> - Name appended to primitive module when exporting\n\
GOOPS classes. (default = \"primitive\")\n\ GOOPS classes. (default = \"primitive\")\n\
@ -86,10 +86,10 @@ static enum {
GUILE_LSTYLE_HOBBIT // use (hobbit4d link) GUILE_LSTYLE_HOBBIT // use (hobbit4d link)
} linkage = GUILE_LSTYLE_SIMPLE; } linkage = GUILE_LSTYLE_SIMPLE;
static File *procdoc = 0; static File *procdoc = 0;
static File *scmstub = 0; static bool scmstub = false;
static String *scmtext; static String *scmtext;
static File *goopsfile = 0; static bool goops = false;
static String *goopstext; static String *goopstext;
static String *goopscode; static String *goopscode;
static String *goopsexport; static String *goopsexport;
@ -236,24 +236,12 @@ public:
Swig_mark_arg (i); Swig_mark_arg (i);
} }
else if (strcmp (argv[i], "-scmstub") == 0) { else if (strcmp (argv[i], "-scmstub") == 0) {
if (argv[i + 1]) { scmstub = true;
scmstub = NewFile(argv[i + 1], (char *) "w"); Swig_mark_arg(i);
Swig_mark_arg (i);
Swig_mark_arg (i + 1);
i++;
} else {
Swig_arg_error();
}
} }
else if (strcmp (argv[i], "-goops") == 0) { else if (strcmp (argv[i], "-shadow") == 0) {
if (argv[i + 1]) { goops = true;
goopsfile = NewFile(argv[i + 1], (char *) "w"); Swig_mark_arg(i);
Swig_mark_arg (i);
Swig_mark_arg (i + 1);
i++;
} else {
Swig_arg_error();
}
} }
else if (strcmp(argv[i], "-gh") == 0) { else if (strcmp(argv[i], "-gh") == 0) {
use_scm_interface = 0; use_scm_interface = 0;
@ -300,15 +288,15 @@ public:
primsuffix = NewString("primitive"); primsuffix = NewString("primitive");
//goops support can only be enabled if passive or module linkage is used //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) { if (linkage != GUILE_LSTYLE_PASSIVE && linkage != GUILE_LSTYLE_MODULE) {
Printf(stderr, "guile: GOOPS support requires passive or module linkage\n"); Printf(stderr, "guile: GOOPS support requires passive or module linkage\n");
exit(1); exit(1);
} }
} }
if (goopsfile) { if (goops) {
// -goops implies -emit-setters // -shadow implies -emit-setters
emit_setters = 1; emit_setters = 1;
} }
@ -435,14 +423,6 @@ public:
Delete(procdoc); Delete(procdoc);
procdoc = NULL; procdoc = NULL;
} }
if (scmstub) {
Delete(scmstub);
scmstub = NULL;
}
if (goopsfile) {
Delete(goopsfile);
goopsfile = NULL;
}
Delete(goopscode); Delete(goopscode);
Delete(goopsexport); Delete(goopsexport);
Delete(goopstext); Delete(goopstext);
@ -468,7 +448,7 @@ public:
} }
Printv(module_func,module_name,NIL); Printv(module_func,module_name,NIL);
if (goopsfile) if (goops)
Replaceall(module_func,"-", "_"); Replaceall(module_func,"-", "_");
switch (linkage) { switch (linkage) {
@ -518,7 +498,7 @@ public:
Printf (f_init, "SCM\n%s (void)\n{\n", module_func); Printf (f_init, "SCM\n%s (void)\n{\n", module_func);
{ {
String *mod = NewString(module_name); String *mod = NewString(module_name);
if (goopsfile) if (goops)
Printv(mod,"-",primsuffix,NIL); Printv(mod,"-",primsuffix,NIL);
Replaceall(mod,"/", " "); Replaceall(mod,"/", " ");
Printf(f_init, " SCM module = scm_c_define_module(\"%s\",\n", mod); Printf(f_init, " SCM module = scm_c_define_module(\"%s\",\n", mod);
@ -549,32 +529,55 @@ public:
if (scmstub) { if (scmstub) {
/* Emit Scheme stub if requested */ /* Emit Scheme stub if requested */
String *mod = NewString(module_name); String *primitive_name = NewString(module_name);
if (goopsfile) if (goops)
Printv(mod,"-",primsuffix,NIL); Printv(primitive_name,"-",primsuffix,NIL);
String *mod = NewString(primitive_name);
Replaceall(mod, "/", " "); 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 if (linkage == GUILE_LSTYLE_SIMPLE
|| linkage == GUILE_LSTYLE_PASSIVE) || linkage == GUILE_LSTYLE_PASSIVE)
Printf (scmstub, "(define-module (%s))\n\n", mod); Printf (scmstubfile, "(define-module (%s))\n\n", mod);
Delete(mod); Delete(mod);
Printf (scmstub, "%s", scmtext); Printf (scmstubfile, "%s", scmtext);
if ((linkage == GUILE_LSTYLE_SIMPLE if ((linkage == GUILE_LSTYLE_SIMPLE
|| linkage == GUILE_LSTYLE_PASSIVE) || linkage == GUILE_LSTYLE_PASSIVE)
&& Len(exported_symbols) > 0) { && Len(exported_symbols) > 0) {
String *ex = NewString(exported_symbols); String *ex = NewString(exported_symbols);
Replaceall(ex, ", ", "\n "); Replaceall(ex, ", ", "\n ");
Replaceall(ex, "\"", ""); Replaceall(ex, "\"", "");
Chop(ex); Chop(ex);
Printf(scmstub, "\n(export %s)\n", ex); Printf(scmstubfile, "\n(export %s)\n", ex);
Delete(ex); Delete(ex);
} }
} }
if (goopsfile) { if (goops) {
String *mod = NewString(module_name); String *mod = NewString(module_name);
Replaceall(mod, "/", " "); 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, ";;; -*- buffer-read-only: t -*- vi: set ro: */\n");
Printf (goopsfile, ";;; Automatically generated by SWIG; do not edit.\n\n"); Printf (goopsfile, ";;; Automatically generated by SWIG; do not edit.\n\n");
Printf (goopsfile, "(define-module (%s))\n", mod); Printf (goopsfile, "(define-module (%s))\n", mod);
@ -594,6 +597,7 @@ public:
Delete(ex); Delete(ex);
} }
Delete(mod); Delete(mod);
Delete(goopsfile);
} }
Delete(module_func); Delete(module_func);
@ -966,14 +970,14 @@ public:
if (use_scm_interface) { if (use_scm_interface) {
/* GOOPS support uses the MEMBER-set and MEMBER-get functions, /* GOOPS support uses the MEMBER-set and MEMBER-get functions,
so ignore only_setters in this case. */ 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", Printf(f_init, "scm_c_make_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
proc_name, numreq, numargs-numreq, wname); proc_name, numreq, numargs-numreq, wname);
else else
Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n", Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
proc_name, numreq, numargs-numreq, wname); proc_name, numreq, numargs-numreq, wname);
} else { } else {
if (only_setters && !goopsfile) if (only_setters && !goops)
Printf(f_init, "scm_make_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n", Printf(f_init, "scm_make_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
proc_name, numreq, numargs-numreq, wname); proc_name, numreq, numargs-numreq, wname);
else else
@ -1014,7 +1018,10 @@ public:
/* Register the function */ /* Register the function */
if (use_scm_interface) { if (use_scm_interface) {
if (exporting_destructor) { 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 { } else {
Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n", Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
proc_name, numreq, numargs-numreq, wname); proc_name, numreq, numargs-numreq, wname);
@ -1068,18 +1075,10 @@ public:
String *wrapargs = NewString(""); String *wrapargs = NewString("");
buildGoopsArguments(Getattr(n, "parms"), args, wrapargs); buildGoopsArguments(Getattr(n, "parms"), args, wrapargs);
String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));
String *goops_name = goopsNameMapping(proc_name, (char *)""); String *goops_name = goopsNameMapping(proc_name, (char *)"");
if (Getattr(known_classes, pb)) { Printv(goopscode, "(define-method (", goops_name, args, ")\n", NIL);
Printv(goopscode, "(define-method (", goops_name, args, ")\n", NIL); Printv(goopscode, primRenamer ? " (primitive:" : " (", proc_name, wrapargs, "))\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);
}
Printf(goopsexport, "%s ", goops_name); Printf(goopsexport, "%s ", goops_name);
Delete(pb);
Delete(goops_name); Delete(goops_name);
Delete(wrapargs); Delete(wrapargs);
Delete(args); Delete(args);
@ -1237,23 +1236,8 @@ public:
if (primRenamer) if (primRenamer)
Printv(primitive_name, "primitive:", NIL); Printv(primitive_name, "primitive:", NIL);
Printv(primitive_name, proc_name, NIL); Printv(primitive_name, proc_name, NIL);
if (Getattr(known_classes, class_name)) { /* Simply re-export the procedure */
/* Create a procedure or p-w-s that handles the GOOPS object */ Printv(goopscode, "(define ", goops_name, " ", primitive_name, ")\n", NIL);
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);
}
Printf(goopsexport, "%s ", goops_name); Printf(goopsexport, "%s ", goops_name);
Delete(primitive_name); Delete(primitive_name);
Delete(class_name); Delete(class_name);
@ -1456,9 +1440,20 @@ public:
} else { } else {
Printv(goopscode,"(<swig>)\n", NIL); Printv(goopscode,"(<swig>)\n", NIL);
} }
SwigType *t = NewStringf("p.%s", Getattr(n, "name")); SwigType *ct = NewStringf("p.%s", Getattr(n, "name"));
swigtype_ptr = SwigType_manglestr(t); swigtype_ptr = SwigType_manglestr(ct);
Delete(t);
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 */ /* Emit all of the members */
goops_class_methods = NewString(""); goops_class_methods = NewString("");
@ -1472,10 +1467,40 @@ public:
if (have_constructor) if (have_constructor)
Printv(goopscode," #:new-function ", primRenamer ? "primitive:" : "", Printv(goopscode," #:new-function ", primRenamer ? "primitive:" : "",
"new-", short_class_name, "\n", NIL); "new-", short_class_name, "\n", NIL);
Printf(goopscode,")\n%s\n", goops_class_methods); Printf(goopscode,")\n%s\n", goops_class_methods);
Delete(goops_class_methods); Delete(goops_class_methods);
goops_class_methods = 0; 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); Delete(swigtype_ptr);
swigtype_ptr = 0; swigtype_ptr = 0;
@ -1495,34 +1520,42 @@ public:
void buildGoopsArguments(ParmList *l, String *args, String *wrapargs) { void buildGoopsArguments(ParmList *l, String *args, String *wrapargs) {
Parm *p; Parm *p;
Node *search; Node *search;
int i; int argnum = 0;
/* input arguments */ /* input arguments */
for (i=0, p=l; p; i++) { for (p=l; p; p = nextSibling(p)) {
while (checkAttribute(p,"tmap:in:numinputs","0")) { while (p && checkAttribute(p,"tmap:in:numinputs","0")) {
if (Getattr(p, "tmap:in:next")) { p = Getattr(p,"tmap:in:next");
p = Getattr(p,"tmap:in:next");
} else {
break;
}
} }
if (!p) break;
SwigType *pt = Getattr(p,"type"); SwigType *pt = Getattr(p,"type");
String *pn = Getattr(p,"name"); String *pn = Getattr(p,"name");
SwigType *pb = SwigType_typedef_resolve_all(SwigType_base(pt)); 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) { if (strcmp("void", Char(pt)) != 0) {
/* do input conversion */ /* do input conversion */
if ((search = Getattr(known_classes, pb))) { if ((search = Getattr(known_classes, pb))) {
Printv(wrapargs, " (slot-ref ", pn, " 'smob)", NIL); Printv(wrapargs, " (slot-ref ", argname, " 'swig-smob)", NIL);
Printv(args, " (", pn, " <", pb, ">)", NIL); Printv(args, " (", argname, " <", pb, ">)", NIL);
} else { } else {
Printv(wrapargs, " ", pn, NIL); Printv(wrapargs, " ", argname, NIL);
Printv(args, " ", pn, NIL); Printv(args, " ", argname, NIL);
} }
} }
if (!pn) {
Delete(argname);
}
p = nextSibling(p);
} }
Replaceall(args, "_", "-"); Replaceall(args, "_", "-");
@ -1534,7 +1567,6 @@ public:
* ------------------------------------------------------------ */ * ------------------------------------------------------------ */
int memberfunctionHandler(Node *n) { int memberfunctionHandler(Node *n) {
String *iname = Getattr(n,"sym:name"); String *iname = Getattr(n,"sym:name");
SwigType *d = Getattr(n,"type");
String *args; String *args;
String *wrapargs; String *wrapargs;
@ -1547,21 +1579,12 @@ public:
String *proc = NewString(iname); String *proc = NewString(iname);
Replaceall(proc,"_", "-"); Replaceall(proc,"_", "-");
String *pb = SwigType_typedef_resolve_all(SwigType_base(d));
String *goops_name = goopsNameMapping(proc, short_class_name); String *goops_name = goopsNameMapping(proc, short_class_name);
if (Getattr(known_classes, pb)) { Printv(goops_class_methods,
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,
"(define-method (", goops_name, " (swig_smob ", class_name, ")", args, ")\n", "(define-method (", goops_name, " (swig_smob ", class_name, ")", args, ")\n",
primRenamer ? " (primitive:" : " (", short_class_name, "-", proc, 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); Printf(goopsexport, "%s ", goops_name);
Delete(pb);
Delete(goops_name); Delete(goops_name);
Delete(wrapargs); Delete(wrapargs);
@ -1576,8 +1599,6 @@ public:
int membervariableHandler(Node *n) int membervariableHandler(Node *n)
{ {
String *iname = Getattr(n,"sym:name"); String *iname = Getattr(n,"sym:name");
String *search;
String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));
if (emit_setters) { if (emit_setters) {
struct_member = 1; struct_member = 1;
@ -1591,29 +1612,18 @@ public:
struct_member = 0; struct_member = 0;
} }
bool class_found = false;
if ((search = Getattr(known_classes, pb))) {
class_found = true;
}
String *proc = NewString(iname); String *proc = NewString(iname);
Replaceall(proc,"_", "-"); Replaceall(proc,"_", "-");
String *goops_name = goopsNameMapping(proc, short_class_name); String *goops_name = goopsNameMapping(proc, short_class_name);
Printv(goopscode, " (", goops_name, " #:allocation", NIL); Printv(goopscode, " (", goops_name, " #:allocation #:virtual", NIL);
if (class_found) {
Printv(goopscode, " #:swig-virtual-class", NIL);
} else {
Printv(goopscode, " #:swig-virtual", NIL);
}
Printv(goopscode, " #:slot-ref ", primRenamer ? "primitive:" : "", Printv(goopscode, " #:slot-ref ", primRenamer ? "primitive:" : "",
short_class_name, "-", proc, "-get", NIL); short_class_name, "-", proc, "-get", NIL);
if (!Getattr(n,"feature:immutable")) { if (!Getattr(n,"feature:immutable")) {
Printv(goopscode, " #:slot-set! ", primRenamer ? "primitive:" : "", Printv(goopscode, " #:slot-set! ", primRenamer ? "primitive:" : "",
short_class_name, "-", proc, "-set", NIL); short_class_name, "-", proc, "-set", NIL);
} } else {
if (class_found) { Printf(goopscode, " #:slot-set! (lambda (obj value) (error \"Immutable slot\"))");
Printv(goopscode, " #:class <", pb, ">", NIL);
} }
if (emit_slot_accessors) { if (emit_slot_accessors) {
if (Getattr(n, "feature:immutable")) { if (Getattr(n, "feature:immutable")) {