Source/Modules/s-exp.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.
  *
  * s-exp.cxx
  *
  * A parse tree represented as Lisp s-expressions.
  * ----------------------------------------------------------------------------- */

 #include "swigmod.h"
 #include "dohint.h"

 static const char *usage = "\
 S-Exp Options (available with -sexp)\n\
      -typemaplang <lang> - Typemap language\n\n";

 //static Node *view_top = 0;
 static File *out = 0;

 class Sexp:public Language {
   int indent_level;
   DOHHash *print_circle_hash;
   int print_circle_count;
   int hanging_parens;
   bool need_whitespace;
   bool need_newline;

 public:
   Sexp():
     indent_level(0),
     print_circle_hash(0),
     print_circle_count(0),
     hanging_parens(0),
     need_whitespace(0),
     need_newline(0) {
   }

   virtual ~ Sexp() {
   }

   virtual void main(int argc, char *argv[]) {
     // Add a symbol to the parser for conditional compilation
     Preprocessor_define("SWIGSEXP 1", 0);

     SWIG_typemap_lang("sexp");
     for (int iX = 0; iX < argc; iX++) {
       if (strcmp(argv[iX], "-typemaplang") == 0) {
 	Swig_mark_arg(iX);
 	iX++;
 	SWIG_typemap_lang(argv[iX]);
 	Swig_mark_arg(iX);
 	continue;
       }
       if (strcmp(argv[iX], "-help") == 0) {
 	fputs(usage, stdout);
       }
     }
   }

   /* Top of the parse tree */
   virtual int top(Node *n) {
     if (out == 0) {
       String *outfile = Getattr(n, "outfile");
       Replaceall(outfile, "_wrap.cxx", ".lisp");
       Replaceall(outfile, "_wrap.c", ".lisp");
       out = NewFile(outfile, "w", SWIG_output_files());
       if (!out) {
 	FileErrorDisplay(outfile);
 	SWIG_exit(EXIT_FAILURE);
       }
     }
     String *f_sink = NewString("");
     Swig_register_filebyname("header", f_sink);
     Swig_register_filebyname("wrapper", f_sink);
     Swig_register_filebyname("begin", f_sink);
     Swig_register_filebyname("runtime", f_sink);
     Swig_register_filebyname("init", f_sink);

     Swig_banner_target_lang(out, ";;;");

     Language::top(n);
     Printf(out, "\n");
     Printf(out, ";;; Lisp parse tree produced by SWIG\n");
     print_circle_hash = NewHash();
     print_circle_count = 0;
     hanging_parens = 0;
     need_whitespace = 0;
     need_newline = 0;
     Sexp_print_node(n);
     flush_parens();
     return SWIG_OK;
   }

   void print_indent() {
     int i;
     for (i = 0; i < indent_level; i++) {
       Printf(out, " ");
     }
   }

   void open_paren(const String *oper) {
     flush_parens();
     Printf(out, "(");
     if (oper)
       Printf(out, "%s ", oper);
     indent_level += 2;
   }

   void close_paren(bool neednewline = false) {
     hanging_parens++;
     if (neednewline)
       print_lazy_whitespace();
     indent_level -= 2;
   }

   void flush_parens() {
     int i;
     if (hanging_parens) {
       for (i = 0; i < hanging_parens; i++)
 	Printf(out, ")");
       hanging_parens = 0;
       need_newline = true;
       need_whitespace = true;
     }
     if (need_newline) {
       Printf(out, "\n");
       print_indent();
       need_newline = false;
       need_whitespace = false;
     } else if (need_whitespace) {
       Printf(out, " ");
       need_whitespace = false;
     }
   }

   void print_lazy_whitespace() {
     need_whitespace = 1;
   }

   void print_lazy_newline() {
     need_newline = 1;
   }

   bool internal_key_p(DOH *key) {
     return ((Cmp(key, "nodeType") == 0)
 	    || (Cmp(key, "firstChild") == 0)
 	    || (Cmp(key, "lastChild") == 0)
 	    || (Cmp(key, "parentNode") == 0)
 	    || (Cmp(key, "nextSibling") == 0)
 	    || (Cmp(key, "previousSibling") == 0)
 	    || (Cmp(key, "csym:nextSibling") == 0)
 	    || (Cmp(key, "csym:previousSibling") == 0)
 	    || (Cmp(key, "typepass:visit") == 0)
 	    || (Cmp(key, "allocate:visit") == 0)
 	    || (*(Char(key)) == '$'));
   }

   bool boolean_key_p(DOH *key) {
     return ((Cmp(key, "allocate:default_constructor") == 0)
 	    || (Cmp(key, "allocate:default_destructor") == 0)
 	    || (Cmp(key, "allows_typedef") == 0)
 	    || (Cmp(key, "feature:immutable") == 0));
   }

   bool list_key_p(DOH *key) {
     return ((Cmp(key, "parms") == 0)
 	    || (Cmp(key, "baselist") == 0));
   }

   bool plist_key_p(DOH *key)
       // true if KEY is the name of data that is a mapping from keys to
       // values, which should be printed as a plist.
   {
     return ((Cmp(key, "typescope") == 0));
   }

   bool maybe_plist_key_p(DOH *key) {
     return (Strncmp(key, "tmap:", 5) == 0);
   }

   bool print_circle(DOH *obj, bool list_p)
       // We have a complex object, which might be referenced several
       // times, or even recursively.  Use Lisp's reader notation for
       // circular structures (#n#, #n=).
       //
       // An object can be printed in list-mode or object-mode; LIST_P toggles.
       // return TRUE if OBJ still needs to be printed
   {
     flush_parens();
     // Following is a silly hack.  It works around the limitation of
     // DOH's hash tables that only work with string keys!
     char address[32];
     sprintf(address, "%p%c", obj, list_p ? 'L' : 'O');
     DOH *placeholder = Getattr(print_circle_hash, address);
     if (placeholder) {
       Printv(out, placeholder, NIL);
       return false;
     } else {
       String *placeholder = NewStringf("#%d#", ++print_circle_count);
       Setattr(print_circle_hash, address, placeholder);
       Printf(out, "#%d=", print_circle_count);
       return true;
     }
   }

   void Sexp_print_value_of_key(DOH *value, DOH *key) {
     if ((Cmp(key, "parms") == 0) || (Cmp(key, "wrap:parms") == 0)
 	|| (Cmp(key, "kwargs") == 0) || (Cmp(key, "pattern") == 0))
       Sexp_print_parms(value);
     else if (plist_key_p(key))
       Sexp_print_plist(value);
     else if (maybe_plist_key_p(key)) {
       if (DohIsMapping(value))
 	Sexp_print_plist(value);
       else
 	Sexp_print_doh(value);
     } else if (list_key_p(key))
       Sexp_print_list(value);
     else if (boolean_key_p(key))
       Sexp_print_boolean(value);
     else
       Sexp_print_doh(value);
   }

   void Sexp_print_boolean(DOH *obj) {
     flush_parens();
     /* See DOH/Doh/base.c, DohGetInt() */
     if (DohIsString(obj)) {
       if (atoi(Char(obj)) != 0)
 	Printf(out, "t");
       else
 	Printf(out, "nil");
     } else
       Printf(out, "nil");
   }

   void Sexp_print_list(DOH *obj) {
     if (print_circle(obj, true)) {
       open_paren(NIL);
       for (; obj; obj = nextSibling(obj)) {
 	Sexp_print_doh(obj);
 	print_lazy_whitespace();
       }
       close_paren(true);
     }
   }

   void Sexp_print_parms(DOH *obj) {
     // print it as a list of plists
     if (print_circle(obj, true)) {
       open_paren(NIL);
       for (; obj; obj = nextSibling(obj)) {
 	if (DohIsMapping(obj)) {
 	  Iterator k;
 	  open_paren(NIL);
 	  for (k = First(obj); k.key; k = Next(k)) {
 	    if (!internal_key_p(k.key)) {
 	      DOH *value = Getattr(obj, k.key);
 	      Sexp_print_as_keyword(k.key);
 	      Sexp_print_value_of_key(value, k.key);
 	      print_lazy_whitespace();
 	    }
 	  }
 	  close_paren(true);
 	} else
 	  Sexp_print_doh(obj);
 	print_lazy_whitespace();
       }
       close_paren(true);
     }
   }

   void Sexp_print_doh(DOH *obj) {
     flush_parens();
     if (DohIsString(obj)) {
       String *o = Str(obj);
       Replaceall(o, "\\", "\\\\");
       Replaceall(o, "\"", "\\\"");
       Printf(out, "\"%s\"", o);
       Delete(o);
     } else {
       if (print_circle(obj, false)) {
 	// Dispatch type
 	if (nodeType(obj)) {
 	  Sexp_print_node(obj);
 	}

 	else if (DohIsMapping(obj)) {
 	  Iterator k;
 	  open_paren(NIL);
 	  for (k = First(obj); k.key; k = Next(k)) {
 	    if (!internal_key_p(k.key)) {
 	      DOH *value = Getattr(obj, k.key);
 	      flush_parens();
 	      open_paren(NIL);
 	      Sexp_print_doh(k.key);
 	      Printf(out, " . ");
 	      Sexp_print_value_of_key(value, k.key);
 	      close_paren();
 	    }
 	  }
 	  close_paren();
 	} else if (strcmp(ObjType(obj)->objname, "List") == 0) {
 	  int i;
 	  open_paren(NIL);
 	  for (i = 0; i < Len(obj); i++) {
 	    DOH *item = Getitem(obj, i);
 	    Sexp_print_doh(item);
 	  }
 	  close_paren();
 	} else {
 	  // What is it?
 	  Printf(out, "#<DOH %s %p>", ObjType(obj)->objname, obj);
 	}
       }
     }
   }

   void Sexp_print_as_keyword(const DOH *k) {
     /* Print key, replacing ":" with "-" because : is CL's package prefix */
     flush_parens();
     String *key = NewString(k);
     Replaceall(key, ":", "-");
     Replaceall(key, "_", "-");
     Printf(out, ":%s ", key);
     Delete(key);
   }

   void Sexp_print_plist_noparens(DOH *obj) {
     /* attributes map names to objects */
     Iterator k;
     bool first;
     for (k = First(obj), first = true; k.key; k = Next(k), first = false) {
       if (!internal_key_p(k.key)) {
 	DOH *value = Getattr(obj, k.key);
 	flush_parens();
 	if (!first) {
 	  Printf(out, " ");
 	}
 	Sexp_print_as_keyword(k.key);
 	/* Print value */
 	Sexp_print_value_of_key(value, k.key);
       }
     }
   }

   void Sexp_print_plist(DOH *obj) {
     flush_parens();
     if (print_circle(obj, true)) {
       open_paren(NIL);
       Sexp_print_plist_noparens(obj);
       close_paren();
     }
   }

   void Sexp_print_attributes(Node *obj) {
     Sexp_print_plist_noparens(obj);
   }

   void Sexp_print_node(Node *obj) {
     Node *cobj;
     open_paren(nodeType(obj));
     /* A node has an attribute list... */
     Sexp_print_attributes(obj);
     /* ... and child nodes. */
     cobj = firstChild(obj);
     if (cobj) {
       print_lazy_newline();
       flush_parens();
       Sexp_print_as_keyword("children");
       open_paren(NIL);
       for (; cobj; cobj = nextSibling(cobj)) {
 	Sexp_print_node(cobj);
       }
       close_paren();
     }
     close_paren();
   }


   virtual int functionWrapper(Node *n) {
     ParmList *l = Getattr(n, "parms");
     Wrapper *f = NewWrapper();
     emit_attach_parmmaps(l, f);
     Setattr(n, "wrap:parms", l);
     DelWrapper(f);
     return SWIG_OK;
   }

 };


 static Language *new_swig_sexp() {
   return new Sexp();
 }
 extern "C" Language *swig_sexp(void) {
   return new_swig_sexp();
 }
	/* -----------------------------------------------------------------------------
	* 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.
	*
	* s-exp.cxx
	*
	* A parse tree represented as Lisp s-expressions.
	* ----------------------------------------------------------------------------- */

	#include "swigmod.h"
	#include "dohint.h"

	static const char *usage = "\
	S-Exp Options (available with -sexp)\n\
	-typemaplang <lang> - Typemap language\n\n";

	//static Node *view_top = 0;
	static File *out = 0;

	class Sexp:public Language {
	int indent_level;
	DOHHash *print_circle_hash;
	int print_circle_count;
	int hanging_parens;
	bool need_whitespace;
	bool need_newline;

	public:
	Sexp():
	indent_level(0),
	print_circle_hash(0),
	print_circle_count(0),
	hanging_parens(0),
	need_whitespace(0),
	need_newline(0) {
	}

	virtual ~ Sexp() {
	}

	virtual void main(int argc, char *argv[]) {
	// Add a symbol to the parser for conditional compilation
	Preprocessor_define("SWIGSEXP 1", 0);

	SWIG_typemap_lang("sexp");
	for (int iX = 0; iX < argc; iX++) {
	if (strcmp(argv[iX], "-typemaplang") == 0) {
	Swig_mark_arg(iX);
	iX++;
	SWIG_typemap_lang(argv[iX]);
	Swig_mark_arg(iX);
	continue;
	}
	if (strcmp(argv[iX], "-help") == 0) {
	fputs(usage, stdout);
	}
	}
	}

	/* Top of the parse tree */
	virtual int top(Node *n) {
	if (out == 0) {
	String *outfile = Getattr(n, "outfile");
	Replaceall(outfile, "_wrap.cxx", ".lisp");
	Replaceall(outfile, "_wrap.c", ".lisp");
	out = NewFile(outfile, "w", SWIG_output_files());
	if (!out) {
	FileErrorDisplay(outfile);
	SWIG_exit(EXIT_FAILURE);
	}
	}
	String *f_sink = NewString("");
	Swig_register_filebyname("header", f_sink);
	Swig_register_filebyname("wrapper", f_sink);
	Swig_register_filebyname("begin", f_sink);
	Swig_register_filebyname("runtime", f_sink);
	Swig_register_filebyname("init", f_sink);

	Swig_banner_target_lang(out, ";;;");

	Language::top(n);
	Printf(out, "\n");
	Printf(out, ";;; Lisp parse tree produced by SWIG\n");
	print_circle_hash = NewHash();
	print_circle_count = 0;
	hanging_parens = 0;
	need_whitespace = 0;
	need_newline = 0;
	Sexp_print_node(n);
	flush_parens();
	return SWIG_OK;
	}

	void print_indent() {
	int i;
	for (i = 0; i < indent_level; i++) {
	Printf(out, " ");
	}
	}

	void open_paren(const String *oper) {
	flush_parens();
	Printf(out, "(");
	if (oper)
	Printf(out, "%s ", oper);
	indent_level += 2;
	}

	void close_paren(bool neednewline = false) {
	hanging_parens++;
	if (neednewline)
	print_lazy_whitespace();
	indent_level -= 2;
	}

	void flush_parens() {
	int i;
	if (hanging_parens) {
	for (i = 0; i < hanging_parens; i++)
	Printf(out, ")");
	hanging_parens = 0;
	need_newline = true;
	need_whitespace = true;
	}
	if (need_newline) {
	Printf(out, "\n");
	print_indent();
	need_newline = false;
	need_whitespace = false;
	} else if (need_whitespace) {
	Printf(out, " ");
	need_whitespace = false;
	}
	}

	void print_lazy_whitespace() {
	need_whitespace = 1;
	}

	void print_lazy_newline() {
	need_newline = 1;
	}

	bool internal_key_p(DOH *key) {
	return ((Cmp(key, "nodeType") == 0)
	\|\| (Cmp(key, "firstChild") == 0)
	\|\| (Cmp(key, "lastChild") == 0)
	\|\| (Cmp(key, "parentNode") == 0)
	\|\| (Cmp(key, "nextSibling") == 0)
	\|\| (Cmp(key, "previousSibling") == 0)
	\|\| (Cmp(key, "csym:nextSibling") == 0)
	\|\| (Cmp(key, "csym:previousSibling") == 0)
	\|\| (Cmp(key, "typepass:visit") == 0)
	\|\| (Cmp(key, "allocate:visit") == 0)
	\|\| (*(Char(key)) == '$'));
	}

	bool boolean_key_p(DOH *key) {
	return ((Cmp(key, "allocate:default_constructor") == 0)
	\|\| (Cmp(key, "allocate:default_destructor") == 0)
	\|\| (Cmp(key, "allows_typedef") == 0)
	\|\| (Cmp(key, "feature:immutable") == 0));
	}

	bool list_key_p(DOH *key) {
	return ((Cmp(key, "parms") == 0)
	\|\| (Cmp(key, "baselist") == 0));
	}

	bool plist_key_p(DOH *key)
	// true if KEY is the name of data that is a mapping from keys to
	// values, which should be printed as a plist.
	{
	return ((Cmp(key, "typescope") == 0));
	}

	bool maybe_plist_key_p(DOH *key) {
	return (Strncmp(key, "tmap:", 5) == 0);
	}

	bool print_circle(DOH *obj, bool list_p)
	// We have a complex object, which might be referenced several
	// times, or even recursively. Use Lisp's reader notation for
	// circular structures (#n#, #n=).
	//
	// An object can be printed in list-mode or object-mode; LIST_P toggles.
	// return TRUE if OBJ still needs to be printed
	{
	flush_parens();
	// Following is a silly hack. It works around the limitation of
	// DOH's hash tables that only work with string keys!
	char address[32];
	sprintf(address, "%p%c", obj, list_p ? 'L' : 'O');
	DOH *placeholder = Getattr(print_circle_hash, address);
	if (placeholder) {
	Printv(out, placeholder, NIL);
	return false;
	} else {
	String *placeholder = NewStringf("#%d#", ++print_circle_count);
	Setattr(print_circle_hash, address, placeholder);
	Printf(out, "#%d=", print_circle_count);
	return true;
	}
	}

	void Sexp_print_value_of_key(DOH value, DOH key) {
	if ((Cmp(key, "parms") == 0) \|\| (Cmp(key, "wrap:parms") == 0)
	\|\| (Cmp(key, "kwargs") == 0) \|\| (Cmp(key, "pattern") == 0))
	Sexp_print_parms(value);
	else if (plist_key_p(key))
	Sexp_print_plist(value);
	else if (maybe_plist_key_p(key)) {
	if (DohIsMapping(value))
	Sexp_print_plist(value);
	else
	Sexp_print_doh(value);
	} else if (list_key_p(key))
	Sexp_print_list(value);
	else if (boolean_key_p(key))
	Sexp_print_boolean(value);
	else
	Sexp_print_doh(value);
	}

	void Sexp_print_boolean(DOH *obj) {
	flush_parens();
	/* See DOH/Doh/base.c, DohGetInt() */
	if (DohIsString(obj)) {
	if (atoi(Char(obj)) != 0)
	Printf(out, "t");
	else
	Printf(out, "nil");
	} else
	Printf(out, "nil");
	}

	void Sexp_print_list(DOH *obj) {
	if (print_circle(obj, true)) {
	open_paren(NIL);
	for (; obj; obj = nextSibling(obj)) {
	Sexp_print_doh(obj);
	print_lazy_whitespace();
	}
	close_paren(true);
	}
	}

	void Sexp_print_parms(DOH *obj) {
	// print it as a list of plists
	if (print_circle(obj, true)) {
	open_paren(NIL);
	for (; obj; obj = nextSibling(obj)) {
	if (DohIsMapping(obj)) {
	Iterator k;
	open_paren(NIL);
	for (k = First(obj); k.key; k = Next(k)) {
	if (!internal_key_p(k.key)) {
	DOH *value = Getattr(obj, k.key);
	Sexp_print_as_keyword(k.key);
	Sexp_print_value_of_key(value, k.key);
	print_lazy_whitespace();
	}
	}
	close_paren(true);
	} else
	Sexp_print_doh(obj);
	print_lazy_whitespace();
	}
	close_paren(true);
	}
	}

	void Sexp_print_doh(DOH *obj) {
	flush_parens();
	if (DohIsString(obj)) {
	String *o = Str(obj);
	Replaceall(o, "\\", "\\\\");
	Replaceall(o, "\"", "\\\"");
	Printf(out, "\"%s\"", o);
	Delete(o);
	} else {
	if (print_circle(obj, false)) {
	// Dispatch type
	if (nodeType(obj)) {
	Sexp_print_node(obj);
	}

	else if (DohIsMapping(obj)) {
	Iterator k;
	open_paren(NIL);
	for (k = First(obj); k.key; k = Next(k)) {
	if (!internal_key_p(k.key)) {
	DOH *value = Getattr(obj, k.key);
	flush_parens();
	open_paren(NIL);
	Sexp_print_doh(k.key);
	Printf(out, " . ");
	Sexp_print_value_of_key(value, k.key);
	close_paren();
	}
	}
	close_paren();
	} else if (strcmp(ObjType(obj)->objname, "List") == 0) {
	int i;
	open_paren(NIL);
	for (i = 0; i < Len(obj); i++) {
	DOH *item = Getitem(obj, i);
	Sexp_print_doh(item);
	}
	close_paren();
	} else {
	// What is it?
	Printf(out, "#<DOH %s %p>", ObjType(obj)->objname, obj);
	}
	}
	}
	}

	void Sexp_print_as_keyword(const DOH *k) {
	/* Print key, replacing ":" with "-" because : is CL's package prefix */
	flush_parens();
	String *key = NewString(k);
	Replaceall(key, ":", "-");
	Replaceall(key, "_", "-");
	Printf(out, ":%s ", key);
	Delete(key);
	}

	void Sexp_print_plist_noparens(DOH *obj) {
	/* attributes map names to objects */
	Iterator k;
	bool first;
	for (k = First(obj), first = true; k.key; k = Next(k), first = false) {
	if (!internal_key_p(k.key)) {
	DOH *value = Getattr(obj, k.key);
	flush_parens();
	if (!first) {
	Printf(out, " ");
	}
	Sexp_print_as_keyword(k.key);
	/* Print value */
	Sexp_print_value_of_key(value, k.key);
	}
	}
	}

	void Sexp_print_plist(DOH *obj) {
	flush_parens();
	if (print_circle(obj, true)) {
	open_paren(NIL);
	Sexp_print_plist_noparens(obj);
	close_paren();
	}
	}

	void Sexp_print_attributes(Node *obj) {
	Sexp_print_plist_noparens(obj);
	}

	void Sexp_print_node(Node *obj) {
	Node *cobj;
	open_paren(nodeType(obj));
	/* A node has an attribute list... */
	Sexp_print_attributes(obj);
	/* ... and child nodes. */
	cobj = firstChild(obj);
	if (cobj) {
	print_lazy_newline();
	flush_parens();
	Sexp_print_as_keyword("children");
	open_paren(NIL);
	for (; cobj; cobj = nextSibling(cobj)) {
	Sexp_print_node(cobj);
	}
	close_paren();
	}
	close_paren();
	}


	virtual int functionWrapper(Node *n) {
	ParmList *l = Getattr(n, "parms");
	Wrapper *f = NewWrapper();
	emit_attach_parmmaps(l, f);
	Setattr(n, "wrap:parms", l);
	DelWrapper(f);
	return SWIG_OK;
	}

	};


	static Language *new_swig_sexp() {
	return new Sexp();
	}
	extern "C" Language *swig_sexp(void) {
	return new_swig_sexp();
	}