Source/Modules/s-exp.cxx

   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.
   4  *
   5  * s-exp.cxx
   6  *
   7  * A parse tree represented as Lisp s-expressions.
   8  * ----------------------------------------------------------------------------- */
   9
  10 char cvsroot_s_exp_cxx[] = "$Id: s-exp.cxx 11133 2009-02-20 07:52:24Z wsfulton $";
  11
  12 #include "swigmod.h"
  13 #include "dohint.h"
  14
  15 static const char *usage = "\
  16 S-Exp Options (available with -sexp)\n\
  17      -typemaplang <lang> - Typemap language\n\n";
  18
  19 //static Node *view_top = 0;
  20 static File *out = 0;
  21
  22 class Sexp:public Language {
  23 public:
  24   int indent_level;
  25    Sexp():indent_level(0) {
  26   }
  27
  28   virtual ~ Sexp() {
  29   }
  30
  31   virtual void main(int argc, char *argv[]) {
  32     // Add a symbol to the parser for conditional compilation
  33     Preprocessor_define("SWIGSEXP 1", 0);
  34
  35     SWIG_typemap_lang("sexp");
  36     for (int iX = 0; iX < argc; iX++) {
  37       if (strcmp(argv[iX], "-typemaplang") == 0) {
  38         Swig_mark_arg(iX);
  39         iX++;
  40         SWIG_typemap_lang(argv[iX]);
  41         Swig_mark_arg(iX);
  42         continue;
  43       }
  44       if (strcmp(argv[iX], "-help") == 0) {
  45         fputs(usage, stdout);
  46       }
  47     }
  48   }
  49
  50   DOHHash *print_circle_hash;
  51   int print_circle_count;
  52   int hanging_parens;
  53   bool need_whitespace;
  54   bool need_newline;
  55
  56   /* Top of the parse tree */
  57   virtual int top(Node *n) {
  58     if (out == 0) {
  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());
  63       if (!out) {
  64         FileErrorDisplay(outfile);
  65         SWIG_exit(EXIT_FAILURE);
  66       }
  67     }
  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);
  74
  75     Swig_banner_target_lang(out, ";;;");
  76
  77     Language::top(n);
  78     Printf(out, "\n");
  79     Printf(out, ";;; Lisp parse tree produced by SWIG\n");
  80     print_circle_hash = DohNewHash();
  81     print_circle_count = 0;
  82     hanging_parens = 0;
  83     need_whitespace = 0;
  84     need_newline = 0;
  85     Sexp_print_node(n);
  86     flush_parens();
  87     return SWIG_OK;
  88   }
  89
  90   void print_indent() {
  91     int i;
  92     for (i = 0; i < indent_level; i++) {
  93       Printf(out, " ");
  94     }
  95   }
  96
  97   void open_paren(const String *oper) {
  98     flush_parens();
  99     Printf(out, "(");
 100     if (oper)
 101       Printf(out, "%s ", oper);
 102     indent_level += 2;
 103   }
 104
 105   void close_paren(bool neednewline = false) {
 106     hanging_parens++;
 107     if (neednewline)
 108       print_lazy_whitespace();
 109     indent_level -= 2;
 110   }
 111
 112   void flush_parens() {
 113     int i;
 114     if (hanging_parens) {
 115       for (i = 0; i < hanging_parens; i++)
 116         Printf(out, ")");
 117       hanging_parens = 0;
 118       need_newline = true;
 119       need_whitespace = true;
 120     }
 121     if (need_newline) {
 122       Printf(out, "\n");
 123       print_indent();
 124       need_newline = false;
 125       need_whitespace = false;
 126     } else if (need_whitespace) {
 127       Printf(out, " ");
 128       need_whitespace = false;
 129     }
 130   }
 131
 132   void print_lazy_whitespace() {
 133     need_whitespace = 1;
 134   }
 135
 136   void print_lazy_newline() {
 137     need_newline = 1;
 138   }
 139
 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)) == '$'));
 152   }
 153
 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));
 159   }
 160
 161   bool list_key_p(DOH *key) {
 162     return ((Cmp(key, "parms") == 0)
 163             || (Cmp(key, "baselist") == 0));
 164   }
 165
 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.
 169   {
 170     return ((Cmp(key, "typescope") == 0));
 171   }
 172
 173   bool maybe_plist_key_p(DOH *key) {
 174     return (Strncmp(key, "tmap:", 5) == 0);
 175   }
 176
 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=).
 181       //
 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
 184   {
 185     flush_parens();
 186     // Following is a silly hack.  It works around the limitation of
 187     // DOH's hash tables that only work with string keys!
 188     char address[32];
 189     sprintf(address, "%p%c", obj, list_p ? 'L' : 'O');
 190     DOH *placeholder = Getattr(print_circle_hash, address);
 191     if (placeholder) {
 192       Printv(out, placeholder, NIL);
 193       return false;
 194     } else {
 195       String *placeholder = NewStringf("#%d#", ++print_circle_count);
 196       Setattr(print_circle_hash, address, placeholder);
 197       Printf(out, "#%d=", print_circle_count);
 198       return true;
 199     }
 200   }
 201
 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);
 211       else
 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);
 217     else
 218       Sexp_print_doh(value);
 219   }
 220
 221   void Sexp_print_boolean(DOH *obj) {
 222     flush_parens();
 223     /* See DOH/Doh/base.c, DohGetInt() */
 224     if (DohIsString(obj)) {
 225       if (atoi(Char(obj)) != 0)
 226         Printf(out, "t");
 227       else
 228         Printf(out, "nil");
 229     } else
 230       Printf(out, "nil");
 231   }
 232
 233   void Sexp_print_list(DOH *obj) {
 234     if (print_circle(obj, true)) {
 235       open_paren(NIL);
 236       for (; obj; obj = nextSibling(obj)) {
 237         Sexp_print_doh(obj);
 238         print_lazy_whitespace();
 239       }
 240       close_paren(true);
 241     }
 242   }
 243
 244   void Sexp_print_parms(DOH *obj) {
 245     // print it as a list of plists
 246     if (print_circle(obj, true)) {
 247       open_paren(NIL);
 248       for (; obj; obj = nextSibling(obj)) {
 249         if (DohIsMapping(obj)) {
 250           Iterator k;
 251           open_paren(NIL);
 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();
 258             }
 259           }
 260           close_paren(true);
 261         } else
 262           Sexp_print_doh(obj);
 263         print_lazy_whitespace();
 264       }
 265       close_paren(true);
 266     }
 267   }
 268
 269   void Sexp_print_doh(DOH *obj) {
 270     flush_parens();
 271     if (DohIsString(obj)) {
 272       String *o = Str(obj);
 273       Replaceall(o, "\\", "\\\\");
 274       Replaceall(o, "\"", "\\\"");
 275       Printf(out, "\"%s\"", o);
 276       Delete(o);
 277     } else {
 278       if (print_circle(obj, false)) {
 279         // Dispatch type
 280         if (nodeType(obj)) {
 281           Sexp_print_node(obj);
 282         }
 283
 284         else if (DohIsMapping(obj)) {
 285           Iterator k;
 286           open_paren(NIL);
 287           for (k = First(obj); k.key; k = Next(k)) {
 288             if (!internal_key_p(k.key)) {
 289               DOH *value = Getattr(obj, k.key);
 290               flush_parens();
 291               open_paren(NIL);
 292               Sexp_print_doh(k.key);
 293               Printf(out, " . ");
 294               Sexp_print_value_of_key(value, k.key);
 295               close_paren();
 296             }
 297           }
 298           close_paren();
 299         } else if (strcmp(ObjType(obj)->objname, "List") == 0) {
 300           int i;
 301           open_paren(NIL);
 302           for (i = 0; i < Len(obj); i++) {
 303             DOH *item = Getitem(obj, i);
 304             Sexp_print_doh(item);
 305           }
 306           close_paren();
 307         } else {
 308           // What is it?
 309           Printf(out, "#<DOH %s %x>", ObjType(obj)->objname, obj);
 310         }
 311       }
 312     }
 313   }
 314
 315   void Sexp_print_as_keyword(const DOH *k) {
 316     /* Print key, replacing ":" with "-" because : is CL's package prefix */
 317     flush_parens();
 318     String *key = NewString(k);
 319     Replaceall(key, ":", "-");
 320     Replaceall(key, "_", "-");
 321     Printf(out, ":%s ", key);
 322     Delete(key);
 323   }
 324
 325   void Sexp_print_plist_noparens(DOH *obj) {
 326     /* attributes map names to objects */
 327     Iterator k;
 328     bool first;
 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);
 332         flush_parens();
 333         if (!first) {
 334           Printf(out, " ");
 335         }
 336         Sexp_print_as_keyword(k.key);
 337         /* Print value */
 338         Sexp_print_value_of_key(value, k.key);
 339       }
 340     }
 341   }
 342
 343   void Sexp_print_plist(DOH *obj) {
 344     flush_parens();
 345     if (print_circle(obj, true)) {
 346       open_paren(NIL);
 347       Sexp_print_plist_noparens(obj);
 348       close_paren();
 349     }
 350   }
 351
 352   void Sexp_print_attributes(Node *obj) {
 353     Sexp_print_plist_noparens(obj);
 354   }
 355
 356   void Sexp_print_node(Node *obj) {
 357     Node *cobj;
 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);
 363     if (cobj) {
 364       print_lazy_newline();
 365       flush_parens();
 366       Sexp_print_as_keyword("children");
 367       open_paren(NIL);
 368       for (; cobj; cobj = nextSibling(cobj)) {
 369         Sexp_print_node(cobj);
 370       }
 371       close_paren();
 372     }
 373     close_paren();
 374   }
 375
 376
 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);
 382     DelWrapper(f);
 383     return SWIG_OK;
 384   }
 385
 386 };
 387
 388
 389 static Language *new_swig_sexp() {
 390   return new Sexp();
 391 }
 392 extern "C" Language *swig_sexp(void) {
 393   return new_swig_sexp();
 394 }