#include <stdlib.h>
#include <stdio.h>
#include <memory.h>
#include <errno.h>
#include <sys/stat.h>
#include <unistd.h>
#include <stdbool.h>

#ifdef __STDC__
#include <stdarg.h>
#else
#include <varargs.h>
#endif

bool exppp_output_filename_reset;    /* if true, force output filename */
/* DAR - moved this from .h file - not sure why was there. */

#include "../express/expbasic.h"
#include "../express/express.h"
#include "exppp.h"

#define EXPR_out(e,p) EXPR__out(e,p,OP_UNKNOWN)
#define EXPRop2_out(oe,string,paren,pad) \
        EXPRop2__out(oe,string,paren,pad,OP_UNKNOWN)
#define EXPRop_out(oe,paren) EXPRop__out(oe,paren,OP_UNKNOWN)

void ALGscope_out( Scope s, int level );
void ENTITYattrs_out( Linked_List attributes, int derived, int level );
void ENTITY_out( Entity e, int level );
void ENTITYinverse_out( Linked_List attrs, int level );
void ENTITYunique_out( Linked_List u, int level );
void EXPRop__out( struct Op_Subexpression * oe, int paren, int previous_op );
void EXPRop_string( char * buffer, struct Op_Subexpression * oe );
void EXPRop1_out( struct Op_Subexpression * eo, char * opcode, int paren );
void EXPRop2__out( struct Op_Subexpression * eo, char * opcode, int paren, int pad, int previous_op );
void EXPR__out( Expression expr, int paren, int previous_op );
void EXPRbounds_out( TypeBody tb );
int EXPRlength( Expression e );
void FUNC_out( Function fn, int level );
void PROC_out( Procedure p, int level );
void REFout( Dictionary refdict, Linked_List reflist, char * type, int level );
void RULE_out( Rule r, int level );
void SCOPEalgs_out( Scope s, int level );
void SCOPEconsts_out( Scope s, int level );
void SCOPEentities_out( Scope s, int level );
void SCOPElocals_out( Scope s, int level );
void SCOPEtypes_out( Scope s, int level );
void STMT_out( Statement s, int level );
void STMTlist_out( Linked_List stmts, int level );
void TYPE_out( Type t, int level );
void TYPE_head_out( Type t, int level );
void TYPE_body_out( Type t, int level );
void WHERE_out( Linked_List wheres, int level );

static Error ERROR_select_empty;

int exppp_nesting_indent = 2;       /* default nesting indent */
int exppp_continuation_indent = 4;  /* default nesting indent for */
/* continuation lines */
int exppp_linelength = 75;      /* leave some slop for closing
                     parens.  \n is not included in */
/* this count either */

int indent2;        /* where continuation lines start */
int curpos;     /* current line position (1 is first position) */

#define NOLEVEL -1  /* unused-level indicator */

char * exppp_output_filename = ( char * )0; /* if this is set, override */
/* default output filename */
char filename[1000];    /* output file name */
Symbol error_sym;   /* only used when printing errors */

char * expheader[] = {
    "(* This file was generated by exppp (an EXPRESS Pretty Printer)"   ,
    "written at the National Institute of Standards and Technology"     ,
    "by Don Libes, February 19, 1993."                  ,
    ""                                  ,
    "WARNING: If you modify this file and want to save the changes,"    ,
    "delete this comment block or else the file will be rewritten"      ,
    "the next time exppp processes this schema. *)"             ,
    0
};

bool exppp_alphabetize = false;

bool exppp_terse = false;

bool exppp_reference_info = false;   /* if true, add commentary */
/* about where things came from */

bool exppp_preserve_comments = false;

bool exppp_rmpp = true;
char rmfilename[] = "rmpp";
FILE * rm;

char * rmheader[] = {
    "# This file was generated by exppp (an EXPRESS Pretty Printer)"    ,
    "# written at the National Institute of Standards and Technology"   ,
    "# by Don Libes, February 19, 1993."                    ,
    ""                                  ,
    "# Run this script from the shell to remove any files created by"   ,
    "# the last run of exppp."                      ,
    ""                                  ,
    0
};

FILE * exppp_fp = NULL;     /* output file */
char * exppp_buf = 0;       /* output buffer */
int exppp_maxbuflen = 0;        /* size of expppbuf */
int exppp_buflen = 0;       /* remaining space in expppbuf */
char * exppp_bufp = 0;      /* pointer to write position in expppbuf */
/* should usually be pointing to a "\0" */

/* count newlines in a string */
int
count_newlines( s )
char * s;
{
    int count = 0;
    for( ; *s; s++ ) {
        if( *s == '\n' ) {
            count++;
        }
    }
    return count;
}

void
exp_output( char * buf, int len ) {
    FILE * fp = ( exppp_fp ? exppp_fp : stdout );

    error_sym.line += count_newlines( buf );

    if( exppp_buf ) {
        /* output to string */
        if( len > exppp_buflen ) {
            /* should provide flag to enable complaint */
            /* for now, just ignore */
            return;
        }
        memcpy( exppp_bufp, buf, len + 1 );
        exppp_bufp += len;
        exppp_buflen -= len;
    } else {
        /* output to file */
        fwrite( buf, 1, len, fp );
    }
}

void
#ifdef __STDC__
wrap( char * fmt, ... ) {
#else
wrap( va_alist )
va_dcl {
    char * fmt;
#endif
    char * p;
    char buf[10000];
    int len;
    va_list args;
#ifdef __STDC__
    va_start( args, fmt );
#else
    va_start( args );
    fmt = va_arg( args, char * );
#endif

    vsprintf( buf, fmt, args );
    len = strlen( buf );

    /* 1st condition checks if string cant fit into current line */
    /* 2nd condition checks if string cant fit into any line */
    /* I.e., if we still can't fit after indenting, don't bother to */
    /* go to newline, just print a long line */
    if( ( ( curpos + len ) > exppp_linelength ) &&
    ( ( indent2 + len ) < exppp_linelength ) ) {
        /* move to new continuation line */
        char line[1000];
        sprintf( line, "\n%*s", indent2, "" );
        exp_output( line, 1 + indent2 );

        curpos = indent2;       /* reset current position */
    }

    exp_output( buf, len );

    if( len ) {
        /* reset cur position based on last newline seen */
        if( 0 == ( p = strrchr( buf, '\n' ) ) ) {
            curpos += len;
        } else {
            curpos = len + buf - p;
        }
    }
}

void
#ifdef __STDC__
raw( char * fmt, ... ) {
#else
raw( va_alist )
va_dcl {
    char * fmt;
#endif
    char * p;
    char buf[10000];
    int len;
    va_list args;
#ifdef __STDC__
    va_start( args, fmt );
#else
    va_start( args );
    fmt = va_arg( args, char * );
#endif

    vsprintf( buf, fmt, args );
    len = strlen( buf );

    exp_output( buf, len );

    if( len ) {
        /* reset cur position based on last newline seen */
        if( 0 == ( p = strrchr( buf, '\n' ) ) ) {
            curpos += len;
        } else {
            curpos = len + buf - p;
        }
    }
}

void
exppp_init() {
    static bool first_time = true;

    if( !first_time ) {
        return;
    }
    first_time = false;

    ERROR_select_empty = ERRORcreate(
                             "select type %s has no members", SEVERITY_ERROR );
}

void
EXPRESSout( Express e ) {
    Schema s;
    DictionaryEntry de;
    char ** hp;

    exppp_init();

    if( exppp_rmpp ) {
        if( !( rm = fopen( rmfilename, "w" ) ) ) {
            ERRORreport( ERROR_file_unwriteable, rmfilename, strerror( errno ) );
            return;
        }

        for( hp = rmheader; *hp; hp++ ) {
            fprintf( rm, "%s\n", *hp );
        }
        fprintf( rm, "rm -f" );
    }

    DICTdo_init( e->symbol_table, &de );
    while( 0 != ( s = ( Schema )DICTdo( &de ) ) ) {
        ( void ) SCHEMAout( s );
    }

    if( exppp_rmpp ) {
        fprintf( rm, " %s\n", rmfilename );

        /* owner+group executable, readable to world */
        if( 0 != chmod( rmfilename, 0774 ) ) {
            fprintf( stderr, "%s: could not mark %s executable (%s)\n",
                     EXPRESSprogram_name, rmfilename, strerror( errno ) );
            return;
        }
    }
}

void
exppp_ref_info( Symbol * s ) {
    if( exppp_reference_info ) {
        raw( "--info %s %s %d\n", s->name, s->filename, s->line );
    }
}

/* normally all non-schema objects start out by printing a newline */
/* however, this is undesirable when printing out single objects */
/* use this variable to avoid it */
static bool first_line = true;       /* if first line */

static void
first_newline() {
    if( first_line ) {
        first_line = false;
    } else {
        raw( "\n" );
    }
}

char *      /* returns name of file written to in static storage */
SCHEMAout( Schema s ) {
#define BUFSIZE     80
    char buf[BUFSIZE];
    char * p;
    FILE * f;
    int level = 0;
    char ** hp;
    bool described = false;

    if( exppp_output_filename_reset ) {
        exppp_output_filename = 0;
    }

    if( exppp_output_filename ) {
        strcpy( filename, exppp_output_filename );
    } else {
        /* when there is only a single file, allow user to find */
        /* out what it is */
        exppp_output_filename = filename;
        exppp_output_filename_reset = true;

        /* since we have to generate a filename, make sure we don't */
        /* overwrite a valuable file */

        sprintf( filename, "%s.exp", s->symbol.name );

        if( 0 != ( f = fopen( filename, "r" ) ) ) {
            fgets( buf, BUFSIZE, f );
            if( 0 != ( p = strchr( buf, '\n' ) ) ) {
                *p = '\0';
            }
            if( streq( buf, expheader[0] ) ) {
                unlink( filename );
            } else {
                fprintf( stderr, "%s: %s already exists and appears to be hand-written\n",
                         EXPRESSprogram_name, filename );
                /*          strcat(bp,".pp");*/
                strcat( filename, ".pp" );
                fprintf( stderr, "%s: writing schema file %s instead\n",
                         EXPRESSprogram_name, filename );
                described = true;
            }
        }
        fclose( f );
    }
    error_sym.filename = filename;

    if( !described && !exppp_terse ) {
        fprintf( stdout, "%s: writing schema file %s\n", EXPRESSprogram_name, filename );
    }
    if( !( exppp_fp = f = fopen( filename, "w" ) ) ) {
        ERRORreport( ERROR_file_unwriteable, filename, strerror( errno ) );
        return 0;
    }

    if( exppp_rmpp && rm ) {
        fprintf( rm, " %s", filename );
    }

    error_sym.line = 1;
    for( hp = expheader; *hp; hp++ ) {
        raw( "%s\n", *hp );
    }

    /*  first_newline();*/
    /*  raw("SCHEMA %s;\n",s->symbol.name);*/

    first_line = false;
    raw( "\nSCHEMA %s;\n", s->symbol.name );

    if( s->u.schema->usedict || s->u.schema->use_schemas
            || s->u.schema->refdict || s->u.schema->ref_schemas ) {
        raw( "\n" );
    }

    REFout( s->u.schema->usedict, s->u.schema->use_schemas, "USE", level + exppp_nesting_indent );
    REFout( s->u.schema->refdict, s->u.schema->ref_schemas, "REFERENCE", level + exppp_nesting_indent );

    SCOPEconsts_out( s, level + exppp_nesting_indent );
    SCOPEtypes_out( s, level + exppp_nesting_indent );
    SCOPEentities_out( s, level + exppp_nesting_indent );
    SCOPEalgs_out( s, level + exppp_nesting_indent );

    raw( "\nEND_SCHEMA; -- %s\n", s->symbol.name );

    fclose( exppp_fp );

    return filename;
}

void
REFout( Dictionary refdict, Linked_List reflist, char * type, int level ) {
    Dictionary dict;
    DictionaryEntry de;
    struct Rename * r;
    Linked_List list;

    LISTdo( reflist, s, Schema )
    raw( "%s FROM %s;\n", type, s->symbol.name );
    LISTod

    if( !refdict ) {
        return;
    }
    dict = DICTcreate( 10 );

    /* sort each list by schema */

    /* step 1: for each entry, store it in a schema-specific list */
    DICTdo_init( refdict, &de );
    while( 0 != ( r = ( struct Rename * )DICTdo( &de ) ) ) {
        Linked_List list;

        list = ( Linked_List )DICTlookup( dict, r->schema->symbol.name );
        if( !list ) {
            list = LISTcreate();
            DICTdefine( dict, r->schema->symbol.name, list,
                        ( Symbol * )0, OBJ_UNKNOWN );
        }
        LISTadd( list, r );
    }

    /* step 2: for each list, print out the renames */
    level = 6;  /* no special reason, feels good */
    indent2 = level + exppp_continuation_indent;
    DICTdo_init( dict, &de );
    while( 0 != ( list = ( Linked_List )DICTdo( &de ) ) ) {
        int first_time = true;
        LISTdo( list, r, struct Rename * )
        if( first_time ) {
            raw( "%s FROM %s\n", type, r->schema->symbol.name );
        } else {
            /* finish previous line */
            raw( ",\n" );
        }

        if( first_time ) {
            raw( "%*s(", level, "" );
            first_time = false;
        } else {
            raw( "%*s ", level, "" );
        }
        raw( r->old->name );
        if( r->old != r->nnew ) {
            wrap( " AS %s", r->nnew->name );
        }
        LISTod
        raw( ");\n" );
    }
    HASHdestroy( dict );
}

void
ALGscope_out( Scope s, int level ) {
    SCOPEtypes_out( s, level );
    SCOPEentities_out( s, level );
    SCOPEalgs_out( s, level );

    SCOPEconsts_out( s, level );
    SCOPElocals_out( s, level );
}

void
SCOPEadd_inorder( Linked_List list, Scope s ) {
    Link k = 0;

    LISTdo_links( list, link )
    if( 0 > strcmp(
                SCOPEget_name( s ),
                SCOPEget_name( ( Type )( link->data ) ) ) ) {
        k = link;
        break;
    }
    LISTod

    LISTadd_before( list, k, ( Generic )s );
}

/* print the rules in a scope */
void
SCOPErules_out( Scope s, int level ) {
    Rule r;
    DictionaryEntry de;

    if( exppp_alphabetize == false ) {
        DICTdo_type_init( s->symbol_table, &de, OBJ_RULE );
        while( 0 != ( r = ( Rule )DICTdo( &de ) ) ) {
            RULE_out( r, level );
        }
    } else {
        Linked_List alpha = LISTcreate();

        DICTdo_type_init( s->symbol_table, &de, OBJ_RULE );
        while( 0 != ( r = ( Rule )DICTdo( &de ) ) ) {
            SCOPEadd_inorder( alpha, r );
        }

        LISTdo( alpha, r, Rule )
        RULE_out( r, level );
        LISTod

        LISTfree( alpha );
    }

}

/* print the functions in a scope */
void
SCOPEfuncs_out( Scope s, int level ) {
    Function f;
    DictionaryEntry de;

    if( exppp_alphabetize == false ) {
        DICTdo_type_init( s->symbol_table, &de, OBJ_FUNCTION );
        while( 0 != ( f = ( Function )DICTdo( &de ) ) ) {
            FUNC_out( f, level );
        }
    } else {
        Linked_List alpha = LISTcreate();

        DICTdo_type_init( s->symbol_table, &de, OBJ_FUNCTION );
        while( 0 != ( f = ( Function )DICTdo( &de ) ) ) {
            SCOPEadd_inorder( alpha, f );
        }

        LISTdo( alpha, f, Function )
        FUNC_out( f, level );
        LISTod

        LISTfree( alpha );
    }

}

/* print the procs in a scope */
void
SCOPEprocs_out( Scope s, int level ) {
    Procedure p;
    DictionaryEntry de;

    if( exppp_alphabetize == false ) {
        DICTdo_type_init( s->symbol_table, &de, OBJ_PROCEDURE );
        while( 0 != ( p = ( Procedure )DICTdo( &de ) ) ) {
            PROC_out( p, level );
        }
    } else {
        Linked_List alpha = LISTcreate();

        DICTdo_type_init( s->symbol_table, &de, OBJ_PROCEDURE );
        while( 0 != ( p = ( Procedure )DICTdo( &de ) ) ) {
            SCOPEadd_inorder( alpha, p );
        }

        LISTdo( alpha, p, Procedure )
        PROC_out( p, level );
        LISTod

        LISTfree( alpha );
    }

}

/* print the algorithms in a scope */
void
SCOPEalgs_out( Scope s, int level ) {
    /* Supplementary Directivies 2.1.1 requires rules to be separated */
    /* might as well separate funcs and procs, too */
    SCOPErules_out( s, level );
    SCOPEfuncs_out( s, level );
    SCOPEprocs_out( s, level );
}

static int
min( int a, int b, int c ) {
    if( a < b ) {
        return ( ( a < c ) ? a : c );
    } else {
        return ( ( b < c ) ? b : c );
    }
}

static void
copy_file_chunk( char * filename, int start, int end, int level ) {
    FILE * infile;
    char buff[256];
    int i, indent, undent = 0, fix;

    if( !( infile = fopen( filename, "r" ) ) ) {
        ERRORreport( ERROR_file_unreadable, filename, strerror( errno ) );
    }

    /* skip to start of chunk */
    for( i = start; --i; ) {
        fgets( buff, 255, infile );
    }

    /* copy first line and compute indentation correction factor */
    fgets( buff, 255, infile );
    indent = level - strspn( buff, " " );
    if( indent < 0 ) {
        undent = -indent;
        indent = 0;
    }
    raw( "%*s%s", indent, "", buff + undent );
    indent = indent - undent;

    /* copy the rest */
    for( i = end - start; i--; ) {
        fgets( buff, 255, infile );
        fix = min( undent, strlen( buff ), strspn( buff, " " ) );
        raw( "%*s%s", indent + fix, "", buff + fix );
    }

    fclose( infile );
}

void
RULE_out( Rule r, int level ) {
    int i = 0;

    first_newline();
    exppp_ref_info( &r->symbol );

    if( exppp_preserve_comments == false ) {
        raw( "%*sRULE %s FOR (", level, "", r->symbol.name );

        LISTdo( r->u.rule->parameters, p, Variable )
        i++;
        if( i != 1 ) {
            raw( ", " );
        }
        wrap( p->name->symbol.name );
        LISTod;
        raw( ");\n" );

        ALGscope_out( r, level + exppp_nesting_indent );
        STMTlist_out( r->u.rule->body, level + exppp_nesting_indent );
        raw( "\n" );
        WHERE_out( RULEget_where( r ), level );

        raw( "\n%*sEND_RULE; -- %s\n", level, "", r->symbol.name );
    } else {
        copy_file_chunk( r->symbol.filename, r->u.rule->text.start,
                         r->u.rule->text.end, level );
    }
}

/* last arg is not terminated with ; or \n */
void
ALGargs_out( Linked_List args, int level ) {
    Type previoustype = 0;
    indent2 = level + exppp_continuation_indent;

    /* combine adjacent parameters that have the same type */

    LISTdo( args, v, Variable )
    if( previoustype != v->type ) {
        if( previoustype ) {
            wrap( ":" );
            TYPE_head_out( previoustype, NOLEVEL );
            raw( ";\n" );
        }
        raw( "%*s", level, "" );
        EXPR_out( VARget_name( v ), 0 );
    } else {
        raw( ", " );
        EXPR_out( VARget_name( v ), 0 );
    }
    previoustype = v->type;
    LISTod

    wrap( ":" );
    TYPE_head_out( previoustype, NOLEVEL );
}

void
FUNC_out( Function fn, int level ) {
    if( fn->u.func->builtin ) {
        return;
    }

    first_newline();
    exppp_ref_info( &fn->symbol );

    if( exppp_preserve_comments == false ) {
        raw( "%*sFUNCTION %s", level, "", fn->symbol.name );

        if( fn->u.func->parameters ) {
            raw( "(\n" );
            ALGargs_out( fn->u.func->parameters,
                         level + strlen( "FUNCTION     " ) );
            raw( "\n%*s)", level + exppp_continuation_indent, "" );
        }
        raw( ":" );

        indent2 = curpos + exppp_continuation_indent;
        TYPE_head_out( fn->u.func->return_type, NOLEVEL );
        raw( ";\n" );

        ALGscope_out( fn, level + exppp_nesting_indent );
        STMTlist_out( fn->u.proc->body, level + exppp_nesting_indent );

        raw( "\n%*sEND_FUNCTION; -- %s\n", level, "", fn->symbol.name );
    } else {
        copy_file_chunk( fn->symbol.filename, fn->u.func->text.start,
                         fn->u.func->text.end, level );
    }
}
void
PROC_out( Procedure p, int level ) {
    if( p->u.proc->builtin ) {
        return;
    }

    first_newline();
    exppp_ref_info( &p->symbol );

    if( exppp_preserve_comments == false ) {
        raw( "%*sPROCEDURE %s(\n", level, "", p->symbol.name );

        ALGargs_out( p->u.proc->parameters, level + strlen( "PROCEDURE     " ) );

        raw( "%*s);\n", level + exppp_nesting_indent, "" );

        ALGscope_out( p, level + exppp_nesting_indent );
        STMTlist_out( p->u.proc->body, level + exppp_nesting_indent );

        raw( "\n%*sEND_PROCEDURE; -- %s\n", level, "", p->symbol.name );
    } else {
        copy_file_chunk( p->symbol.filename, p->u.proc->text.start,
                         p->u.proc->text.end, level );
    }
}

void
SCOPEconsts_out( Scope s, int level ) {
    Variable v;
    DictionaryEntry de;
    int max_indent = 0;
    Dictionary d = s->symbol_table;

    DICTdo_type_init( d, &de, OBJ_VARIABLE );
    while( 0 != ( v = ( Variable )DICTdo( &de ) ) ) {
        if( !v->flags.constant ) {
            continue;
        }
        if( strlen( v->name->symbol.name ) > max_indent ) {
            max_indent = strlen( v->name->symbol.name );
        }
    }

    if( !max_indent ) {
        return;
    }

    first_newline();

    raw( "%*sCONSTANT\n", level, "" );

    indent2 = level + max_indent + strlen( ": " ) + exppp_continuation_indent;

    DICTdo_type_init( d, &de, OBJ_VARIABLE );
    while( 0 != ( v = ( Variable )DICTdo( &de ) ) ) {
        if( !v->flags.constant ) {
            continue;
        }

        /* print attribute name */
        raw( "%*s%-*s :", level, "",
             max_indent, v->name->symbol.name );

        /* print attribute type */
        if( VARget_optional( v ) ) {
            wrap( " OPTIONAL" );
        }
        TYPE_head_out( v->type, NOLEVEL );

        if( v->initializer ) {
            wrap( " := " );
            EXPR_out( v->initializer, 0 );
        }

        raw( ";\n" );
    }

    raw( "%*sEND_CONSTANT;\n", level, "" );
}

void
SCOPElocals_out( Scope s, int level ) {
    Variable v;
    DictionaryEntry de;
    int max_indent = 0;
    Dictionary d = s->symbol_table;

    DICTdo_type_init( d, &de, OBJ_VARIABLE );
    while( 0 != ( v = ( Variable )DICTdo( &de ) ) ) {
        if( v->flags.constant ) {
            continue;
        }
        if( v->flags.parameter ) {
            continue;
        }
        if( strlen( v->name->symbol.name ) > max_indent ) {
            max_indent = strlen( v->name->symbol.name );
        }
    }

    if( !max_indent ) {
        return;
    }

    first_newline();

    raw( "%*sLOCAL\n", level, "" );
    indent2 = level + max_indent + strlen( ": " ) + exppp_continuation_indent;

    DICTdo_type_init( d, &de, OBJ_VARIABLE );
    while( 0 != ( v = ( Variable )DICTdo( &de ) ) ) {
        if( v->flags.constant ) {
            continue;
        }
        if( v->flags.parameter ) {
            continue;
        }

        /* print attribute name */
        raw( "%*s%-*s :", level + exppp_nesting_indent, "",
             max_indent, v->name->symbol.name );

        /* print attribute type */
        if( VARget_optional( v ) ) {
            wrap( " OPTIONAL" );
        }
        TYPE_head_out( v->type, NOLEVEL );

        if( v->initializer ) {
            wrap( " := " );
            EXPR_out( v->initializer, 0 );
        }

        raw( ";\n" );
    }

    raw( "%*sEND_LOCAL;\n", level, "" );
}

void
LOOPout( struct Loop_ *loop, int level ) {
    Variable v;

    raw( "%*sREPEAT", level, "" );

    /* increment */
    /*  if (loop->scope->u.incr) {*/
    if( loop->scope ) {
        DictionaryEntry de;

        DICTdo_init( loop->scope->symbol_table, &de );
        v = ( Variable )DICTdo( &de );
        wrap( " %s := ", v->name->symbol.name );
        EXPR_out( loop->scope->u.incr->init, 0 );
        wrap( " TO " );
        EXPR_out( loop->scope->u.incr->end, 0 );
        wrap( " BY " ); /* parser always forces a "by" expr */
        EXPR_out( loop->scope->u.incr->increment, 0 );
    }

    /* while */
    if( loop->while_expr ) {
        wrap( " WHILE " );
        EXPR_out( loop->while_expr, 0 );
    }

    /* until */
    if( loop->until_expr ) {
        wrap( " UNTIL " );
        EXPR_out( loop->until_expr, 0 );
    }

    raw( ";\n" );

    STMTlist_out( loop->statements, level + exppp_nesting_indent );

    raw( "%*sEND_REPEAT;\n", level, "" );
}

void
CASEout( struct Case_Statement_ *c, int level ) {
    int len = 0;
    int max_indent;

    raw( "%*sCASE ", level, "" );
    EXPR_out( c->selector, 0 );
    wrap( " OF\n" );

    /* pass 1: calculate length of longest label */
    max_indent = 0;
    LISTdo( c->cases, ci, Case_Item )
    if( ci->labels ) {
        LISTdo( ci->labels, label, Expression )
        len = EXPRlength( label );
        LISTod
    } else {
        len = strlen( "OTHERWISE" );
    }
    if( len > max_indent ) {
        max_indent = len;
    }
    LISTod

    level += exppp_nesting_indent;

    /* pass 2: print them */
    LISTdo( c->cases, ci, Case_Item )
    if( ci->labels ) {
        LISTdo( ci->labels, label, Expression )
        /* print label(s) */
        indent2 = level + exppp_continuation_indent;
        raw( "%*s", level, "" );
        EXPR_out( label, 0 );
        raw( "%*s : ", level + max_indent - curpos, "" );

        /* print action */
        STMT_out( ci->action, level + exppp_nesting_indent );
        LISTod
    } else {
        /* print OTHERWISE */
        indent2 = level + exppp_continuation_indent;
        raw( "%*s", level, "" );
        raw( "OTHERWISE" );
        raw( "%*s : ", level + max_indent - curpos, "" );

        /* print action */
        STMT_out( ci->action, level + exppp_nesting_indent );
    }
    LISTod

    raw( "%*sEND_CASE;\n", level, "" );
}

void
STMT_out( Statement s, int level ) {
    bool first_time = true;

    if( !s ) {  /* null statement */
        raw( "%*s;\n", level, "" );
        return;
    }

    indent2 = level + exppp_continuation_indent;

    switch( s->type ) {
        case STMT_ASSIGN:
            raw( "%*s", level, "" );
            EXPR_out( s->u.assign->lhs, 0 );
            wrap( " := " );
            EXPR_out( s->u.assign->rhs, 0 );
            raw( ";\n", level, "" );
            break;
        case STMT_CASE:
            CASEout( s->u.Case, level );
            break;
        case STMT_COMPOUND:
            raw( "%*sBEGIN\n", level, "" );
            STMTlist_out( s->u.compound->statements, level + exppp_nesting_indent );
            raw( "%*sEND;\n", level, "" );
            break;
        case STMT_COND:
            raw( "%*sIF ", level, "" );
            EXPR_out( s->u.cond->test, 0 );
            wrap( " THEN\n" );
            STMTlist_out( s->u.cond->code, level + exppp_nesting_indent );
            if( s->u.cond->otherwise ) {
                raw( "%*sELSE\n", level, "" );
                STMTlist_out( s->u.cond->otherwise, level + exppp_nesting_indent );
            }
            raw( "%*sEND_IF;\n", level, "" );
            break;
        case STMT_LOOP:
            LOOPout( s->u.loop, level );
            break;
        case STMT_PCALL:
            raw( "%*s%s(", level, "", s->symbol.name );
            LISTdo( s->u.proc->parameters, p, Expression )
            if( first_time ) {
                first_time = false;
            } else {
                raw( "," );
            }
            EXPR_out( p, 0 );
            LISTod
            raw( ");\n" );
            break;
        case STMT_RETURN:
            raw( "%*sRETURN", level, "" );
            if( s->u.ret->value ) {
                wrap( "(" );
                EXPR_out( s->u.ret->value, 0 );
                raw( ")" );
            }
            raw( ";\n" );
            break;
        case STMT_ALIAS:
            raw( "%*sALIAS %s for %s;\n", level, "", s->symbol.name,
                 /* should be generalized reference */
                 s->u.alias->variable->name->symbol.name );
            STMTlist_out( s->u.alias->statements, level + exppp_nesting_indent );
            raw( "%*sEND_ALIAS; -- %s\n", level, "", s->symbol.name );
            break;
        case STMT_SKIP:
            raw( "%*sSKIP;\n", level, "" );
            break;
        case STMT_ESCAPE:
            raw( "%*sESCAPE;\n", level, "" );
            break;
    }
}

void
STMTlist_out( Linked_List stmts, int level ) {
    LISTdo( stmts, stmt, Statement )
    STMT_out( stmt, level );
    LISTod
}

/* print all entities in a scope */
void
SCOPEentities_out( Scope s, int level ) {
    Entity e;
    DictionaryEntry de;

    if( exppp_alphabetize == false ) {
        DICTdo_type_init( s->symbol_table, &de, OBJ_ENTITY );
        while( 0 != ( e = ( Entity )DICTdo( &de ) ) ) {
            ENTITY_out( e, level );
        }
    } else {
        Linked_List alpha = LISTcreate();

        DICTdo_type_init( s->symbol_table, &de, OBJ_ENTITY );
        while( 0 != ( e = ( Entity )DICTdo( &de ) ) ) {
            SCOPEadd_inorder( alpha, e );
        }

        LISTdo( alpha, e, Entity )
        ENTITY_out( e, level );
        LISTod

        LISTfree( alpha );
    }
}

void
SUBTYPEout( Expression e ) {
    /* language insists on having parens around entity names */
    /* even if there is only one, but if the expression is */
    /* complex, EXPRout will add on its own parens */
    /*  if (TYPEis_expression(e->type)) {*/
    raw( "(" );
    /*  }*/

    EXPR_out( e, 0 );

    /*  if (TYPEis_expression(e->type)) {*/
    raw( ")" );
    /*  }*/
}

#define EXPLICIT 0
#define DERIVED 1

void
ENTITY_out( Entity e, int level ) {
    bool first_time = true;

    first_newline();
    exppp_ref_info( &e->symbol );

    raw( "%*sENTITY %s", level, "", e->symbol.name );

    level += exppp_nesting_indent;
    indent2 = level + exppp_continuation_indent;

    if( ENTITYget_abstract( e ) ) {
        if( e->u.entity->subtype_expression ) {
            raw( "\n%*sABSTRACT SUPERTYPE OF ", level, "" );
            SUBTYPEout( e->u.entity->subtype_expression );
        } else {
            raw( "\n%*sABSTRACT SUPERTYPE", level, "" );
        }
    } else {
        if( e->u.entity->subtype_expression ) {
            raw( "\n%*sSUPERTYPE OF ", level, "" );
            SUBTYPEout( e->u.entity->subtype_expression );
        }
    }

    if( e->u.entity->supertype_symbols ) {
        raw( "\n%*sSUBTYPE OF (", level, "" );

        LISTdo( e->u.entity->supertype_symbols, s, Symbol * )
        if( first_time ) {
            first_time = false;
        } else {
            raw( ", " );
        }
        wrap( s->name );
        LISTod
        raw( ")" );
    }

    raw( ";\n" );

#if 0
    /* add a little more space before entities if sub or super appears */
    if( e->u.entity->supertype_symbols || e->u.entity->subtype_expression ) {
        raw( "\n" );
    }
#endif

    ENTITYattrs_out( e->u.entity->attributes, EXPLICIT, level );
    ENTITYattrs_out( e->u.entity->attributes, DERIVED, level );
    ENTITYinverse_out( e->u.entity->attributes, level );
    ENTITYunique_out( e->u.entity->unique, level );
    WHERE_out( TYPEget_where( e ), level );

    level -= exppp_nesting_indent;
    raw( "%*sEND_ENTITY; -- %s\n", level, "", e->symbol.name );
}

void
ENTITYunique_out( Linked_List u, int level ) {
    int i;
    int max_indent;
    Symbol * sym;
    int length;

    if( !u ) {
        return;
    }

    raw( "%*sUNIQUE\n", level, "" );

    /* pass 1 */
    max_indent = 0;
    LISTdo( u, list, Linked_List )
    if( 0 != ( sym = ( Symbol * )LISTget_first( list ) ) ) {
        length = strlen( sym->name );
        if( length > max_indent ) {
            max_indent = length;
        }
    }
    LISTod

    level += exppp_nesting_indent;
    indent2 = level + max_indent + strlen( ": " ) + exppp_continuation_indent;

    LISTdo( u, list, Linked_List )
    i = 0;
    LISTdo( list, v, Variable )
    i++;
    if( i == 1 ) {
        /* print label if present */
        if( v ) {
            raw( "%*s%-*s : ", level, "",
                 max_indent, ( ( Symbol * )v )->name );
        } else {
            raw( "%*s%-*s   ", level, "",
                 max_indent, "" );
        }
    } else {
        if( i > 2 ) {
            raw( ", " );
        }
        EXPR_out( v->name, 0 );
    }
    LISTod
    raw( ";\n" );
    LISTod
}

void
ENTITYinverse_out( Linked_List attrs, int level ) {
    int length;

    int max_indent;

    /* pass 1: calculate length of longest attr name */
    max_indent = 0;
    LISTdo( attrs, v, Variable )
    if( v->inverse_symbol ) {
        length = strlen( v->name->symbol.name );
        if( length > max_indent ) {
            max_indent = length;
        }
    }
    LISTod

    if( max_indent == 0 ) {
        return;
    }
    raw( "%*sINVERSE\n", level, "" );
    level += exppp_nesting_indent;
    indent2 = level + max_indent + strlen( ": " ) + exppp_continuation_indent;

    /* pass 2: print them */
    LISTdo( attrs, v, Variable )
    if( v->inverse_symbol ) {
        /* print attribute name */
        raw( "%*s%-*s :", level, "",
             max_indent, v->name->symbol.name );

        /* print attribute type */
        if( VARget_optional( v ) ) {
            wrap( " OPTIONAL" );
        }
        TYPE_head_out( v->type, NOLEVEL );

        raw( " FOR " );

        wrap( v->inverse_attribute->name->symbol.name );

        raw( ";\n" );
    }
    LISTod
}

void
ENTITYattrs_out( Linked_List attrs, int derived, int level ) {
    int length;

    int max_indent;

    /* pass 1: calculate length of longest attr name */
    max_indent = 0;
    LISTdo( attrs, v, Variable )
    if( v->inverse_symbol ) {
        continue;
    }
    if( ( derived && v->initializer ) ||
            ( !derived && !v->initializer ) ) {
        length = EXPRlength( v->name );
        if( length > max_indent ) {
            max_indent = length;
        }
    }
    LISTod

    if( max_indent == 0 ) {
        return;
    }
    if( derived ) {
        raw( "%*sDERIVE\n", level, "" );
    }
    level += exppp_nesting_indent;
    indent2 = level + max_indent + strlen( ": " ) + exppp_continuation_indent;

    /* pass 2: print them */
    LISTdo( attrs, v, Variable )
    if( v->inverse_symbol ) {
        continue;
    }
    if( ( derived && v->initializer ) ||
            ( !derived && !v->initializer ) ) {
        /* print attribute name */
        raw( "%*s", level, "" );
        EXPR_out( v->name, 0 );
        raw( "%*s :", level + max_indent + 1 - curpos, "" );

        /* print attribute type */
        if( VARget_optional( v ) ) {
            wrap( " OPTIONAL" );
        }
        TYPE_head_out( v->type, NOLEVEL );

        if( derived && v->initializer ) {
            wrap( " := " );
            EXPR_out( v->initializer, 0 );
        }

        raw( ";\n" );
    }
    LISTod
}

void
WHERE_out( Linked_List wheres, int level ) {
    int max_indent;
    if( !wheres ) {
        return;
    }

    raw( "%*s%s", level, "", "WHERE\n" );
    level += exppp_nesting_indent;

    /* pass 1: calculate length of longest label */
    max_indent = 0;
    LISTdo( wheres, w, Where )
    if( w->label ) {
        if( strlen( w->label->name ) > max_indent ) {
            max_indent = strlen( w->label->name );
        }
    }
    LISTod

    if( max_indent > 10 ) {
        /* don't bother indenting completely for labels that are */
        /* ridiculously long */
        max_indent = 4;
    }
    indent2 = level + max_indent + strlen( ": " ) + exppp_continuation_indent;

    /* pass 2: now print labels and exprs */
    LISTdo( wheres, w, Where )
    if( w->label ) {
        raw( "%*s%-*s: ", level, "", max_indent, w->label->name );
    } else {
        /* no label */
        raw( "%*s%-*s  ", level, "", max_indent, "" );
    }
    EXPR_out( w->expr, max_indent );
    raw( ";\n" );
    LISTod
}

/* print all types in a scope */
void
SCOPEtypes_out( Scope s, int level ) {
    DictionaryEntry de;
    Type t;

    if( exppp_alphabetize == false ) {
        DICTdo_type_init( s->symbol_table, &de, OBJ_TYPE );
        while( 0 != ( t = ( Type )DICTdo( &de ) ) ) {
            TYPE_out( t, level );
        }
    } else {
        Linked_List alpha = LISTcreate();

        DICTdo_type_init( s->symbol_table, &de, OBJ_TYPE );
        while( 0 != ( t = ( Type )DICTdo( &de ) ) ) {
            SCOPEadd_inorder( alpha, t );
        }

        LISTdo( alpha, t, Type )
        TYPE_out( t, level );
        LISTod

        LISTfree( alpha );
    }
}

/* print a type definition.  I.e., a TYPE statement */
void
TYPE_out( Type t, int level ) {
    first_newline();
    exppp_ref_info( &t->symbol );

    raw( "%*sTYPE %s =", level, "", t->symbol.name );
    if( TYPEget_head( t ) ) {
        wrap( " %s", TYPEget_name( TYPEget_head( t ) ) );
    } else {
        TYPE_body_out( t, level + exppp_nesting_indent );
    }

    raw( ";\n" );

    WHERE_out( t->where, level );

    raw( "%*sEND_TYPE; -- %s\n", level, "", t->symbol.name );
}

/* prints type description (preceded by a space).  I.e., the type of an */
/* attribute or other object */
void
TYPE_head_out( Type t, int level ) {
    if( t->symbol.name ) {
        wrap( " %s", t->symbol.name );
    } else {
        TYPE_body_out( t, level );
    }
}

void TYPEunique_or_optional_out( TypeBody tb ) {
    if( tb->flags.unique ) {
        wrap( " UNIQUE" );
    }
    if( tb->flags.optional ) {
        wrap( " OPTIONAL" );
    }
}

void
TYPE_body_out( Type t, int level ) {
    bool first_time = true;

    Expression expr;
    DictionaryEntry de;

    TypeBody tb = TYPEget_body( t );

    switch( tb->type ) {
        case integer_:
            wrap( " INTEGER" );
            break;
        case real_:
            wrap( " REAL" );
            break;
        case string_:
            wrap( " STRING" );
            break;
        case binary_:
            wrap( " BINARY" );
            break;
        case boolean_:
            wrap( " BOOLEAN" );
            break;
        case logical_:
            wrap( " LOGICAL" );
            break;
        case number_:
            wrap( " NUMBER" );
            break;
        case entity_:
            wrap( " %s", tb->entity->symbol.name );
            break;
        case aggregate_:
        case array_:
        case bag_:
        case set_:
        case list_:
            switch( tb->type ) {
                    /* ignore the aggregate bounds for now */
                case aggregate_:
                    wrap( " AGGREGATE" );
                    if( tb->tag ) {
                        wrap( ":%s", tb->tag->symbol.name );
                    }
                    wrap( " OF" );
                    break;

                case array_:
                    wrap( " ARRAY" );
                    EXPRbounds_out( tb );
                    wrap( " OF" );
                    TYPEunique_or_optional_out( tb );
                    break;

                case bag_:
                    wrap( " BAG" );
                    EXPRbounds_out( tb );
                    wrap( " OF" );
                    break;

                case set_:
                    wrap( " SET" );
                    EXPRbounds_out( tb );
                    wrap( " OF" );
                    break;

                case list_:
                    wrap( " LIST" );
                    EXPRbounds_out( tb );
                    wrap( " OF" );
                    TYPEunique_or_optional_out( tb );
                    break;
                default:
                    printf( "Error in %s, line %d: type %d not handled by switch statement.", __FILE__, __LINE__, tb->type );
                    abort();
            }

            TYPE_head_out( tb->base, level );
            break;
        case enumeration_: {
#if 1
            int i, count = 0;
            char ** names;

            /*
             * write names out in original order by first bucket sorting
             * to a temporary array.  This is trivial since all buckets
             * will get filled with one and only one object.
             */
            DICTdo_type_init( t->symbol_table, &de, OBJ_EXPRESSION );
            while( 0 != ( expr = ( Expression )DICTdo( &de ) ) ) {
                count++;
            }
            names = ( char ** )malloc( count * sizeof( char * ) );
            DICTdo_type_init( t->symbol_table, &de, OBJ_EXPRESSION );
            while( 0 != ( expr = ( Expression )DICTdo( &de ) ) ) {
                names[expr->u.integer - 1] = expr->symbol.name;
            }

            wrap( " ENUMERATION OF\n" );

            for( i = 0; i < count; i++ ) {
                /* finish line from previous enum item */
                if( !first_time ) {
                    raw( ",\n" );
                }

                /* start new enum item */
                if( first_time ) {
                    raw( "%*s(", level, "" );
                    first_time = false;
                } else {
                    raw( "%*s ", level, "" );
                }
                raw( names[i] );
            }
            raw( ")" );
            free( ( char * )names );
        }
#else
            wrap( " ENUMERATION OF\n" );
            DICTdo_type_init( t->symbol_table, &de, OBJ_EXPRESSION );
            while( 0 != ( expr = ( Expression )DICTdo( &de ) ) ) {

                /* finish line from previous enum item */
                if( !first_time ) {
                    raw( ",\n" );
                }

                /* start new enum item */
                if( first_time ) {
                    raw( "%*s(", level, "" );
                    first_time = False;
                } else {
                    raw( "%*s ", level, "" );
                }
                raw( expr->symbol.name );
            }
            raw( ")" );
#endif
        break;
        case select_:
            wrap( " SELECT\n" );
            LISTdo( tb->list, type, Type )
            /* finish line from previous entity */
            if( !first_time ) {
                raw( ",\n" );
            }

            /* start new entity */
            if( first_time ) {
                raw( "%*s(", level, "" );
                first_time = false;
            } else {
                raw( "%*s ", level, "" );
            }
            raw( type->symbol.name );
            LISTod

            /* if empty, force a left paren */
            if( first_time ) {
                ERRORreport_with_symbol( ERROR_select_empty, &error_sym, t->symbol.name );
                raw( "%*s(", level, "" );
            }
            raw( ")" );
            break;
        case generic_:
            wrap( " GENERIC" );
            if( tb->tag ) {
                wrap( ":%s", tb->tag->symbol.name );
            }
            break;
        default:
            wrap( " (* unknown type %d *)", tb->type );
    }

    if( tb->precision ) {
        wrap( " (" );
        EXPR_out( tb->precision, 0 );
        raw( ")" );
    }
    if( tb->flags.fixed ) {
        wrap( " FIXED" );
    }
}

void
EXPRbounds_out( TypeBody tb ) {
    if( !tb->upper ) {
        return;
    }

    wrap( " [" );
    EXPR_out( tb->lower, 0 );
    wrap( ":" );
    EXPR_out( tb->upper, 0 );
    raw( "]" );
}

/*
 if paren == 1, parens are usually added to prevent possible rebind by
    higher-level context.  If op is similar to previous op (and
    precedence/associativity is not a problem) parens may be omitted.
 if paren == 0, then parens may be omitted without consequence
*/
void
EXPR__out( Expression e, int paren, int previous_op ) {
    int i;  /* trusty temporary */

    switch( TYPEis( e->type ) ) {
        case integer_:
            if( e == LITERAL_INFINITY ) {
                wrap( "?" );
            } else {
                wrap( "%d", e->u.integer );
            }
            break;
        case real_:
            if( e == LITERAL_PI ) {
                wrap( "PI" );
            } else if( e == LITERAL_E ) {
                wrap( "E" );
            } else {
                wrap( "%g", e->u.real );
            }
            break;
        case binary_:
            wrap( "%%%s", e->u.binary ); /* put "%" back */
            break;
        case logical_:
        case boolean_:
            switch( e->u.logical ) {
                case Ltrue:
                    wrap( "TRUE" );
                    break;
                case Lfalse:
                    wrap( "FALSE" );
                    break;
                default:
                    wrap( "UNKNOWN" );
                    break;
            }
            break;
        case string_:
            if( TYPEis_encoded( e->type ) ) {
                wrap( "\"%s\"", e->symbol.name );
            } else {
                wrap( "'%s'", e->symbol.name );
            }
            break;
        case entity_:
        case identifier_:
        case attribute_:
        case enumeration_:
            wrap( "%s", e->symbol.name );
            break;
        case query_:
            wrap( "QUERY ( %s <* ", e->u.query->local->name->symbol.name );
            EXPR_out( e->u.query->aggregate, 1 );
            wrap( " | " );
            EXPR_out( e->u.query->expression, 1 );
            raw( " )" );
            break;
        case self_:
            wrap( "SELF" );
            break;
        case funcall_:
            wrap( "%s(", e->symbol.name );
            i = 0;
            LISTdo( e->u.funcall.list, arg, Expression )
            i++;
            if( i != 1 ) {
                raw( "," );
            }
            EXPR_out( arg, 0 );
            LISTod
            raw( ")" );
            break;
        case op_:
            EXPRop__out( &e->e, paren, previous_op );
            break;
        case aggregate_:
            wrap( "[" );
            i = 0;
            LISTdo( e->u.list, arg, Expression )
            i++;
            if( i != 1 ) {
                raw( "," );
            }
            EXPR_out( arg, 0 );
            LISTod
            raw( "]" );
            break;
        case oneof_:
            wrap( "ONEOF (" );

            i = 0;
            LISTdo( e->u.list, arg, Expression )
            i++;
            if( i != 1 ) {
                raw( "," );
            }
            EXPR_out( arg, 0 );
            LISTod

            raw( ")" );
            break;
        default:
            wrap( "unknown expression, type %d", TYPEis( e->type ) );
    }
}

#define PAD 1
#define NOPAD   0

/* print expression that has op and operands */
void
EXPRop__out( struct Op_Subexpression * oe, int paren, int previous_op ) {
    switch( oe->op_code ) {
        case OP_AND:
        case OP_ANDOR:
        case OP_OR:
        case OP_CONCAT:
        case OP_EQUAL:
        case OP_PLUS:
        case OP_TIMES:
        case OP_XOR:
            EXPRop2__out( oe, ( char * )0, paren, PAD, previous_op );
            break;
        case OP_EXP:
        case OP_GREATER_EQUAL:
        case OP_GREATER_THAN:
        case OP_IN:
        case OP_INST_EQUAL:
        case OP_INST_NOT_EQUAL:
        case OP_LESS_EQUAL:
        case OP_LESS_THAN:
        case OP_LIKE:
        case OP_MOD:
        case OP_NOT_EQUAL:
            EXPRop2_out( oe, ( char * )0, paren, PAD );
            break;
        case OP_NOT:
            EXPRop1_out( oe, "NOT ", paren );
            break;
        case OP_REAL_DIV:
        case OP_DIV:
            EXPRop2_out( oe, "/", paren, PAD );
            break;
        case OP_MINUS:
            EXPRop2_out( oe, "-", paren, PAD );
            break;
        case OP_DOT:
            EXPRop2_out( oe, ".", paren, NOPAD );
            break;
        case OP_GROUP:
            EXPRop2_out( oe, "\\", paren, NOPAD );
            break;
        case OP_NEGATE:
            EXPRop1_out( oe, "-", paren );
            break;
        case OP_ARRAY_ELEMENT:
            EXPR_out( oe->op1, 1 );
            wrap( "[" );
            EXPR_out( oe->op2, 0 );
            raw( "]" );
            break;
        case OP_SUBCOMPONENT:
            EXPR_out( oe->op1, 1 );
            wrap( "[" );
            EXPR_out( oe->op2, 0 );
            wrap( ":" );
            EXPR_out( oe->op3, 0 );
            raw( "]" );
            break;
        default:
            wrap( "(* unknown op-expression *)" );
    }
}

void
EXPRop2__out( struct Op_Subexpression * eo, char * opcode, int paren, int pad, int previous_op ) {
    if( pad && paren && ( eo->op_code != previous_op ) ) {
        wrap( "(" );
    }
    EXPR__out( eo->op1, 1, eo->op_code );
    if( pad ) {
        raw( " " );
    }
    wrap( "%s", ( opcode ? opcode : EXPop_table[eo->op_code].token ) );
    if( pad ) {
        wrap( " " );
    }
    EXPR__out( eo->op2, 1, eo->op_code );
    if( pad && paren && ( eo->op_code != previous_op ) ) {
        raw( ")" );
    }
}

/* Print out a one-operand operation.  If there were more than two of these */
/* I'd generalize it to do padding, but it's not worth it. */
void
EXPRop1_out( struct Op_Subexpression * eo, char * opcode, int paren ) {
    if( paren ) {
        wrap( "(" );
    }
    wrap( "%s", opcode );
    EXPR_out( eo->op1, 1 );
    if( paren ) {
        raw( ")" );
    }
}

int
EXPRop_length( struct Op_Subexpression * oe ) {
    switch( oe->op_code ) {
        case OP_DOT:
        case OP_GROUP:
            return( 1 + EXPRlength( oe->op1 )
                    + EXPRlength( oe->op2 ) );
        default:
            fprintf( stdout, "EXPRop_length: unknown op-expression" );
    }
    return 0;
}

/* returns printable representation of expression rather than printing it */
/* originally only used for general references, now being expanded to handle */
/* any kind of expression */
/* contains fragment of string, adds to it */
void
EXPRstring( char * buffer, Expression e ) {
    int i;

    switch( TYPEis( e->type ) ) {
        case integer_:
            if( e == LITERAL_INFINITY ) {
                strcpy( buffer, "?" );
            } else {
                sprintf( buffer, "%d", e->u.integer );
            }
            break;
        case real_:
            if( e == LITERAL_PI ) {
                strcpy( buffer, "PI" );
            } else if( e == LITERAL_E ) {
                strcpy( buffer, "E" );
            } else {
                sprintf( buffer, "%g", e->u.real );
            }
            break;
        case binary_:
            sprintf( buffer, "%%%s", e->u.binary ); /* put "%" back */
            break;
        case logical_:
        case boolean_:
            switch( e->u.logical ) {
                case Ltrue:
                    strcpy( buffer, "TRUE" );
                    break;
                case Lfalse:
                    strcpy( buffer, "FALSE" );
                    break;
                default:
                    strcpy( buffer, "UNKNOWN" );
                    break;
            }
            break;
        case string_:
            if( TYPEis_encoded( e->type ) ) {
                sprintf( buffer, "\"%s\"", e->symbol.name );
            } else {
                sprintf( buffer, "'%s'", e->symbol.name );
            }
            break;
        case entity_:
        case identifier_:
        case attribute_:
        case enumeration_:
            strcpy( buffer, e->symbol.name );
            break;
        case query_:
            sprintf( buffer, "QUERY ( %s <* ", e->u.query->local->name->symbol.name );
            EXPRstring( buffer + strlen( buffer ), e->u.query->aggregate );
            strcat( buffer, " | " );
            EXPRstring( buffer + strlen( buffer ), e->u.query->expression );
            strcat( buffer, " )" );
            break;
        case self_:
            strcpy( buffer, "SELF" );
            break;
        case funcall_:
            sprintf( buffer, "%s(", e->symbol.name );
            i = 0;
            LISTdo( e->u.funcall.list, arg, Expression )
            i++;
            if( i != 1 ) {
                strcat( buffer, "," );
            }
            EXPRstring( buffer + strlen( buffer ), arg );
            LISTod
            strcat( buffer, ")" );
            break;

        case op_:
            EXPRop_string( buffer, &e->e );
            break;
        case aggregate_:
            strcpy( buffer, "[" );
            i = 0;
            LISTdo( e->u.list, arg, Expression )
            i++;
            if( i != 1 ) {
                strcat( buffer, "," );
            }
            EXPRstring( buffer + strlen( buffer ), arg );
            LISTod
            strcat( buffer, "]" );
            break;
        case oneof_:
            strcpy( buffer, "ONEOF (" );

            i = 0;
            LISTdo( e->u.list, arg, Expression )
            i++;
            if( i != 1 ) {
                strcat( buffer, "," );
            }
            EXPRstring( buffer + strlen( buffer ), arg );
            LISTod

            strcat( buffer, ")" );
            break;
        default:
            sprintf( buffer, "EXPRstring: unknown expression, type %d", TYPEis( e->type ) );
            fprintf( stderr, "%s", buffer );
    }
}

void
EXPRop_string( char * buffer, struct Op_Subexpression * oe ) {
    EXPRstring( buffer, oe->op1 );
    switch( oe->op_code ) {
        case OP_DOT:
            strcat( buffer, "." );
            break;
        case OP_GROUP:
            strcat( buffer, "\\" );
            break;
        default:
            strcat( buffer, "(* unknown op-expression *)" );
    }
    EXPRstring( buffer + strlen( buffer ), oe->op2 );
}

/* returns length of printable representation of expression w.o. printing it */
int
EXPRlength( Expression e ) {
    char buffer[10000];

    *buffer = '\0';
    EXPRstring( buffer, e );
    return( strlen( buffer ) );
}


/* Interfacing Definitions */

#define BIGBUFSIZ   100000
static int old_curpos;
static int old_lineno;
static bool string_func_in_use = false;
static bool file_func_in_use = false;

/* return false if successful */
static bool
prep_buffer( char * buf, int len ) {
    /* this should never happen */
    if( string_func_in_use ) {
        fprintf( stderr, "cannot generate EXPRESS string representations recursively!\n" );
        return true;
    }
    string_func_in_use = true;

    exppp_buf = exppp_bufp = buf;
    exppp_buflen = exppp_maxbuflen = len;

    *exppp_bufp = '\0';
    old_curpos = curpos;
    curpos = 1;
    old_lineno = 1;

    first_line = true;

    return false;
}

/* return length of string */
static int
finish_buffer() {
    exppp_buf = 0;
    curpos = old_curpos;
    error_sym.line = old_lineno;
    string_func_in_use = false;
    return 1 + exppp_maxbuflen - exppp_buflen;
}

/* return false if successful */
static bool
prep_string() {
    /* this should never happen */
    if( string_func_in_use ) {
        fprintf( stderr, "cannot generate EXPRESS string representations recursively!\n" );
        return true;
    }
    string_func_in_use = true;

    exppp_buf = exppp_bufp = ( char * )malloc( BIGBUFSIZ );
    if( !exppp_buf ) {
        fprintf( stderr, "failed to allocate exppp buffer\n" );
        return false;
    }
    exppp_buflen = exppp_maxbuflen = BIGBUFSIZ;

    *exppp_bufp = '\0';
    old_curpos = curpos;
    old_lineno = error_sym.line;
    curpos = 1;

    first_line = true;

    return false;
}

static char *
finish_string() {
    char * b = ( char * )realloc( exppp_buf, 1 + exppp_maxbuflen - exppp_buflen );

    if( b == 0 ) {
        fprintf( stderr, "failed to reallocate exppp buffer\n" );
        return 0;
    }
    exppp_buf = 0;
    curpos = old_curpos;
    error_sym.line = old_lineno;

    string_func_in_use = false;
    return b;
}

static FILE * oldfp;

static void
prep_file() {
    /* this can only happen if user calls output func while suspended */
    /* inside another output func both called from debugger */
    if( file_func_in_use ) {
        fprintf( stderr, "cannot print EXPRESS representations recursively!\n" );
    }
    file_func_in_use = true;

    /* temporarily change file to stdout and print */
    /* This avoids messing up any printing in progress */
    oldfp = exppp_fp ? exppp_fp : stdout;
    exppp_fp = stdout;
    curpos = 1;
}

static void
finish_file() {
    exppp_fp = oldfp;       /* reset back to original file */
    file_func_in_use = false;
}

static char * placeholder = "placeholder";

char *
SUBTYPEto_string( Expression e ) {
    if( prep_string() ) {
        return placeholder;
    }
    EXPR_out( e, 0 );
    return ( finish_string() );
}

char *
ENTITYto_string( Entity e ) {
    if( prep_string() ) {
        return placeholder;
    }
    ENTITY_out( e, 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
ENTITYto_buffer( Entity e, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    ENTITY_out( e, 0 );
    return( finish_buffer() );
}

void
ENTITYout( Entity e ) {
    prep_file();
    ENTITY_out( e, 0 );
    finish_file();
}

char *
EXPRto_string( Expression e ) {
    if( prep_string() ) {
        return placeholder;
    }
    EXPR_out( e, 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
EXPRto_buffer( Expression e, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    EXPR_out( e, 0 );
    return( finish_buffer() );
}

void
EXPRout( Expression e ) {
    prep_file();
    EXPR_out( e, 0 );
    finish_file();
}

char *
FUNCto_string( Function f ) {
    if( prep_string() ) {
        return placeholder;
    }
    FUNC_out( f, 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
FUNCto_buffer( Function e, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    FUNC_out( e, 0 );
    return( finish_buffer() );
}

void
FUNCout( Function f ) {
    prep_file();
    FUNC_out( f, 0 );
    finish_file();
}

char *
PROCto_string( Procedure p ) {
    if( prep_string() ) {
        return placeholder;
    }
    PROC_out( p, 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
PROCto_buffer( Procedure e, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    PROC_out( e, 0 );
    return( finish_buffer() );
}

void
PROCout( Procedure p ) {
    prep_file();
    PROC_out( p, 0 );
    finish_file();
}

char *
RULEto_string( Rule r ) {
    if( prep_string() ) {
        return placeholder;
    }
    RULE_out( r, 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
RULEto_buffer( Rule e, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    RULE_out( e, 0 );
    return( finish_buffer() );
}

void
RULEout( Rule r ) {
    prep_file();
    RULE_out( r, 0 );
    finish_file();
}

char *
SCHEMAref_to_string( Schema s ) {
    if( prep_string() ) {
        return placeholder;
    }
    REFout( s->u.schema->usedict, s->u.schema->use_schemas, "USE", 0 );
    REFout( s->u.schema->refdict, s->u.schema->ref_schemas, "REFERENCE", 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
SCHEMAref_to_buffer( Schema s, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    REFout( s->u.schema->usedict, s->u.schema->use_schemas, "USE", 0 );
    REFout( s->u.schema->refdict, s->u.schema->ref_schemas, "REFERENCE", 0 );
    return( finish_buffer() );
}

void
SCHEMAref_out( Schema s ) {
    prep_file();
    REFout( s->u.schema->usedict, s->u.schema->use_schemas, "USE", 0 );
    REFout( s->u.schema->refdict, s->u.schema->ref_schemas, "REFERENCE", 0 );
    finish_file();
}

char *
STMTto_string( Statement s ) {
    if( prep_string() ) {
        return placeholder;
    }
    STMT_out( s, 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
STMTto_buffer( Statement s, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    STMT_out( s, 0 );
    return( finish_buffer() );
}

void
STMTout( Statement s ) {
    prep_file();
    STMT_out( s, 0 );
    finish_file();
}

char *
TYPEto_string( Type t ) {
    if( prep_string() ) {
        return placeholder;
    }
    TYPE_out( t, 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
TYPEto_buffer( Type t, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    TYPE_out( t, 0 );
    return( finish_buffer() );
}

void
TYPEout( Type t ) {
    prep_file();
    TYPE_out( t, 0 );
    finish_file();
}

char *
TYPEhead_to_string( Type t ) {
    if( prep_string() ) {
        return placeholder;
    }
    TYPE_head_out( t, 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
TYPEhead_to_buffer( Type t, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    TYPE_out( t, 0 );
    return( finish_buffer() );
}

void
TYPEhead_out( Type t ) {
    prep_file();
    TYPE_head_out( t, 0 );
    finish_file();
}

char *
TYPEbody_to_string( Type t ) {
    if( prep_string() ) {
        return placeholder;
    }
    TYPE_body_out( t, 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
TYPEbody_to_buffer( Type t, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    TYPE_body_out( t, 0 );
    return( finish_buffer() );
}

void
TYPEbody_out( Type t ) {
    prep_file();
    TYPE_body_out( t, 0 );
    finish_file();
}

char *
WHEREto_string( Linked_List w ) {
    if( prep_string() ) {
        return placeholder;
    }
    WHERE_out( w, 0 );
    return ( finish_string() );
}

/* return length of buffer used */
int
WHEREto_buffer( Linked_List w, char * buffer, int length ) {
    if( prep_buffer( buffer, length ) ) {
        return -1;
    }
    WHERE_out( w, 0 );
    return( finish_buffer() );
}

void
WHEREout( Linked_List w ) {
    prep_file();
    WHERE_out( w, 0 );
    finish_file();
}
