1 /* -----------------------------------------------------------------------------
2 * See the LICENSE file for information on copyright, usage and redistribution
3 * of SWIG, and the README file for authors - http://www.swig.org/release.html.
7 * clisp language module for SWIG.
8 * ----------------------------------------------------------------------------- */
10 char cvsroot_clisp_cxx[] = "$Id: clisp.cxx 11380 2009-07-08 12:17:45Z wsfulton $";
14 class CLISP:public Language {
18 virtual void main(int argc, char *argv[]);
19 virtual int top(Node *n);
20 virtual int functionWrapper(Node *n);
21 virtual int variableWrapper(Node *n);
22 virtual int constantWrapper(Node *n);
23 virtual int classDeclaration(Node *n);
24 virtual int enumDeclaration(Node *n);
25 virtual int typedefHandler(Node *n);
28 String *get_ffi_type(Node *n, SwigType *ty);
29 String *convert_literal(String *num_param, String *type);
30 String *strip_parens(String *string);
32 int generate_typedef_flag;
36 void CLISP::main(int argc, char *argv[]) {
39 Preprocessor_define("SWIGCLISP 1", 0);
40 SWIG_library_directory("clisp");
41 SWIG_config_file("clisp.swg");
42 generate_typedef_flag = 0;
45 for (i = 1; i < argc; i++) {
46 if (!strcmp(argv[i], "-help")) {
47 Printf(stdout, "clisp Options (available with -clisp)\n");
50 "\t If this option is given then clisp definitions for all the functions\n"
51 "and global variables will be created otherwise only definitions for \n"
52 "externed functions and variables are created.\n"
53 " -generate-typedef\n"
54 "\t If this option is given then def-c-type will be used to generate shortcuts\n"
55 "according to the typedefs in the input.\n");
56 } else if ((Strcmp(argv[i], "-extern-all") == 0)) {
59 } else if ((Strcmp(argv[i], "-generate-typedef") == 0)) {
60 generate_typedef_flag = 1;
66 int CLISP::top(Node *n) {
68 File *f_null = NewString("");
69 module = Getattr(n, "name");
70 String *output_filename;
73 /* Get the output file name */
74 String *outfile = Getattr(n, "outfile");
77 output_filename = outfile;
79 output_filename = NewString("");
80 Printf(output_filename, "%s%s.lisp", SWIG_output_directory(), module);
83 f_cl = NewFile(output_filename, "w+", SWIG_output_files());
85 FileErrorDisplay(output_filename);
86 SWIG_exit(EXIT_FAILURE);
89 Swig_register_filebyname("header", f_null);
90 Swig_register_filebyname("begin", f_null);
91 Swig_register_filebyname("runtime", f_null);
92 Swig_register_filebyname("wrapper", f_null);
94 String *header = NewString("");
96 Swig_banner_target_lang(header, ";;");
98 Printf(header, "\n(defpackage :%s\n (:use :common-lisp :ffi)", module);
104 long len = Len(entries);
106 Printf(header, "\n (:export");
108 //else nothing to export
110 for (i = First(entries); i.item; i = Next(i)) {
111 Printf(header, "\n\t:%s", i.item);
118 Printf(header, ")\n");
119 Printf(header, "\n(in-package :%s)\n", module);
120 Printf(header, "\n(default-foreign-language :stdc)\n");
124 Printf(f_cl, "%s", header);
126 long end = Tell(f_cl);
128 for (len--; len >= 0; len--) {
130 Seek(f_cl, len, SEEK_SET);
132 Seek(f_cl, end, SEEK_SET);
136 Seek(f_cl, 0, SEEK_SET);
137 Write(f_cl, Char(header), Len(header));
140 Delete(f_cl); // Deletes the handle, not the file
146 int CLISP::functionWrapper(Node *n) {
148 String *storage = Getattr(n, "storage");
149 if (!extern_all_flag && (!storage || (Strcmp(storage, "extern") && Strcmp(storage, "externc"))))
152 String *func_name = Getattr(n, "sym:name");
154 ParmList *pl = Getattr(n, "parms");
156 int argnum = 0, first = 1;
158 Printf(f_cl, "\n(ffi:def-call-out %s\n\t(:name \"%s\")\n", func_name, func_name);
160 Append(entries, func_name);
162 if (ParmList_len(pl) != 0) {
163 Printf(f_cl, "\t(:arguments ");
165 for (Parm *p = pl; p; p = nextSibling(p), argnum++) {
167 String *argname = Getattr(p, "name");
168 // SwigType *argtype;
170 String *ffitype = get_ffi_type(n, Getattr(p, "type"));
175 argname = NewStringf("arg%d", argnum);
180 Printf(f_cl, "\n\t\t");
182 Printf(f_cl, "(%s %s)", argname, ffitype);
190 if (ParmList_len(pl) != 0) {
191 Printf(f_cl, ")\n"); /* finish arg list */
193 String *ffitype = get_ffi_type(n, Getattr(n, "type"));
194 if (Strcmp(ffitype, "NIL")) { //when return type is not nil
195 Printf(f_cl, "\t(:return-type %s)\n", ffitype);
197 Printf(f_cl, "\t(:library +library-name+))\n");
203 int CLISP::constantWrapper(Node *n) {
205 String *type = Getattr(n, "type");
206 String *converted_value = convert_literal(Getattr(n, "value"), type);
207 String *name = Getattr(n, "sym:name");
209 Printf(f_cl, "\n(defconstant %s %s)\n", name, converted_value);
210 Append(entries, name);
211 Delete(converted_value);
216 int CLISP::variableWrapper(Node *n) {
219 String *storage = Getattr(n, "storage");
221 if (!extern_all_flag && (!storage || (Strcmp(storage, "extern") && Strcmp(storage, "externc"))))
224 String *var_name = Getattr(n, "sym:name");
225 String *lisp_type = get_ffi_type(n, Getattr(n, "type"));
226 Printf(f_cl, "\n(ffi:def-c-var %s\n (:name \"%s\")\n (:type %s)\n", var_name, var_name, lisp_type);
227 Printf(f_cl, "\t(:library +library-name+))\n");
228 Append(entries, var_name);
234 int CLISP::typedefHandler(Node *n) {
235 if (generate_typedef_flag) {
237 Printf(f_cl, "\n(ffi:def-c-type %s %s)\n", Getattr(n, "name"), get_ffi_type(n, Getattr(n, "type")));
240 return Language::typedefHandler(n);
243 int CLISP::enumDeclaration(Node *n) {
245 String *name = Getattr(n, "sym:name");
247 Printf(f_cl, "\n(ffi:def-c-enum %s ", name);
249 for (Node *c = firstChild(n); c; c = nextSibling(c)) {
251 String *slot_name = Getattr(c, "name");
252 String *value = Getattr(c, "enumvalue");
254 Printf(f_cl, "(%s %s)", slot_name, value);
256 Append(entries, slot_name);
267 int CLISP::classDeclaration(Node *n) {
269 String *name = Getattr(n, "sym:name");
270 String *kind = Getattr(n, "kind");
272 if (Strcmp(kind, "struct")) {
273 Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
274 Printf(stderr, " (name: %s)\n", name);
275 SWIG_exit(EXIT_FAILURE);
279 Printf(f_cl, "\n(ffi:def-c-struct %s", name);
281 Append(entries, NewStringf("make-%s", name));
283 for (Node *c = firstChild(n); c; c = nextSibling(c)) {
285 if (Strcmp(nodeType(c), "cdecl")) {
286 Printf(stderr, "Structure %s has a slot that we can't deal with.\n", name);
287 Printf(stderr, "nodeType: %s, name: %s, type: %s\n", nodeType(c), Getattr(c, "name"), Getattr(c, "type"));
288 SWIG_exit(EXIT_FAILURE);
291 String *temp = Copy(Getattr(c, "decl"));
292 Append(temp, Getattr(c, "type")); //appending type to the end, otherwise wrong type
293 String *lisp_type = get_ffi_type(n, temp);
296 String *slot_name = Getattr(c, "sym:name");
297 Printf(f_cl, "\n\t(%s %s)", slot_name, lisp_type);
299 Append(entries, NewStringf("%s-%s", name, slot_name));
306 /* Add this structure to the known lisp types */
307 //Printf(stdout, "Adding %s foreign type\n", name);
308 // add_defined_foreign_type(name);
314 /* returns new string w/ parens stripped */
315 String *CLISP::strip_parens(String *string) {
316 char *s = Char(string), *p;
317 int len = Len(string);
320 if (len == 0 || s[0] != '(' || s[len - 1] != ')') {
321 return NewString(string);
324 p = (char *) malloc(len - 2 + 1);
326 Printf(stderr, "Malloc failed\n");
327 SWIG_exit(EXIT_FAILURE);
330 strncpy(p, s + 1, len - 1);
331 p[len - 2] = 0; /* null terminate */
339 String *CLISP::convert_literal(String *num_param, String *type) {
340 String *num = strip_parens(num_param), *res;
343 /* Make sure doubles use 'd' instead of 'e' */
344 if (!Strcmp(type, "double")) {
345 String *updated = Copy(num);
346 if (Replace(updated, "e", "d", DOH_REPLACE_ANY) > 1) {
347 Printf(stderr, "Weird!! number %s looks invalid.\n", num);
348 SWIG_exit(EXIT_FAILURE);
354 if (SwigType_type(type) == T_CHAR) {
355 /* Use CL syntax for character literals */
356 return NewStringf("#\\%s", num_param);
357 } else if (SwigType_type(type) == T_STRING) {
358 /* Use CL syntax for string literals */
359 return NewStringf("\"%s\"", num_param);
362 if (Len(num) < 2 || s[0] != '0') {
368 res = NewStringf("#%c%s", s[1] == 'x' ? 'x' : 'o', s + 2);
374 String *CLISP::get_ffi_type(Node *n, SwigType *ty) {
375 Node *node = NewHash();
376 Setattr(node, "type", ty);
377 Setfile(node, Getfile(n));
378 Setline(node, Getline(n));
379 const String *tm = Swig_typemap_lookup("in", node, "", 0);
383 return NewString(tm);
384 } else if (SwigType_ispointer(ty)) {
385 SwigType *cp = Copy(ty);
386 SwigType_del_pointer(cp);
387 String *inner_type = get_ffi_type(n, cp);
389 if (SwigType_isfunction(cp)) {
393 SwigType *base = SwigType_base(ty);
394 String *base_name = SwigType_str(base, 0);
397 if (!Strcmp(base_name, "int") || !Strcmp(base_name, "float") || !Strcmp(base_name, "short")
398 || !Strcmp(base_name, "double") || !Strcmp(base_name, "long") || !Strcmp(base_name, "char")) {
400 str = NewStringf("(ffi:c-ptr %s)", inner_type);
402 str = NewStringf("(ffi:c-pointer %s)", inner_type);
409 } else if (SwigType_isarray(ty)) {
410 SwigType *cp = Copy(ty);
411 String *array_dim = SwigType_array_getdim(ty, 0);
413 if (!Strcmp(array_dim, "")) { //dimension less array convert to pointer
415 SwigType_del_array(cp);
416 SwigType_add_pointer(cp);
417 String *str = get_ffi_type(n, cp);
421 SwigType_pop_arrays(cp);
422 String *inner_type = get_ffi_type(n, cp);
425 int ndim = SwigType_array_ndim(ty);
428 dimension = array_dim;
430 dimension = array_dim;
431 for (int i = 1; i < ndim; i++) {
432 array_dim = SwigType_array_getdim(ty, i);
433 Append(dimension, " ");
434 Append(dimension, array_dim);
437 String *temp = dimension;
438 dimension = NewStringf("(%s)", dimension);
443 str = NewStringf("(ffi:c-ptr (ffi:c-array %s %s))", inner_type, dimension);
445 str = NewStringf("(ffi:c-array %s %s)", inner_type, dimension);
451 } else if (SwigType_isfunction(ty)) {
452 SwigType *cp = Copy(ty);
453 SwigType *fn = SwigType_pop_function(cp);
454 String *args = NewString("");
455 ParmList *pl = SwigType_function_parms(fn);
456 if (ParmList_len(pl) != 0) {
457 Printf(args, "(:arguments ");
459 int argnum = 0, first = 1;
460 for (Parm *p = pl; p; p = nextSibling(p), argnum++) {
461 String *argname = Getattr(p, "name");
462 SwigType *argtype = Getattr(p, "type");
463 String *ffitype = get_ffi_type(n, argtype);
468 argname = NewStringf("arg%d", argnum);
472 Printf(args, "\n\t\t");
474 Printf(args, "(%s %s)", argname, ffitype);
480 if (ParmList_len(pl) != 0) {
481 Printf(args, ")\n"); /* finish arg list */
483 String *ffitype = get_ffi_type(n, cp);
484 String *str = NewStringf("(ffi:c-function %s \t\t\t\t(:return-type %s))", args, ffitype);
491 String *str = SwigType_str(ty, 0);
493 char *st = Strstr(str, "struct");
496 return NewString(st);
498 char *cl = Strstr(str, "class");
501 return NewString(cl);
507 extern "C" Language *swig_clisp(void) {