Source/Modules/uffi.cxx - third_party/swig - Git at Google

 /* -----------------------------------------------------------------------------
  * This file is part of SWIG, which is licensed as a whole under version 3
  * (or any later version) of the GNU General Public License. Some additional
  * terms also apply to certain portions of SWIG. The full details of the SWIG
  * license and copyrights can be found in the LICENSE and COPYRIGHT files
  * included with the SWIG source code as distributed by the SWIG developers
  * and at http://www.swig.org/legal.html.
  *
  * uffi.cxx
  *
  * Uffi language module for SWIG.
  * ----------------------------------------------------------------------------- */

 // TODO: remove remnants of lisptype

 #include "swigmod.h"

 static const char *usage = "\
 UFFI Options (available with -uffi)\n\
      -identifier-converter <type or funcname> - \n\
                        Specifies the type of conversion to do on C identifiers\n\
                        to convert them to symbols. There are two built-in\n\
                        converters: 'null' and 'lispify'. The default is\n\
                        'null'. If you supply a name other than one of the\n\
                        built-ins, then a function by that name will be\n\
                        called to convert identifiers to symbols.\n\
 ";

 class UFFI:public Language {
 public:

   virtual void main(int argc, char *argv[]);
   virtual int top(Node *n);
   virtual int functionWrapper(Node *n);
   virtual int constantWrapper(Node *n);
   virtual int classHandler(Node *n);
   virtual int membervariableHandler(Node *n);

 };

 static File *f_cl = 0;

 static struct {
   int count;
   String **entries;
 } defined_foreign_types;

 static String *identifier_converter = NewString("identifier-convert-null");

 static int any_varargs(ParmList *pl) {
   Parm *p;

   for (p = pl; p; p = nextSibling(p)) {
     if (SwigType_isvarargs(Getattr(p, "type")))
       return 1;
   }

   return 0;
 }


 /* utilities */
 /* returns new string w/ parens stripped */
 static String *strip_parens(String *string) {
   char *s = Char(string), *p;
   int len = Len(string);
   String *res;

   if (len == 0 || s[0] != '(' || s[len - 1] != ')') {
     return NewString(string);
   }

   p = (char *) malloc(len - 2 + 1);
   if (!p) {
     Printf(stderr, "Malloc failed\n");
     SWIG_exit(EXIT_FAILURE);
   }

   strncpy(p, s + 1, len - 1);
   p[len - 2] = 0;		/* null terminate */

   res = NewString(p);
   free(p);

   return res;
 }


 static String *convert_literal(String *num_param, String *type) {
   String *num = strip_parens(num_param), *res;
   char *s = Char(num);

   /* Make sure doubles use 'd' instead of 'e' */
   if (!Strcmp(type, "double")) {
     String *updated = Copy(num);
     if (Replace(updated, "e", "d", DOH_REPLACE_ANY) > 1) {
       Printf(stderr, "Weird!! number %s looks invalid.\n", num);
       SWIG_exit(EXIT_FAILURE);
     }
     Delete(num);
     return updated;
   }

   if (SwigType_type(type) == T_CHAR) {
     /* Use CL syntax for character literals */
     return NewStringf("#\\%s", num_param);
   } else if (SwigType_type(type) == T_STRING) {
     /* Use CL syntax for string literals */
     return NewStringf("\"%s\"", num_param);
   }

   if (Len(num) < 2 || s[0] != '0') {
     return num;
   }

   /* octal or hex */

   res = NewStringf("#%c%s", s[1] == 'x' ? 'x' : 'o', s + 2);
   Delete(num);

   return res;
 }

 static void add_defined_foreign_type(String *type) {
   if (!defined_foreign_types.count) {
     /* Make fresh */
     defined_foreign_types.count = 1;
     defined_foreign_types.entries = (String **) malloc(sizeof(String *));
   } else {
     /* make room */
     defined_foreign_types.count++;
     defined_foreign_types.entries = (String **)
 	realloc(defined_foreign_types.entries, defined_foreign_types.count * sizeof(String *));
   }

   if (!defined_foreign_types.entries) {
     Printf(stderr, "Out of memory\n");
     SWIG_exit(EXIT_FAILURE);
   }

   /* Fill in the new data */
   defined_foreign_types.entries[defined_foreign_types.count - 1] = Copy(type);

 }


 static String *get_ffi_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
   Node *node = NewHash();
   Setattr(node, "type", ty);
   Setattr(node, "name", name);
   Setfile(node, Getfile(n));
   Setline(node, Getline(n));
   const String *tm = Swig_typemap_lookup("ffitype", node, "", 0);
   Delete(node);

   if (tm) {
     return NewString(tm);
   } else {
     SwigType *tr = SwigType_typedef_resolve_all(ty);
     char *type_reduced = Char(tr);
     int i;

     //Printf(stdout,"convert_type %s\n", ty);
     if (SwigType_isconst(tr)) {
       SwigType_pop(tr);
       type_reduced = Char(tr);
     }

     if (SwigType_ispointer(type_reduced) || SwigType_isarray(ty) || !strncmp(type_reduced, "p.f", 3)) {
       return NewString(":pointer-void");
     }

     for (i = 0; i < defined_foreign_types.count; i++) {
       if (!Strcmp(ty, defined_foreign_types.entries[i])) {
 	return NewStringf("#.(%s \"%s\" :type :type)", identifier_converter, ty);
       }
     }

     if (!Strncmp(type_reduced, "enum ", 5)) {
       return NewString(":int");
     }

     Printf(stderr, "Unsupported data type: %s (was: %s)\n", type_reduced, ty);
     SWIG_exit(EXIT_FAILURE);
   }
   return 0;
 }

 static String *get_lisp_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
   Node *node = NewHash();
   Setattr(node, "type", ty);
   Setattr(node, "name", name);
   Setfile(node, Getfile(n));
   Setline(node, Getline(n));
   const String *tm = Swig_typemap_lookup("lisptype", node, "", 0);
   Delete(node);

   return tm ? NewString(tm) : NewString("");
 }

 void UFFI::main(int argc, char *argv[]) {
   int i;

   Preprocessor_define("SWIGUFFI 1", 0);
   SWIG_library_directory("uffi");
   SWIG_config_file("uffi.swg");


   for (i = 1; i < argc; i++) {
     if (!strcmp(argv[i], "-identifier-converter")) {
       char *conv = argv[i + 1];

       if (!conv)
 	Swig_arg_error();

       Swig_mark_arg(i);
       Swig_mark_arg(i + 1);
       i++;

       /* check for built-ins */
       if (!strcmp(conv, "lispify")) {
 	Delete(identifier_converter);
 	identifier_converter = NewString("identifier-convert-lispify");
       } else if (!strcmp(conv, "null")) {
 	Delete(identifier_converter);
 	identifier_converter = NewString("identifier-convert-null");
       } else {
 	/* Must be user defined */
 	Delete(identifier_converter);
 	identifier_converter = NewString(conv);
       }
     }

     if (!strcmp(argv[i], "-help")) {
       Printf(stdout, "%s\n", usage);
     }
   }
 }

 int UFFI::top(Node *n) {
   String *module = Getattr(n, "name");
   String *output_filename = NewString("");
   File *f_null = NewString("");

   Printf(output_filename, "%s%s.cl", SWIG_output_directory(), module);


   f_cl = NewFile(output_filename, "w", SWIG_output_files());
   if (!f_cl) {
     FileErrorDisplay(output_filename);
     SWIG_exit(EXIT_FAILURE);
   }

   Swig_register_filebyname("header", f_null);
   Swig_register_filebyname("begin", f_null);
   Swig_register_filebyname("runtime", f_null);
   Swig_register_filebyname("wrapper", f_cl);

   Swig_banner_target_lang(f_cl, ";;");

   Printf(f_cl, "\n"
 	 ";; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; package: %s -*-\n\n(defpackage :%s\n  (:use :common-lisp :uffi))\n\n(in-package :%s)\n",
 	 module, module, module);
   Printf(f_cl, "(eval-when (compile load eval)\n  (defparameter *swig-identifier-converter* '%s))\n", identifier_converter);

   Language::top(n);

   Delete(f_cl);			// Delete the handle, not the file
   Delete(f_null);

   return SWIG_OK;
 }

 int UFFI::functionWrapper(Node *n) {
   String *funcname = Getattr(n, "sym:name");
   ParmList *pl = Getattr(n, "parms");
   Parm *p;
   int argnum = 0, first = 1;
 //  int varargs = 0;

   //Language::functionWrapper(n);

   Printf(f_cl, "(swig-defun \"%s\"\n", funcname);
   Printf(f_cl, "  (");

   /* Special cases */

   if (ParmList_len(pl) == 0) {
     Printf(f_cl, ":void");
   } else if (any_varargs(pl)) {
     Printf(f_cl, "#| varargs |#");
 //    varargs = 1;
   } else {
     for (p = pl; p; p = nextSibling(p), argnum++) {
       String *argname = Getattr(p, "name");
       SwigType *argtype = Getattr(p, "type");
       String *ffitype = get_ffi_type(n, argtype, argname);
       String *lisptype = get_lisp_type(n, argtype, argname);
       int tempargname = 0;

       if (!argname) {
 	argname = NewStringf("arg%d", argnum);
 	tempargname = 1;
       }

       if (!first) {
 	Printf(f_cl, "\n   ");
       }
       Printf(f_cl, "(%s %s %s)", argname, ffitype, lisptype);
       first = 0;

       Delete(ffitype);
       Delete(lisptype);
       if (tempargname)
 	Delete(argname);

     }
   }
   Printf(f_cl, ")\n");		/* finish arg list */
   Printf(f_cl, "  :returning %s\n"
 	 //"  :strings-convert t\n"
 	 //"  :call-direct %s\n"
 	 //"  :optimize-for-space t"
 	 ")\n", get_ffi_type(n, Getattr(n, "type"), Swig_cresult_name())
 	 //,varargs ? "nil"  : "t"
       );


   return SWIG_OK;
 }

 int UFFI::constantWrapper(Node *n) {
   String *type = Getattr(n, "type");
   String *converted_value = convert_literal(Getattr(n, "value"), type);
   String *name = Getattr(n, "sym:name");

 #if 0
   Printf(stdout, "constant %s is of type %s. value: %s\n", name, type, converted_value);
 #endif

   Printf(f_cl, "(swig-defconstant \"%s\" %s)\n", name, converted_value);

   Delete(converted_value);

   return SWIG_OK;
 }

 // Includes structs
 int UFFI::classHandler(Node *n) {

   String *name = Getattr(n, "sym:name");
   String *kind = Getattr(n, "kind");
   Node *c;

   if (Strcmp(kind, "struct")) {
     Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
     Printf(stderr, " (name: %s)\n", name);
     SWIG_exit(EXIT_FAILURE);
   }

   Printf(f_cl, "(swig-def-struct \"%s\"\n \n", name);

   for (c = firstChild(n); c; c = nextSibling(c)) {
     SwigType *type = Getattr(c, "type");
     SwigType *decl = Getattr(c, "decl");
     if (type) {
       type = Copy(type);
       SwigType_push(type, decl);
       String *lisp_type;

       if (Strcmp(nodeType(c), "cdecl")) {
 	Printf(stderr, "Structure %s has a slot that we can't deal with.\n", name);
 	Printf(stderr, "nodeType: %s, name: %s, type: %s\n", nodeType(c), Getattr(c, "name"), Getattr(c, "type"));
 	SWIG_exit(EXIT_FAILURE);
       }

       /* Printf(stdout, "Converting %s in %s\n", type, name); */
       lisp_type = get_ffi_type(n, type, Getattr(c, "sym:name"));

       Printf(f_cl, "  (#.(%s \"%s\" :type :slot) %s)\n", identifier_converter, Getattr(c, "sym:name"), lisp_type);

       Delete(lisp_type);
     }
   }

   // Language::classHandler(n);

   Printf(f_cl, " )\n");

   /* Add this structure to the known lisp types */
   //Printf(stdout, "Adding %s foreign type\n", name);
   add_defined_foreign_type(name);

   return SWIG_OK;
 }

 int UFFI::membervariableHandler(Node *n) {
   Language::membervariableHandler(n);
   return SWIG_OK;
 }


 extern "C" Language *swig_uffi(void) {
   return new UFFI();
 }
	/* -----------------------------------------------------------------------------
	* This file is part of SWIG, which is licensed as a whole under version 3
	* (or any later version) of the GNU General Public License. Some additional
	* terms also apply to certain portions of SWIG. The full details of the SWIG
	* license and copyrights can be found in the LICENSE and COPYRIGHT files
	* included with the SWIG source code as distributed by the SWIG developers
	* and at http://www.swig.org/legal.html.
	*
	* uffi.cxx
	*
	* Uffi language module for SWIG.
	* ----------------------------------------------------------------------------- */

	// TODO: remove remnants of lisptype

	#include "swigmod.h"

	static const char *usage = "\
	UFFI Options (available with -uffi)\n\
	-identifier-converter <type or funcname> - \n\
	Specifies the type of conversion to do on C identifiers\n\
	to convert them to symbols. There are two built-in\n\
	converters: 'null' and 'lispify'. The default is\n\
	'null'. If you supply a name other than one of the\n\
	built-ins, then a function by that name will be\n\
	called to convert identifiers to symbols.\n\
	";

	class UFFI:public Language {
	public:

	virtual void main(int argc, char *argv[]);
	virtual int top(Node *n);
	virtual int functionWrapper(Node *n);
	virtual int constantWrapper(Node *n);
	virtual int classHandler(Node *n);
	virtual int membervariableHandler(Node *n);

	};

	static File *f_cl = 0;

	static struct {
	int count;
	String **entries;
	} defined_foreign_types;

	static String *identifier_converter = NewString("identifier-convert-null");

	static int any_varargs(ParmList *pl) {
	Parm *p;

	for (p = pl; p; p = nextSibling(p)) {
	if (SwigType_isvarargs(Getattr(p, "type")))
	return 1;
	}

	return 0;
	}


	/* utilities */
	/* returns new string w/ parens stripped */
	static String strip_parens(String string) {
	char s = Char(string), p;
	int len = Len(string);
	String *res;

	if (len == 0 \|\| s[0] != '(' \|\| s[len - 1] != ')') {
	return NewString(string);
	}

	p = (char *) malloc(len - 2 + 1);
	if (!p) {
	Printf(stderr, "Malloc failed\n");
	SWIG_exit(EXIT_FAILURE);
	}

	strncpy(p, s + 1, len - 1);
	p[len - 2] = 0; /* null terminate */

	res = NewString(p);
	free(p);

	return res;
	}


	static String convert_literal(String num_param, String *type) {
	String num = strip_parens(num_param), res;
	char *s = Char(num);

	/* Make sure doubles use 'd' instead of 'e' */
	if (!Strcmp(type, "double")) {
	String *updated = Copy(num);
	if (Replace(updated, "e", "d", DOH_REPLACE_ANY) > 1) {
	Printf(stderr, "Weird!! number %s looks invalid.\n", num);
	SWIG_exit(EXIT_FAILURE);
	}
	Delete(num);
	return updated;
	}

	if (SwigType_type(type) == T_CHAR) {
	/* Use CL syntax for character literals */
	return NewStringf("#\\%s", num_param);
	} else if (SwigType_type(type) == T_STRING) {
	/* Use CL syntax for string literals */
	return NewStringf("\"%s\"", num_param);
	}

	if (Len(num) < 2 \|\| s[0] != '0') {
	return num;
	}

	/* octal or hex */

	res = NewStringf("#%c%s", s[1] == 'x' ? 'x' : 'o', s + 2);
	Delete(num);

	return res;
	}

	static void add_defined_foreign_type(String *type) {
	if (!defined_foreign_types.count) {
	/* Make fresh */
	defined_foreign_types.count = 1;
	defined_foreign_types.entries = (String *) malloc(sizeof(String ));
	} else {
	/* make room */
	defined_foreign_types.count++;
	defined_foreign_types.entries = (String **)
	realloc(defined_foreign_types.entries, defined_foreign_types.count * sizeof(String *));
	}

	if (!defined_foreign_types.entries) {
	Printf(stderr, "Out of memory\n");
	SWIG_exit(EXIT_FAILURE);
	}

	/* Fill in the new data */
	defined_foreign_types.entries[defined_foreign_types.count - 1] = Copy(type);

	}


	static String get_ffi_type(Node n, SwigType *ty, const_String_or_char_ptr name) {
	Node *node = NewHash();
	Setattr(node, "type", ty);
	Setattr(node, "name", name);
	Setfile(node, Getfile(n));
	Setline(node, Getline(n));
	const String *tm = Swig_typemap_lookup("ffitype", node, "", 0);
	Delete(node);

	if (tm) {
	return NewString(tm);
	} else {
	SwigType *tr = SwigType_typedef_resolve_all(ty);
	char *type_reduced = Char(tr);
	int i;

	//Printf(stdout,"convert_type %s\n", ty);
	if (SwigType_isconst(tr)) {
	SwigType_pop(tr);
	type_reduced = Char(tr);
	}

	if (SwigType_ispointer(type_reduced) \|\| SwigType_isarray(ty) \|\| !strncmp(type_reduced, "p.f", 3)) {
	return NewString(":pointer-void");
	}

	for (i = 0; i < defined_foreign_types.count; i++) {
	if (!Strcmp(ty, defined_foreign_types.entries[i])) {
	return NewStringf("#.(%s \"%s\" :type :type)", identifier_converter, ty);
	}
	}

	if (!Strncmp(type_reduced, "enum ", 5)) {
	return NewString(":int");
	}

	Printf(stderr, "Unsupported data type: %s (was: %s)\n", type_reduced, ty);
	SWIG_exit(EXIT_FAILURE);
	}
	return 0;
	}

	static String get_lisp_type(Node n, SwigType *ty, const_String_or_char_ptr name) {
	Node *node = NewHash();
	Setattr(node, "type", ty);
	Setattr(node, "name", name);
	Setfile(node, Getfile(n));
	Setline(node, Getline(n));
	const String *tm = Swig_typemap_lookup("lisptype", node, "", 0);
	Delete(node);

	return tm ? NewString(tm) : NewString("");
	}

	void UFFI::main(int argc, char *argv[]) {
	int i;

	Preprocessor_define("SWIGUFFI 1", 0);
	SWIG_library_directory("uffi");
	SWIG_config_file("uffi.swg");


	for (i = 1; i < argc; i++) {
	if (!strcmp(argv[i], "-identifier-converter")) {
	char *conv = argv[i + 1];

	if (!conv)
	Swig_arg_error();

	Swig_mark_arg(i);
	Swig_mark_arg(i + 1);
	i++;

	/* check for built-ins */
	if (!strcmp(conv, "lispify")) {
	Delete(identifier_converter);
	identifier_converter = NewString("identifier-convert-lispify");
	} else if (!strcmp(conv, "null")) {
	Delete(identifier_converter);
	identifier_converter = NewString("identifier-convert-null");
	} else {
	/* Must be user defined */
	Delete(identifier_converter);
	identifier_converter = NewString(conv);
	}
	}

	if (!strcmp(argv[i], "-help")) {
	Printf(stdout, "%s\n", usage);
	}
	}
	}

	int UFFI::top(Node *n) {
	String *module = Getattr(n, "name");
	String *output_filename = NewString("");
	File *f_null = NewString("");

	Printf(output_filename, "%s%s.cl", SWIG_output_directory(), module);


	f_cl = NewFile(output_filename, "w", SWIG_output_files());
	if (!f_cl) {
	FileErrorDisplay(output_filename);
	SWIG_exit(EXIT_FAILURE);
	}

	Swig_register_filebyname("header", f_null);
	Swig_register_filebyname("begin", f_null);
	Swig_register_filebyname("runtime", f_null);
	Swig_register_filebyname("wrapper", f_cl);

	Swig_banner_target_lang(f_cl, ";;");

	Printf(f_cl, "\n"
	";; -- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; package: %s --\n\n(defpackage :%s\n (:use :common-lisp :uffi))\n\n(in-package :%s)\n",
	module, module, module);
	Printf(f_cl, "(eval-when (compile load eval)\n (defparameter swig-identifier-converter '%s))\n", identifier_converter);

	Language::top(n);

	Delete(f_cl); // Delete the handle, not the file
	Delete(f_null);

	return SWIG_OK;
	}

	int UFFI::functionWrapper(Node *n) {
	String *funcname = Getattr(n, "sym:name");
	ParmList *pl = Getattr(n, "parms");
	Parm *p;
	int argnum = 0, first = 1;
	// int varargs = 0;

	//Language::functionWrapper(n);

	Printf(f_cl, "(swig-defun \"%s\"\n", funcname);
	Printf(f_cl, " (");

	/* Special cases */

	if (ParmList_len(pl) == 0) {
	Printf(f_cl, ":void");
	} else if (any_varargs(pl)) {
	Printf(f_cl, "#\| varargs \|#");
	// varargs = 1;
	} else {
	for (p = pl; p; p = nextSibling(p), argnum++) {
	String *argname = Getattr(p, "name");
	SwigType *argtype = Getattr(p, "type");
	String *ffitype = get_ffi_type(n, argtype, argname);
	String *lisptype = get_lisp_type(n, argtype, argname);
	int tempargname = 0;

	if (!argname) {
	argname = NewStringf("arg%d", argnum);
	tempargname = 1;
	}

	if (!first) {
	Printf(f_cl, "\n ");
	}
	Printf(f_cl, "(%s %s %s)", argname, ffitype, lisptype);
	first = 0;

	Delete(ffitype);
	Delete(lisptype);
	if (tempargname)
	Delete(argname);

	}
	}
	Printf(f_cl, ")\n"); /* finish arg list */
	Printf(f_cl, " :returning %s\n"
	//" :strings-convert t\n"
	//" :call-direct %s\n"
	//" :optimize-for-space t"
	")\n", get_ffi_type(n, Getattr(n, "type"), Swig_cresult_name())
	//,varargs ? "nil" : "t"
	);


	return SWIG_OK;
	}

	int UFFI::constantWrapper(Node *n) {
	String *type = Getattr(n, "type");
	String *converted_value = convert_literal(Getattr(n, "value"), type);
	String *name = Getattr(n, "sym:name");

	#if 0
	Printf(stdout, "constant %s is of type %s. value: %s\n", name, type, converted_value);
	#endif

	Printf(f_cl, "(swig-defconstant \"%s\" %s)\n", name, converted_value);

	Delete(converted_value);

	return SWIG_OK;
	}

	// Includes structs
	int UFFI::classHandler(Node *n) {

	String *name = Getattr(n, "sym:name");
	String *kind = Getattr(n, "kind");
	Node *c;

	if (Strcmp(kind, "struct")) {
	Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
	Printf(stderr, " (name: %s)\n", name);
	SWIG_exit(EXIT_FAILURE);
	}

	Printf(f_cl, "(swig-def-struct \"%s\"\n \n", name);

	for (c = firstChild(n); c; c = nextSibling(c)) {
	SwigType *type = Getattr(c, "type");
	SwigType *decl = Getattr(c, "decl");
	if (type) {
	type = Copy(type);
	SwigType_push(type, decl);
	String *lisp_type;

	if (Strcmp(nodeType(c), "cdecl")) {
	Printf(stderr, "Structure %s has a slot that we can't deal with.\n", name);
	Printf(stderr, "nodeType: %s, name: %s, type: %s\n", nodeType(c), Getattr(c, "name"), Getattr(c, "type"));
	SWIG_exit(EXIT_FAILURE);
	}

	/* Printf(stdout, "Converting %s in %s\n", type, name); */
	lisp_type = get_ffi_type(n, type, Getattr(c, "sym:name"));

	Printf(f_cl, " (#.(%s \"%s\" :type :slot) %s)\n", identifier_converter, Getattr(c, "sym:name"), lisp_type);

	Delete(lisp_type);
	}
	}

	// Language::classHandler(n);

	Printf(f_cl, " )\n");

	/* Add this structure to the known lisp types */
	//Printf(stdout, "Adding %s foreign type\n", name);
	add_defined_foreign_type(name);

	return SWIG_OK;
	}

	int UFFI::membervariableHandler(Node *n) {
	Language::membervariableHandler(n);
	return SWIG_OK;
	}


	extern "C" Language *swig_uffi(void) {
	return new UFFI();
	}