[S-EXP] Remove code for Common Lisp S-Exp
We dropped support for it in SWIG 4.0.0 and nobody has stepped forward to revive it in over 2 years. See #2009.
This commit is contained in:
Olly Betts
parent
11bb422bd3
commit
b7a99f22f5
4 changed files with 5 additions and 793 deletions
|
|
@ -1,402 +0,0 @@
|
|||
/* -----------------------------------------------------------------------------
|
||||
* 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();
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue