File move
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@4150 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley
parent
d199dde9e2
commit
74a3aa015c
25 changed files with 19427 additions and 0 deletions
401
Source/Modules/s-exp.cxx
Normal file
401
Source/Modules/s-exp.cxx
Normal file
|
|
@ -0,0 +1,401 @@
|
|||
/* -----------------------------------------------------------------------------
|
||||
* s-exp.cxx
|
||||
*
|
||||
* A parse tree represented as Lisp s-expressions.
|
||||
*
|
||||
* Author(s) : Matthias Koeppe (mkoeppe@mail.math.uni-magdeburg.de)
|
||||
*
|
||||
* Copyright (C) 2002. The University of Chicago
|
||||
* See the file LICENSE for information on usage and redistribution.
|
||||
* ----------------------------------------------------------------------------- */
|
||||
|
||||
/* Derived from xml.cxx 1.1.2.2 */
|
||||
|
||||
char cvsroot_s_exp_cxx[] = "$Header$";
|
||||
static const char *usage = "\
|
||||
S-Exp Options (available with -sexp)\n\
|
||||
-typemaplang lang - Typemap language.\n\n";
|
||||
|
||||
#include "swigmod.h"
|
||||
|
||||
//static Node *view_top = 0;
|
||||
static File *out = 0;
|
||||
|
||||
class Sexp : public Language {
|
||||
public:
|
||||
int indent_level;
|
||||
Sexp() : indent_level( 0 ) {}
|
||||
virtual ~Sexp() {}
|
||||
virtual void main(int argc, char *argv[]) {
|
||||
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, stderr );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
DOHHash *print_circle_hash;
|
||||
int print_circle_count;
|
||||
int hanging_parens;
|
||||
bool need_whitespace;
|
||||
bool need_newline;
|
||||
|
||||
/* Top of the parse tree */
|
||||
virtual int top(Node *n)
|
||||
{
|
||||
if( out == 0 )
|
||||
{
|
||||
String *outfile = Getattr(n,"outfile");
|
||||
Replaceall(outfile,"_wrap.cxx", ".lisp");
|
||||
out = NewFile(outfile,"w");
|
||||
if (!out)
|
||||
{
|
||||
Printf(stderr,"*** Can't open '%s'\n", outfile);
|
||||
SWIG_exit(EXIT_FAILURE);
|
||||
}
|
||||
}
|
||||
Language::top(n);
|
||||
Printf( out, ";;; Lisp parse tree produced by SWIG\n" );
|
||||
print_circle_hash = DohNewHash();
|
||||
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 need_newline = false)
|
||||
{
|
||||
hanging_parens++;
|
||||
if (need_newline)
|
||||
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[16];
|
||||
sprintf(address, "%x%c", (unsigned int)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)) {
|
||||
DOH *k;
|
||||
open_paren(NIL);
|
||||
for (k = Firstkey(obj); k; k = Nextkey(obj)) {
|
||||
if (!internal_key_p(k)) {
|
||||
DOH *value = Getattr(obj, k);
|
||||
Sexp_print_as_keyword(k);
|
||||
Sexp_print_value_of_key(value, k);
|
||||
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)) {
|
||||
DOH *k;
|
||||
open_paren(NIL);
|
||||
for (k = Firstkey(obj); k; k = Nextkey(obj)) {
|
||||
if (!internal_key_p(k)) {
|
||||
DOH *value = Getattr(obj, k);
|
||||
flush_parens();
|
||||
open_paren(NIL);
|
||||
Sexp_print_doh(k);
|
||||
Printf(out, " . ");
|
||||
Sexp_print_value_of_key(value, k);
|
||||
close_paren();
|
||||
}
|
||||
}
|
||||
close_paren();
|
||||
}
|
||||
else {
|
||||
// What is it?
|
||||
Printf(out,"#<DOH %x>", 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 */
|
||||
String *k;
|
||||
bool first;
|
||||
for (k = Firstkey(obj), first = true; k; k = Nextkey(obj), first=false) {
|
||||
if (!internal_key_p(k)) {
|
||||
DOH *value = Getattr(obj, k);
|
||||
flush_parens();
|
||||
if (!first) {
|
||||
Printf(out, " ");
|
||||
}
|
||||
Sexp_print_as_keyword(k);
|
||||
/* Print value */
|
||||
Sexp_print_value_of_key(value, k);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
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);
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
};
|
||||
|
||||
|
||||
extern "C"
|
||||
{
|
||||
Language * swig_sexp( void )
|
||||
{
|
||||
return new Sexp();
|
||||
}
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue