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 * A parse tree represented as Lisp s-expressions.
8 * ----------------------------------------------------------------------------- */
10 char cvsroot_s_exp_cxx[] = "$Id: s-exp.cxx 11133 2009-02-20 07:52:24Z wsfulton $";
15 static const char *usage = "\
16 S-Exp Options (available with -sexp)\n\
17 -typemaplang <lang> - Typemap language\n\n";
19 //static Node *view_top = 0;
22 class Sexp:public Language {
25 Sexp():indent_level(0) {
31 virtual void main(int argc, char *argv[]) {
32 // Add a symbol to the parser for conditional compilation
33 Preprocessor_define("SWIGSEXP 1", 0);
35 SWIG_typemap_lang("sexp");
36 for (int iX = 0; iX < argc; iX++) {
37 if (strcmp(argv[iX], "-typemaplang") == 0) {
40 SWIG_typemap_lang(argv[iX]);
44 if (strcmp(argv[iX], "-help") == 0) {
50 DOHHash *print_circle_hash;
51 int print_circle_count;
56 /* Top of the parse tree */
57 virtual int top(Node *n) {
59 String *outfile = Getattr(n, "outfile");
60 Replaceall(outfile, "_wrap.cxx", ".lisp");
61 Replaceall(outfile, "_wrap.c", ".lisp");
62 out = NewFile(outfile, "w", SWIG_output_files());
64 FileErrorDisplay(outfile);
65 SWIG_exit(EXIT_FAILURE);
68 String *f_sink = NewString("");
69 Swig_register_filebyname("header", f_sink);
70 Swig_register_filebyname("wrapper", f_sink);
71 Swig_register_filebyname("begin", f_sink);
72 Swig_register_filebyname("runtime", f_sink);
73 Swig_register_filebyname("init", f_sink);
75 Swig_banner_target_lang(out, ";;;");
79 Printf(out, ";;; Lisp parse tree produced by SWIG\n");
80 print_circle_hash = DohNewHash();
81 print_circle_count = 0;
92 for (i = 0; i < indent_level; i++) {
97 void open_paren(const String *oper) {
101 Printf(out, "%s ", oper);
105 void close_paren(bool neednewline = false) {
108 print_lazy_whitespace();
112 void flush_parens() {
114 if (hanging_parens) {
115 for (i = 0; i < hanging_parens; i++)
119 need_whitespace = true;
124 need_newline = false;
125 need_whitespace = false;
126 } else if (need_whitespace) {
128 need_whitespace = false;
132 void print_lazy_whitespace() {
136 void print_lazy_newline() {
140 bool internal_key_p(DOH *key) {
141 return ((Cmp(key, "nodeType") == 0)
142 || (Cmp(key, "firstChild") == 0)
143 || (Cmp(key, "lastChild") == 0)
144 || (Cmp(key, "parentNode") == 0)
145 || (Cmp(key, "nextSibling") == 0)
146 || (Cmp(key, "previousSibling") == 0)
147 || (Cmp(key, "csym:nextSibling") == 0)
148 || (Cmp(key, "csym:previousSibling") == 0)
149 || (Cmp(key, "typepass:visit") == 0)
150 || (Cmp(key, "allocate:visit") == 0)
151 || (*(Char(key)) == '$'));
154 bool boolean_key_p(DOH *key) {
155 return ((Cmp(key, "allocate:default_constructor") == 0)
156 || (Cmp(key, "allocate:default_destructor") == 0)
157 || (Cmp(key, "allows_typedef") == 0)
158 || (Cmp(key, "feature:immutable") == 0));
161 bool list_key_p(DOH *key) {
162 return ((Cmp(key, "parms") == 0)
163 || (Cmp(key, "baselist") == 0));
166 bool plist_key_p(DOH *key)
167 // true if KEY is the name of data that is a mapping from keys to
168 // values, which should be printed as a plist.
170 return ((Cmp(key, "typescope") == 0));
173 bool maybe_plist_key_p(DOH *key) {
174 return (Strncmp(key, "tmap:", 5) == 0);
177 bool print_circle(DOH *obj, bool list_p)
178 // We have a complex object, which might be referenced several
179 // times, or even recursively. Use Lisp's reader notation for
180 // circular structures (#n#, #n=).
182 // An object can be printed in list-mode or object-mode; LIST_P toggles.
183 // return TRUE if OBJ still needs to be printed
186 // Following is a silly hack. It works around the limitation of
187 // DOH's hash tables that only work with string keys!
189 sprintf(address, "%p%c", obj, list_p ? 'L' : 'O');
190 DOH *placeholder = Getattr(print_circle_hash, address);
192 Printv(out, placeholder, NIL);
195 String *placeholder = NewStringf("#%d#", ++print_circle_count);
196 Setattr(print_circle_hash, address, placeholder);
197 Printf(out, "#%d=", print_circle_count);
202 void Sexp_print_value_of_key(DOH *value, DOH *key) {
203 if ((Cmp(key, "parms") == 0) || (Cmp(key, "wrap:parms") == 0)
204 || (Cmp(key, "kwargs") == 0) || (Cmp(key, "pattern") == 0))
205 Sexp_print_parms(value);
206 else if (plist_key_p(key))
207 Sexp_print_plist(value);
208 else if (maybe_plist_key_p(key)) {
209 if (DohIsMapping(value))
210 Sexp_print_plist(value);
212 Sexp_print_doh(value);
213 } else if (list_key_p(key))
214 Sexp_print_list(value);
215 else if (boolean_key_p(key))
216 Sexp_print_boolean(value);
218 Sexp_print_doh(value);
221 void Sexp_print_boolean(DOH *obj) {
223 /* See DOH/Doh/base.c, DohGetInt() */
224 if (DohIsString(obj)) {
225 if (atoi(Char(obj)) != 0)
233 void Sexp_print_list(DOH *obj) {
234 if (print_circle(obj, true)) {
236 for (; obj; obj = nextSibling(obj)) {
238 print_lazy_whitespace();
244 void Sexp_print_parms(DOH *obj) {
245 // print it as a list of plists
246 if (print_circle(obj, true)) {
248 for (; obj; obj = nextSibling(obj)) {
249 if (DohIsMapping(obj)) {
252 for (k = First(obj); k.key; k = Next(k)) {
253 if (!internal_key_p(k.key)) {
254 DOH *value = Getattr(obj, k.key);
255 Sexp_print_as_keyword(k.key);
256 Sexp_print_value_of_key(value, k.key);
257 print_lazy_whitespace();
263 print_lazy_whitespace();
269 void Sexp_print_doh(DOH *obj) {
271 if (DohIsString(obj)) {
272 String *o = Str(obj);
273 Replaceall(o, "\\", "\\\\");
274 Replaceall(o, "\"", "\\\"");
275 Printf(out, "\"%s\"", o);
278 if (print_circle(obj, false)) {
281 Sexp_print_node(obj);
284 else if (DohIsMapping(obj)) {
287 for (k = First(obj); k.key; k = Next(k)) {
288 if (!internal_key_p(k.key)) {
289 DOH *value = Getattr(obj, k.key);
292 Sexp_print_doh(k.key);
294 Sexp_print_value_of_key(value, k.key);
299 } else if (strcmp(ObjType(obj)->objname, "List") == 0) {
302 for (i = 0; i < Len(obj); i++) {
303 DOH *item = Getitem(obj, i);
304 Sexp_print_doh(item);
309 Printf(out, "#<DOH %s %x>", ObjType(obj)->objname, obj);
315 void Sexp_print_as_keyword(const DOH *k) {
316 /* Print key, replacing ":" with "-" because : is CL's package prefix */
318 String *key = NewString(k);
319 Replaceall(key, ":", "-");
320 Replaceall(key, "_", "-");
321 Printf(out, ":%s ", key);
325 void Sexp_print_plist_noparens(DOH *obj) {
326 /* attributes map names to objects */
329 for (k = First(obj), first = true; k.key; k = Next(k), first = false) {
330 if (!internal_key_p(k.key)) {
331 DOH *value = Getattr(obj, k.key);
336 Sexp_print_as_keyword(k.key);
338 Sexp_print_value_of_key(value, k.key);
343 void Sexp_print_plist(DOH *obj) {
345 if (print_circle(obj, true)) {
347 Sexp_print_plist_noparens(obj);
352 void Sexp_print_attributes(Node *obj) {
353 Sexp_print_plist_noparens(obj);
356 void Sexp_print_node(Node *obj) {
358 open_paren(nodeType(obj));
359 /* A node has an attribute list... */
360 Sexp_print_attributes(obj);
361 /* ... and child nodes. */
362 cobj = firstChild(obj);
364 print_lazy_newline();
366 Sexp_print_as_keyword("children");
368 for (; cobj; cobj = nextSibling(cobj)) {
369 Sexp_print_node(cobj);
377 virtual int functionWrapper(Node *n) {
378 ParmList *l = Getattr(n, "parms");
379 Wrapper *f = NewWrapper();
380 emit_attach_parmmaps(l, f);
381 Setattr(n, "wrap:parms", l);
389 static Language *new_swig_sexp() {
392 extern "C" Language *swig_sexp(void) {
393 return new_swig_sexp();