/* IParser -- An interpretting parser   Copyright (C) 2001 Frans Faase

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

GNU General Public License:
   http://www.iwriteiam.nl/GNU.txt

Description:
   This program implements a parser with the following
   unique features:
   - It is an interpretting parser, meaning that on the
     input it expects at least two arguments, namely:
     - a filename of a file with a grammer, and
     - a filename of a file to be parsed according to the grammar.
   - Implements a "greedy" back-tracking parser, thus
     supporting a wide range of grammers. Can deal with many
     ambigious grammers.
   - Uses a smart caching algorithm for high performance.
   - Grammar supports keywords like OPT, LIST, SEQ and CHAIN.
   - Grammer supports common C-like non-terminals.
   - Scanner is controlled by parser, instead of being
     implemented as a first pass. This allows context-sensitve
     scanning.
   - Has output option to implement a parser with "hard-coded"
     grammar. So, you don't need to supply the first argument
     anymore.
   - Builds a abstact syntax tree from the parsed input based
     on a simple name giving strategy.
   - extremely small code base. (This file contains it all.)

   This parser was developed as part of the Meta-Meta
   environment. See http://www.iwriteiam.nl/MM.html

*/

#define VERSION "1.1a of October 9, 2001."

#include <stdio.h>
#include <malloc.h>
#include <string.h>
#include <unistd.h>
#include <ctype.h>
#include <math.h>

#ifndef NULL
#define NULL 0
#endif

typedef int bool;
#define TRUE 1
#define FALSE 0

typedef signed long longint;
typedef unsigned long longword;
typedef unsigned short word;
typedef unsigned char byte;

#define MALLOC(t) (t*)malloc(sizeof(t))
#define MALLOC_N(N,T)  (T *)malloc((N)*sizeof(T))
#define STR_MALLOC(N) (char *)malloc(N+1)
#define REALLOC_N(A,N,T)  (T *)realloc(A, (N)*sizeof(T))
#define STRCPY(D,S) D = (char *)malloc(strlen(S)+1); strcpy(D,S)


/*** Strings ***/


typedef struct hexa_hash_tree_T
{
    byte state;
    union
    {   char *string;
        struct hexa_hash_tree_T **children;
    } data;
} hexa_hash_tree_t;

byte *keyword_state = NULL;

char *string(char *s)
{
    static hexa_hash_tree_t *hash_tree = NULL;
    hexa_hash_tree_t **r_node = &hash_tree;
    char *vs = s;
    int depth;
    int mode = 0;

    for (depth = 0; ; depth++)
    {   hexa_hash_tree_t *node = *r_node;

        if (node == NULL)
        {   node = MALLOC(hexa_hash_tree_t);
            node->state = 0;
            STRCPY(node->data.string, s);
            *r_node = node;
            keyword_state = &node->state;
            return node->data.string;
        }

        if (node->state != 255)
        {   char *cs = node->data.string;
            hexa_hash_tree_t **children;
            word i, v = 0;

            if (*cs == *s && strcmp(cs+1, s+1) == 0)
            {   keyword_state = &node->state;
                return node->data.string;
            }

            children = MALLOC_N(16, hexa_hash_tree_t*);
            for (i = 0; i < 16; i++)
                children[i] = NULL;

            i = strlen(cs);
            if (depth <= i)
                v = ((byte)cs[depth]) & 15;
            else if (depth <= i*2)
                v = ((byte)cs[depth-i-1]) >> 4;

            children[v] = node;

            node = MALLOC(hexa_hash_tree_t);
            node->state = 255;
            node->data.children = children;
            *r_node = node;
        }
        {   word v;
            if (*vs == '\0')
            {   v = 0;
                if (mode == 0)
                {   mode = 1;
                    vs = s;
                }
            }
            else if (mode == 0)
                v = ((word)*vs++) & 15;
            else
                v = ((word)*vs++) >> 4;

            r_node = &node->data.children[v];
        }
    }
}



/*** Trees ***/

typedef struct tree_T
{   char *type;
    union
    {   struct list_T *parts;
        char   *str_value;
        int    int_value;
        double double_value;
        char   char_value;
    } c;
    word line, column;
    longword refcount;
} tree_t, *tree_p;

typedef struct list_T
{   struct list_T *next;
    tree_p first;
} list_t, *list_p;

char *tt_str_value,
     *tt_int_value,
     *tt_list;

/* Special strings, one for each terminal */
char *tt_ident = "identifier";
char *tt_str_value = "string value";
char *tt_int_value = "integer value";
char *tt_double_value = "double value";
char *tt_char_value = "char value";
char *tt_list = "list";

/* Special strings for identifiers and context */
char *tt_identdef = "<identdef>";
char *tt_identdefadd = "<identdefadd>";
char *tt_identuse = "<identuse>";
char *tt_identfield = "<identfield>";

tree_p old_trees = NULL;
list_p old_lists = NULL;
long alloced_trees = 0;

tree_p malloc_tree( void )
{   tree_p new;

    if (old_trees)
    {   new = old_trees;
        old_trees = (tree_p)old_trees->type;
    }
    else
        new = MALLOC(tree_t);

    new->line = 0;
    new->column = 0;
    new->refcount = 1;
    alloced_trees++;

    return new;
} 

void free_list( list_p list );

bool type_can_have_parts( char *type )
{
    return    type != tt_ident 
           && type != tt_str_value
           && type != tt_int_value
           && type != tt_double_value
           && type != tt_char_value
          ;
}


void tree_release( tree_p *r_t )
{   tree_p t = *r_t;

    if (t == NULL)
        return;

    alloced_trees--;
    t->refcount--;

    if (t->refcount == 0)
    {
        if (type_can_have_parts(t->type))
        {   list_p list = t->c.parts;

            while (list != NULL)
            {   list_p next = list->next;
                free_list(list);
                list = next;
            }
        }

        t->type = (char*)old_trees;
        old_trees = t;
    }
    *r_t = NULL;
}

void free_list( list_p list )
{ tree_release(&list->first);
  list->next = old_lists;
  old_lists = list;
}

void tree_assign(tree_p *d, tree_p s)
{
  tree_p old_d = *d;

  *d = s;
  if (s != NULL)
  {
    s->refcount++;
    alloced_trees++;
  }
  if (old_d != NULL)
      tree_release(&old_d);
}

void tree_move(tree_p *d, tree_p *s)
{
  tree_p old_d = *d;

  *d = *s;
  *s = NULL;
  if (old_d != NULL)
      tree_release(&old_d);
}

static list_p malloc_list( void )
{   list_p new;
    if (old_lists)
    {   new = old_lists;
        old_lists = old_lists->next;
    }
    else
        new = MALLOC(list_t);
    new->next = NULL;
    new->first = NULL;
    return new;
} 

tree_p make_ident( char *str )
{
    tree_p tree = malloc_tree();
    tree->type = tt_ident;
    tree->c.str_value = str; 
    return tree;
}

tree_p make_str_atom( char *str )
{
    tree_p tree = malloc_tree();
    tree->type = tt_str_value;
    tree->c.str_value = str; 
    return tree;
}

tree_p make_double_atom( double value )
{
    tree_p tree = malloc_tree();
    tree->type = tt_double_value;
    tree->c.double_value = value; 
    return tree;
}

tree_p make_char_atom( char value )
{
    tree_p tree = malloc_tree();
    tree->type = tt_char_value;
    tree->c.char_value = value; 
    return tree;
}

tree_p make_int_atom( int value )
{
    tree_p tree = malloc_tree();
    tree->type = tt_int_value;
    tree->c.int_value = value; 
    return tree;
}

tree_p make_list( void )
{
    tree_p tree = malloc_tree();
    tree->type = tt_list;
    tree->c.parts = NULL;
    return tree;
}
    
tree_p make_tree( char *name )
{
    tree_p tree = malloc_tree();
    tree->type = name;
    tree->c.parts = NULL;
    return tree;
}
   
void insert_element( tree_p tree, tree_p element )
{
    list_p r_list;

    r_list = malloc_list();
    tree_assign(&r_list->first, element);
    r_list->next = tree->c.parts;
    tree->c.parts = r_list;
} 

void add_element( tree_p tree, tree_p element )
{
    list_p *r_list = &tree->c.parts;

    while (*r_list != NULL)
        r_list = &(*r_list)->next;

    *r_list = malloc_list();
    tree_assign(&(*r_list)->first, element);
}

void drop_last_element( tree_p tree )
{
    list_p *r_list = &tree->c.parts;

    if (*r_list == NULL)
        return;

    while ((*r_list)->next != NULL)
        r_list = &(*r_list)->next;

    free_list(*r_list);
    *r_list = NULL;
} 

inline list_p elements( tree_p tree )
{
    return tree->c.parts;
}

inline bool is_a_ident( tree_p tree )
{
    return tree && tree->type == tt_ident;
}

inline bool is_ident( tree_p tree, char *ident )
{
    return    tree
           && tree->type == tt_ident
           && tree->c.str_value == ident;
}

inline bool equal_ident( tree_p tree, char *ident )
{
    return tree->c.str_value == ident;
}

inline bool is_a_str( tree_p tree )
{
    return tree && tree->type == tt_str_value;
}

inline bool is_str( tree_p tree, char *str )
{
    return    tree
           && tree->type == tt_str_value
           && tree->c.str_value == str;
}

inline bool is_a_int( tree_p tree )
{
    return tree && tree->type == tt_int_value;
}

inline bool is_a_double( tree_p tree )
{
    return tree && tree->type == tt_double_value;
}

inline bool is_a_char( tree_p tree )
{
    return tree && tree->type == tt_char_value;
}

inline bool is_a_list( tree_p tree )
{
    return tree && tree->type == tt_list;
}

inline bool is_tree( tree_p tree, char *name )
{
    return tree && tree->type == name;
}

inline bool equal_tree( tree_p tree, char *name )
{
    return tree->type == name;
}

tree_p part( tree_p tree, int i )
{
    list_p parts = tree->c.parts;

    for (i--; parts && i > 0; parts = parts->next, i--);

    return parts ? parts->first : NULL;
}


int print_tree_depth = 0;
void print_list(FILE *f, list_p list, bool compact);

void print_tree( FILE *f, tree_p tree, bool compact )
{
    if (tree == NULL)
        fprintf(f, "[NULL]");
    else 
    {
        if (tree->line != 0)
            fprintf(f, "{%d:%d}", tree->line, tree->column);
         if (is_a_ident(tree))
            fprintf(f, "%s", tree->c.str_value);
        else if (is_a_str(tree))
            fprintf(f, "\"%s\"", tree->c.str_value);
        else if (is_a_int(tree))
            fprintf(f, "%d", tree->c.int_value);
        else if (is_a_double(tree))
            fprintf(f, "%f", tree->c.double_value);
        else if (is_a_char(tree))
            fprintf(f, "'%c'", tree->c.char_value);
        else
        {    
            fprintf(f, "%s(", tree->type);
       
            print_tree_depth += strlen(tree->type) + 1;
            print_list(f, tree->c.parts, compact);
            print_tree_depth -= strlen(tree->type) + 1;
            fprintf(f, ")");
        }
    }
    if (print_tree_depth == 0 && !compact)
        fprintf(f, "\n");
};

void print_list(FILE *f, list_p list, bool compact)
{   list_p l;
    bool first = TRUE;

    for (l = list; l; l = l->next)
    {   if (!first)
        {   if (compact)
                fprintf(f, ",");
            else 
                fprintf(f, ",\n%*s", print_tree_depth, "");
        }
        first = FALSE;
        /* fprintf(f, "[%lx]", (longword)l); */
        print_tree(f, l->first, compact);
    }
}

static void print_tree_rec( FILE *f, tree_p tree );
 
void print_tree_to_c( FILE *f, tree_p tree, char *name )
{   
    fprintf(f, "void init_%s( tree_p *root )\n", name);
    fprintf(f, "{   /* Generated by IParse version %s */\n", VERSION);
    fprintf(f, "    tree_p tt[100];\n");
    fprintf(f, "    int v = 0;\n");
    fprintf(f, "\n");
    fprintf(f, "#define ID(s) tt[v]=make_ident(string(s));\n");
    fprintf(f, "#define LITERAL(s) tt[v]=make_str_atom(string(s));"
                                   " *keyword_state |= 1;\n");
    fprintf(f, "#define INT(i) tt[v]=make_int_atom(i);\n");
    fprintf(f, "#define DOUBLE(i) tt[v]=make_double_atom(i);\n");
    fprintf(f, "#define CHAR(i) tt[v]=make_char_atom(i);\n");
    fprintf(f, "#define TREE(n) tt[v]=make_tree(string(n)); v++;\n");
    fprintf(f, "#define LIST tt[v]=make_list(); v++;\n");
    fprintf(f, "#define NONE tt[v]=NULL;\n");
    fprintf(f, "#define SEP add_element(tt[v-1],tt[v]); tree_release(&tt[v]);\n");
    fprintf(f, "#define CLOSE add_element(tt[v-1],tt[v]); tree_release(&tt[v]); v--;\n");
    fprintf(f, "#define EMPTY_CLOSE v--;\n");
    fprintf(f, "\n    ");

    print_tree_rec( f, tree );
    fprintf(f, "\n    *root = tt[0];\n}\n\n");
}

static void print_tree_rec( FILE *f, tree_p tree )
{
    if (tree == NULL)
         fprintf(f, "NONE ");
    else if (is_a_ident(tree))
    {    fprintf(f, "ID(\"%s\") ", tree->c.str_value);
    }
    else if (is_a_str(tree))
    {    fprintf(f, "LITERAL(\"%s\") ", tree->c.str_value);
    }
    else if (is_a_int(tree))
    {    fprintf(f, "INT(%d) ", tree->c.int_value);
    }
    else if (is_a_double(tree))
    {    fprintf(f, "DOUBLE(%f) ", tree->c.double_value);
    }
    else if (is_a_char(tree))
    {    fprintf(f, "CHAR('%c') ", tree->c.char_value);
    }
    else
    {   list_p l;

        if (is_a_list(tree))
            fprintf(f, "LIST ");
        else
            fprintf(f, "TREE(\"%s\") ", tree->type);
        if (tree->c.parts)
        {   print_tree_depth++;

            for (l = tree->c.parts; l; l = l->next)
            {   print_tree_rec(f, l->first);
                if (l->next)
                  fprintf(f, "SEP\n%*.*s    ",
                          print_tree_depth, print_tree_depth, "");
            }
            print_tree_depth--;
            fprintf(f, "CLOSE ");
        }
        else
            fprintf(f, "EMPTY_CLOSE ");
    }
};


/*** File IO ***/

#define TAB_POS 4

char *info = NULL;
longword file_pos;
longword file_len;
#define _eof   (file_pos >= file_len)
word cur_line = 1;
word cur_column = 1;


char *buffer = NULL;

void _assign(FILE *the_file)
{
    int fh = fileno(the_file);
    file_len = lseek(fh, 0L, SEEK_END);
    lseek(fh, 0L, SEEK_SET);
    buffer = (char*)malloc(file_len+2);
    file_len = read(fh, buffer, file_len);
    buffer[file_len] = '\0';
    file_pos = 0;
    cur_line = 1;
    cur_column = 1;
    info = buffer;
}

void _unassign()
{
    if (buffer)
        free(buffer);
    buffer = NULL;
}


inline void _set_file_pos(longword new_file_pos)
{
    file_pos = new_file_pos;
    info = buffer + file_pos;
}

inline void _next()
{
    if (file_pos < file_len)
    {
      switch(*info)
      {   case '\t':
              cur_column = ((cur_column + TAB_POS) % TAB_POS) * TAB_POS;
              break;
          case '\n':
              cur_line++;
              cur_column = 1;
              break;
          default:
              cur_column++;
              break;
      }
      file_pos++;
      info++;
    }
}

inline void _advance(word steps)
{
    file_pos += steps;
    if (file_pos > file_len)
        file_pos = file_len;
    info = buffer + file_pos;
    cur_column += steps;
}

void _print_state()
{
    printf("[0,%ld,%ld] = `%c'\n", file_pos, file_len, *info);
}

/*** Scanner ***/

int debug_scan = 0;
char *current_nt;

word start_line;
word start_column;

typedef struct
{   longword file_pos;
    word cur_line;
    word cur_column;
} scan_pos_t;


#define _DEBUG(S)
#define _DEBUG_P1(S,A)
#define _DEBUG_P2(S,A,B) 
#define _DEBUG_P3(S,A,B,C) 
#define _DEBUG_P4(S,A,B,C,D) 
#define DEBUG(S) if (debug_scan) printf(S)
/*#define DEBUG_P1(S,A) if (debug_scan) printf(S,A)*/
#define DEBUG_P2(S,A,B) if (debug_scan) printf(S,A,B)
#define DEBUG_P3(S,A,B,C) if (debug_scan) printf(S,A,B,C)
#define DEBUG_P4(S,A,B,C,D) if (debug_scan) printf(S,A,B,C,D)
#define DEBUG_P6(S,A,B,C,D,E,F) if (debug_scan) printf(S,A,B,C,D,E,F)
#define DEBUG_F(S) if (debug_scan > 1) printf(S)
#define DEBUG_F_P1(S,A) if (debug_scan > 1) printf(S,A)
#define DEBUG_F_P2(S,A,B) if (debug_scan > 1) printf(S,A,B)
#define DEBUG_F_P3(S,A,B,C) if (debug_scan > 1) printf(S,A,B,C)
#define DEBUG_F_P4(S,A,B,C,D) if (debug_scan > 1) printf(S,A,B,C,D)
#define DEBUG_F_P6(S,A,B,C,D,E,F) if (debug_scan > 1) printf(S,A,B,C,D,E,F)

void skip_space(void);
static void expected_string(char *s, char *is_keyword);
    
static char *start_info()
{   static char buff[13];
    int i;
    char *s;

    for (i = 0, s = info; i < 10 && *s; s++)
        if (*s == '\n')
        {   buff[i++] = '\\';
            buff[i++] = 'n';
        }
        else if (*s == '\t')
        {   buff[i++] = '\\';
            buff[i++] = 't';
        }
        else
            buff[i++] = *s;

    buff[i] = '\0';
    return buff;
}


longword f_file_pos = 0;
word f_line = 1;
word f_column = 1;
int nr_exp_syms = 0;


longword last_space_pos = (longword)-1;
scan_pos_t last_space_end_pos;
longword last_string_pos = (longword)-1;
char *last_string;
scan_pos_t last_string_end_pos;
longword last_ident_pos = (longword)-1;
char *last_ident;
bool last_ident_is_keyword;
scan_pos_t last_ident_end_pos;


void init_scan(FILE *the_file)
{
    _assign(the_file);

    f_file_pos = 0;
    f_line = 1;
    f_column = 1;
    nr_exp_syms = 0;

    last_space_pos = (longword)-1;
    last_string_pos = (longword)-1;
    last_ident_pos = (longword)-1;

    skip_space();
}

void save_pos(scan_pos_t *sp)
{
    sp->file_pos = file_pos;
    sp->cur_line = cur_line;
    sp->cur_column = cur_column;
}

void restore_pos(scan_pos_t *sp)
{
    if (sp->file_pos == file_pos)
        return;
    _set_file_pos(sp->file_pos);
    cur_line = sp->cur_line;
    cur_column = sp->cur_column;
    /* _print_state(); */
}

void skip_space()
{
    if (file_pos == last_space_pos)
    {   restore_pos(&last_space_end_pos);
        return;
    }
    last_space_pos = file_pos;
    for(;;)
    {   _DEBUG_P1("now: `%c'\n", *info);
        if (*info == ' ' || *info == '\t' || info[0] == '\n')
        {
            _next();
        }
        else if (info[0] == '%')
        {
            while (!_eof && info[0] != '\n')
                _next();
        }
        else
            break;
    }
    save_pos(&last_space_end_pos);
    /* _print_state(); */
}

bool accept_eof()
{
    if (_eof)
    {
        DEBUG_P3("%d.%d: accept_eof() for: `%s'\n",
             cur_line, start_column, start_info());
        return TRUE;
    }
    else
    {
        DEBUG_F_P3("%d.%d: accept_eof() failed for: `%s'\n",
             cur_line, cur_column, start_info());
        expected_string("<eof>", NULL);
        return FALSE;
    }
}

bool accept_i_string(char **string)
{
    scan_pos_t sp;
    int i;

    if (_eof || info[0] != '(')
    {   expected_string("<string>", NULL);
        DEBUG_F_P3("%d.%d: accept_string() failed for: `%s'\n", 
                 cur_line, cur_column, start_info());
        return FALSE;
    }

    save_pos(&sp);

    i = 0;
    _next();
    for (;;)
    {
        if (_eof || *info == '\0' || *info == '\n')
        {   
            printf("Error: %d.%d incorrectly terminated string\n",
                   sp.cur_line, sp.cur_column);
            break;
        }
        else if (*info == '\\')
        {
            _next();
            if (0 <= *info && *info <= 7)
            {   char d1 = *info;
                _next();
                if (0 <= *info && *info <= 7)
                {   _next();
                    if ((d1 == '0' || d1 == '1') && 0 <= *info && *info <= 7)
                        _next();
                }
            }
            else
                _next();
            i++;
        }
        else if (*info == ')')
        {   break;
        }
        else
        {   i++;
            _next();
        }
    }
    *string = STR_MALLOC(i);
    restore_pos(&sp);
    
    i = 0;
    _next();
    for (;;)
    {
        if (_eof || *info == '\0' || *info == '\n')
        {   
            break;
        }
        else if (*info == '(')
        {
            _next();
            if (!_eof && 0 <= *info && *info <= 7)
            {   char d1 = *info,
                     v = *info - '0';
                _next();
                if (!_eof && 0 <= *info && *info <= 7)
                {   v = v*8 + *info - '0';
                    _next();
                    if (   !_eof && (d1 == '0' || d1 == '1') 
                        && 0 <= *info && *info <= 7)
                    {   v = v*8 + *info - '0';
                        _next();
                    }
                }
                (*string)[i++] = v;
            }
            else if (!_eof) 
            {   if (*info == 'n')
                    (*string)[i++] = '\n';
                else if (*info == 't')
                    (*string)[i++] = '\t';
                else 
                    (*string)[i++] = *info;
                _next();
            }
        }
        else if (*info == ')')
        {   _next();
            break;
        }
        else
        {   (*string)[i++] = *info;
            _next();
        }
    }
    (*string)[i] = '\0';

    skip_space();

    DEBUG_P4("%d.%d: accept_string(\"%s\") %d\n",
             sp.cur_line, sp.cur_column, *string, cur_column);
    return TRUE;
}

bool accept_string(char **string)
{   bool result;
    longword start_pos;

    DEBUG_P2("%d.%d: try accept_string\n", cur_line, cur_column);

    if (file_pos == last_string_pos)
    {
        *string = last_string;
        restore_pos(&last_string_end_pos);
        return TRUE;
    }

    start_pos = file_pos;
    result = accept_i_string(string);
    if (result)
    {
        last_string_pos = start_pos;
        last_string = *string;
        save_pos(&last_string_end_pos);
        return TRUE;
    }
    return FALSE;
}

bool accept_ident(char **ident)
{
    int i;
    char s;

    DEBUG_P2("%d.%d: try accept_ident\n", cur_line, cur_column);

    if (file_pos == last_ident_pos)
    { 
        if (last_ident_is_keyword)
        {   expected_string("<ident>", NULL);
            DEBUG_F_P3("%d.%d: accept_ident() failed for `%s'\n",
                       cur_line, cur_column, start_info());
            return FALSE;
        }
        start_column = cur_column;
        *ident = last_ident;
        restore_pos(&last_ident_end_pos);
    }
    else
    {   longword pos = file_pos; 

        start_line = cur_line;
        start_column = cur_column;

        if (_eof || (!isalpha(*info) && *info != '_'))
        {   expected_string("<ident>", NULL);
            DEBUG_F_P3("%d.%d: accept_ident() failed for `%s'\n",
                     cur_line, start_column, start_info());
            return FALSE;
        }
  
        i = 1;
        while (isalpha(info[i]) || isdigit(info[i]) || info[i] == '_' || info[i] == '-') 
            i++;
        s = info[i];
        info[i] = '\0';
        *ident = string(info);
        info[i] = s;

        _advance(i);

        last_ident_pos = pos;
        last_ident = *ident;
        last_ident_is_keyword = FALSE; 

        skip_space();

        save_pos(&last_ident_end_pos);
    }
    
    DEBUG_P3("%d.%d: accept_ident(%s)\n", start_line, cur_column, *ident);
    return TRUE; 
}

bool accept_qident(char **ident)
{
    DEBUG_P2("%d.%d: try accept_qident\n", start_line, cur_column);

    bool result;
    if (*info != '/')
        return FALSE;
        
    _next();
    result = accept_ident(ident);

    DEBUG_P3("%d.%d: done accept_ident %d\n", start_line, cur_column, result);
    
    return result;
}

bool accept_int(longint *v)
{
    int i = 0;

    DEBUG_P2("%d.%d: try accept_int\n", start_line, cur_column);

    if (_eof || (   !isdigit(*info)
                 && (   (*info != '+' && *info != '-') 
                     || !isdigit(info[1]))))
    {   expected_string("<int>", NULL);
        DEBUG_F_P3("%d.%d: accept_int() failed for `%s'\n", 
                 cur_line, cur_column, start_info());
        return FALSE;
    }
    start_column = cur_column;

    if (info[i] == '-' || info[i] == '+')
        i++;
    if (info[i] == '0' && info[i+1] == 'x')
    {   i += 2;
        while (   isdigit(info[i]) 
               || ('a' <= info[i] && info[i] <= 'f') 
               || ('A' <= info[i] && info[i] <= 'F'))
            i++;
    }
    else
    {   while (isdigit(info[i]))
            i++;
        if (info[i] == '.')
        {   expected_string("<int>", NULL);
            DEBUG_F_P3("%d.%d: accept_int() found double `%s'\n", 
                     cur_line, start_column, start_info());
            return FALSE;
        }
        if (info[i] == 'L')
            i++;
    }
    
    sscanf(info, "%ld", v);
    _advance(i);

    skip_space();

    DEBUG_P3("%d.%d: accept_int(%ld)\n", cur_line, start_column, *v);
    return TRUE;
}

bool accept_double(double *v)
{
    int i = 0;

    DEBUG_P2("%d.%d: try accept_double\n", start_line, cur_column);

    if (_eof || (   !isdigit(*info) && *info != '.'
                 && (   (*info != '+' && *info != '-') 
                     || (!isdigit(info[1]) && info[1] != '.'))))
    {   expected_string("<double>", NULL);
        DEBUG_F_P3("%d.%d: accept_double() failed for `%s'\n", 
                 cur_line, cur_column, start_info());
        return FALSE;
    }
    start_column = cur_column;

    if (info[i] == '-' || info[i] == '+')
        i++;
    while (isdigit(info[i]))
        i++;
    if (info[i] != '.')
    {   expected_string("<double>", NULL);
        DEBUG_P3("%d.%d: accept_double() found int `%s'\n", 
                 cur_line, start_column, start_info());
        return FALSE;
    }
    i++;
    while (isdigit(info[i]))
        i++;

    sscanf(info, "%lf", v);
    _advance(i);

    skip_space();

    DEBUG_P3("%d.%d: accept_double(%f)\n", cur_line, start_column, *v);
    return TRUE;
}

bool accept_symbol(char *sym)
{   
    char *v, *s;

    DEBUG_P3("%d.%d: try accept_symbol %s\n", start_line, cur_column, sym);
    
    if (file_pos == last_ident_pos)
    {   if (sym == last_ident)
        {
            DEBUG_F_P3("%d.%d: accept_sym(%s)", 
                       cur_line, cur_column, sym);
            restore_pos(&last_ident_end_pos);
            return TRUE;
        }
        else if (!last_ident_is_keyword)
        {   expected_string(sym, NULL);
            DEBUG_F_P4("%d.%d: accept_symbol(%s) failed for `%s'\n",
                       cur_line, cur_column, sym, start_info());
            return FALSE;
        }
    }

    for (v = info, s = sym; *v == *s; v++, s++);

    if (*s != '\0')
    {   expected_string(sym, NULL);
        DEBUG_F_P4("%d.%d: accept_symbol(%s) failed for `%s'\n",
                 cur_line, cur_column, sym, start_info());
        return FALSE;
    }

    DEBUG_P3("%d.%d: accept_symbol(%s)\n", cur_line, cur_column, sym);

    last_ident_pos = file_pos;

    _advance(v - info);

    skip_space();

    last_ident = sym;
    last_ident_is_keyword = TRUE;
    save_pos(&last_ident_end_pos);

    return TRUE;
}


/*** Parser ***/


typedef struct val_T
{   struct val_T *prev;
    tree_p last;
} val_t, *val_p;

typedef struct or_rule_T
{   struct or_rule_T *next;
    struct rule_T *rule;
    char *tree_name;
} or_rule_t, *or_rule_p;

typedef struct non_terminal_t
{   struct non_terminal_t *next;
    char *name;
    or_rule_p first;
    or_rule_p recursive;
} non_terminal_t, *non_terminal_p;

typedef struct rule_T
{   struct rule_T *next;
    bool optional;
    bool sequential;
    char *chain_symbol;
    int kind;
    union 
    {   non_terminal_p non_terminal;
        or_rule_p or_rule;
        char *str_value;
        char *ident_class;
    } info;
    long last_fail_pos;
} rule_t, *rule_p;

#define RK_NT              0
#define RK_LIT             1
#define RK_OR_RULE         2
#define RK_T_EOF          10
#define RK_T_STRING       11
#define RK_T_INT          13
#define RK_T_DOUBLE       14
#define RK_T_IDENT        16
#define RK_T_QIDENT       17

non_terminal_p find_nt(char *name);
rule_p make_rule(list_p rules);
or_rule_p make_or_rule(list_p or);
void make_all_nt(tree_p root);

bool parse_nt(non_terminal_p non_term, tree_p *rtree);
bool parse_or(or_rule_p or, tree_p *rtree);
bool parse_rule(rule_p rule, val_p prev_parts, char *tree_name, 
                tree_p *rtree);
bool parse_seq(rule_p rule, char *chain_sym,
               tree_p seq, val_p prev_parts, char *tree_name,
               tree_p *rtree) ;
void print_or(FILE *f, or_rule_p or);
void print_rule(FILE *f, rule_p rule);

static 
char *str_root,
     *str_nt_def,
     *str_ident,
     *str_qident,
     *str_rule,
     *str_opt,
     *str_seq,
     *str_list,
     *str_chain,
     *str_prim_elem,
     *str_string,
     *str_int,
     *str_double,
     *str_eof;

non_terminal_p all_nt = NULL;

non_terminal_p find_nt(char *name)
{
   non_terminal_p *p_nt = &all_nt;

   while (*p_nt != NULL && (*p_nt)->name != name)
        p_nt = &((*p_nt)->next);

   if (*p_nt == NULL)
   {   *p_nt = MALLOC(non_terminal_t);
       (*p_nt)->name = name;
       (*p_nt)->first = NULL;
       (*p_nt)->recursive = NULL;
       (*p_nt)->next = NULL;
   }
   return *p_nt;
}

rule_p make_rule(list_p rule)
{   rule_p result;
    tree_p elem; /* only used as pointer */
 
    if (rule == NULL)
        return NULL;

    result = MALLOC(rule_t);
    result->optional = FALSE;
    result->sequential = FALSE;
    result->chain_symbol = NULL;
    result->last_fail_pos = (long)-1;

    elem = rule->first;
    /* Is the first element optional? */
    if (equal_tree(elem, str_opt))
    {   result->optional = TRUE;
        elem = elements(elem)->first;
    }

    /* Is it a sequential, chain or list? */
    if (equal_tree(elem, str_seq))
    {   result->sequential = TRUE;
        elem = elements(elem)->first;
    }
    else if (equal_tree(elem, str_chain))
    {   result->sequential = TRUE;
        result->chain_symbol = elements(elem)->next->first->c.str_value;
        elem = elements(elem)->first;
    }
    else if (equal_tree(elem, str_list))
    {   result->sequential = TRUE;
        result->chain_symbol = ",";
        elem = elements(elem)->first;
    }

    if (is_a_ident(elem))
    {
        if (equal_ident(elem, str_eof))
            result->kind = RK_T_EOF;
        else if (equal_ident(elem, str_string))
            result->kind = RK_T_STRING;
        else if (equal_ident(elem, str_int))
            result->kind = RK_T_INT;
        else if (equal_ident(elem, str_double))
            result->kind = RK_T_DOUBLE;
        else if (equal_ident(elem, str_ident))
            result->kind = RK_T_IDENT;
        else if (equal_ident(elem, str_qident))
            result->kind = RK_T_QIDENT;
        else
        {
            result->kind = RK_NT;
            result->info.non_terminal = find_nt(elem->c.str_value);
            if (result->info.non_terminal == NULL)
            {
                printf("Undefined non-terminal: '%s'\n", elem->c.str_value);
                exit(1);
            }
        }
    }
    else if (is_a_str(elem))
    {
        result->kind = RK_LIT;
        result->info.str_value = elem->c.str_value;
    }
    else if (is_a_list(elem))
    {
        result->kind = RK_OR_RULE;
        result->info.or_rule = make_or_rule(elements(elem));
    }
    result->next = make_rule(rule->next);

    return result;
}

or_rule_p make_or_rule(list_p or)
{
    if (or == NULL)
        return NULL;

    {   tree_p rule = or->first; /* only used as pointer */
        if (is_tree(rule, str_rule))
        {   list_p elem = elements(rule);
            or_rule_p result = MALLOC(or_rule_t);

            if (elem->first == NULL)
            {
                result->rule = NULL;
                result->tree_name = NULL;
            }
            else
            {   result->rule = make_rule(elements(elem->first));
                result->tree_name =   is_a_ident(elem->next->first)
                                    ? elem->next->first->c.str_value : NULL;
            }
            result->next = make_or_rule(or->next);
            return result;
        }
    }
 
    return make_or_rule(or->next);
}

void make_all_nt(tree_p root)
{
    list_p rules;

    /* init strings */
    str_root = string("root");
    str_nt_def = string("nt_def");
    str_ident = string("ident");
    str_qident = string("qident");
    str_rule = string("rule");
    str_opt = string("opt");
    str_seq = string("seq");
    str_list = string("list");
    str_chain = string("chain");
    str_prim_elem = string("prim_elem");
    str_string = string("string");
    str_int = string("int");
    str_double = string("double");
    str_eof = string("eof");

    all_nt = NULL;
    
    for (rules = root->c.parts; rules; rules = rules->next)
        if (is_tree(rules->first, str_nt_def))
        {   char *nt_name = part(rules->first, 1)->c.str_value;
            non_terminal_p nt = find_nt(nt_name);
            or_rule_p *p_first = &nt->first;
            or_rule_p *p_recursive = &nt->recursive;
            list_p or = part(rules->first, 2)->c.parts;

            while (*p_first != NULL)
                p_first = &(*p_first)->next;
            while (*p_recursive != NULL)
                p_recursive = &(*p_recursive)->next;

            for (; or != NULL; or = or->next)
            {   tree_p rule = or->first; /* only used as pointer */
                if (is_tree(rule, str_rule))
                {   list_p elem = elements(rule);
                    or_rule_p new = MALLOC(or_rule_t);

                    if (elem->first == NULL)
                    {   new->rule = NULL;
                        new->tree_name = NULL;
                        new->next = NULL;
                        *p_first = new;
                        p_first = &new->next;
                    }
                    else
                    {   list_p parts = elements(elem->first);
                        new->tree_name =   is_a_ident(elem->next->first)
                                         ? elem->next->first->c.str_value
                                         : NULL;
                        new->next = NULL;
                        if (parts == NULL || !is_ident(parts->first, nt_name))
                        {
                            new->rule = make_rule(parts);
                            *p_first = new;
                            p_first = &new->next;
                        }
                        else
                        {
                            new->rule = make_rule(parts->next);
                            *p_recursive = new;
                            p_recursive = &new->next;
                        }
                    }                     
                }
            }
        }
    {    non_terminal_p nt;
    
        for (nt = all_nt; nt != NULL; nt = nt->next)
            if (nt->first == NULL && nt->recursive == NULL)
                printf("Non-terminal '%s' has no rule.\n", nt->name);
    }            
}

enum success_t { s_unknown, s_fail, s_success } ;
typedef struct solution_T 
{
  struct solution_T *next;
  char *nt;
  enum success_t success;
  tree_p result;
  scan_pos_t sp;
} solution_t;

solution_t **solutions = NULL;
   
void init_solutions()
{ longword i;

  solutions = MALLOC_N(file_len+1, solution_t*);
  for (i = 0; i < file_len+1; i++)
      solutions[i] = NULL;
}

void free_solutions()
{
  longword i;

  for (i = 0; i < file_len+1; i++)
  {  solution_t *sol = solutions[i];

     while (sol != NULL)
     {  solution_t *next_sol = sol->next;
        tree_release(&sol->result);
        free(sol);
        sol = next_sol;
     }
  }
  free(solutions);
  solutions = NULL;
}

solution_t *find_solution(longword filepos, char *nt)
{
  solution_t *sol;

  if (filepos > file_len)
      filepos = file_len;

  for (sol = solutions[filepos]; sol != NULL; sol = sol->next)
      if ( sol->nt == nt )
          return sol;

  sol = MALLOC(solution_t);
  sol->next = solutions[filepos];
  sol->nt = nt;
  sol->success = s_unknown;
  sol->result = NULL;
  solutions[filepos] = sol;

  return sol;
} 


int grammar_level = 2;

int depth = 0;
bool debug_parse = FALSE;
bool debug_nt = FALSE;
char *current_nt = NULL;
rule_p current_rule = NULL;

#define DEBUG_ENTER(X) if (debug_parse) { DEBUG_TAB; printf("Enter: %s", X); depth += 2; }
#define DEBUG_ENTER_P1(X,A) if (debug_parse) { DEBUG_TAB; printf("Enter: "); printf(X,A); depth += 2; }
#define DEBUG_EXIT(X) if (debug_parse) { depth -=2; DEBUG_TAB; printf("Leave: %s", X); }
#define DEBUG_EXIT_P1(X,A) if (debug_parse) { depth -=2; DEBUG_TAB; printf("Leave: "); printf(X,A); }
#define DEBUG_TAB if (debug_parse) printf("%*.*s", depth, depth, "")
#define DEBUG_NL if (debug_parse) printf("\n")
#define DEBUG_PT(X) if (debug_parse) print_tree(stdout, X, TRUE)
#define DEBUG_PO(X) if (debug_parse) print_or(stdout, X)
#define DEBUG_PR(X) if (debug_parse) print_rule(stdout, X)
#define DEBUG_(X)  if (debug_parse) printf(X)
#define DEBUG_P1(X,A) if (debug_parse) printf(X,A)

bool parse_nt( non_terminal_p non_term, tree_p *rtree)
{
    or_rule_p or;
    char *surr_nt = current_nt;
    char *nt = non_term->name;
    solution_t *sol = find_solution(file_pos, nt);

    DEBUG_ENTER_P1("parse_nt(%s)", nt); DEBUG_NL;

    if (sol->success == s_success)
    {
        DEBUG_EXIT_P1("parse_nt(%s) SUCCESS", nt);  DEBUG_NL;
        tree_assign(rtree, sol->result);
        restore_pos(&sol->sp);
        return TRUE;
    }
    else if (sol->success == s_fail)
    {
        DEBUG_EXIT_P1("parse_nt(%s) FAIL", nt);  DEBUG_NL;
        return FALSE;
    }

    current_nt = nt;

    if (debug_nt)
    {   printf("%*.*s", depth, depth, "");
        printf("Enter: %s\n", nt);
        depth += 2; 
    }

    for ( or = non_term->first; or != NULL; or = or->next )
        if (parse_rule(or->rule, (val_p)NULL, or->tree_name, rtree))
            break;

    if (or != NULL)
    {
        for(;;)
        {   val_t val;
            val.prev = NULL;
            val.last = NULL;
            tree_move(&val.last, rtree);

            for ( or = non_term->recursive; or != NULL; or = or->next )
                if (parse_rule(or->rule, &val, or->tree_name, rtree))
                {   tree_release(&val.last);
                    break;
                }

            if (or == NULL)
            {   tree_move(rtree, &val.last);
                break;
            }
            tree_release(&val.last);
        }

        DEBUG_EXIT_P1("parse_nt(%s) =", nt);
        DEBUG_PT(*rtree); DEBUG_NL;
        if (debug_nt)
        {   depth -= 2;
            printf("%*.*s", depth, depth, "");
            printf("Parsed: %s\n", nt);
        }
        current_nt = surr_nt;
        tree_assign(&sol->result, *rtree);
        sol->success = s_success;
        save_pos(&sol->sp);
        return TRUE;
    }
    DEBUG_EXIT_P1("parse_nt(%s) - failed", nt);  DEBUG_NL;
    if (debug_nt)
    {   depth -= 2;
        printf("%*.*s", depth, depth, "");
        printf("Failed: %s\n", nt);
    }
    current_nt = surr_nt;
    sol->success = s_fail;
    return FALSE;
}

bool parse_or(or_rule_p or, tree_p *rtree)
{
    DEBUG_ENTER("parse_or: ");
    DEBUG_PO(or); DEBUG_NL;

    for ( ; or != NULL; or = or->next )
        if (parse_rule(or->rule, (val_p)NULL, or->tree_name, rtree))
        {   DEBUG_EXIT("parse_or = ");
            DEBUG_PT(*rtree); DEBUG_NL;
            return TRUE;
        }
    DEBUG_EXIT("parse_or: failed"); DEBUG_NL;
    return FALSE;
}


bool parse_rule(rule_p rule, val_p prev_parts, char *tree_name, tree_p *rtree)
{   bool optional,
         sequential;
    char *chain_sym;
    longword *last_fail_pos;
    scan_pos_t sp;
    bool try = FALSE;
    val_t val;
    
    DEBUG_ENTER("parse_rule: ");
    DEBUG_PR(rule); DEBUG_NL;

    /* At the end of the rule: */
    if (rule == NULL)
    {   if (tree_name != NULL)
        {   
            if (   prev_parts != NULL
                && prev_parts->prev == NULL
                && is_a_list(prev_parts->last) && 0)
            {
                tree_assign(rtree, prev_parts->last);
                (*rtree)->type = tree_name;
            }
            else
            {   /* make tree of previous elements: */
                *rtree = make_tree(tree_name);
                while (prev_parts)
                {   insert_element(*rtree, prev_parts->last);
                    prev_parts = prev_parts->prev;
                }
            }
        }
        else
        {   /* group previous elements into a list, if more than one: */
            if (prev_parts == NULL)
                *rtree = NULL;
            else if (prev_parts->prev == NULL)
                tree_assign(rtree, prev_parts->last);
            else
            {   *rtree = make_list();
                while (prev_parts)
                {   insert_element(*rtree, prev_parts->last);
                    prev_parts = prev_parts->prev;
                }
            }
        }
        DEBUG_EXIT("parse_rule = ");
        DEBUG_PT(*rtree); DEBUG_NL;
        return TRUE;
    }

    optional = rule->optional,
    sequential = rule->sequential;
    chain_sym = rule->chain_symbol;

    /* Did we fail the last time at this position? */
    if (rule->last_fail_pos == file_pos)
    {
        DEBUG_EXIT("parse_rule - BREAK "); DEBUG_NL;
        return FALSE;
    }
    last_fail_pos = &rule->last_fail_pos;

    save_pos(&sp);
    current_rule = rule;

    /* Try to accept first symbol */
    {   tree_p t = NULL;
        word s_line = cur_line,
             s_column = cur_column;

        switch( rule->kind )
        {   case RK_T_EOF:
                try = accept_eof();
                if (try)
                {
                    if (parse_rule(rule->next, prev_parts, tree_name,
                                   rtree))
                    {   DEBUG_EXIT("parse_rule = ");
                        DEBUG_PT(*rtree); DEBUG_NL;
                        return TRUE;
                    }
                }
                break;
            case RK_T_STRING:
            {   char *v;
                try = accept_string(&v);
                if (try)
                {   if (grammar_level > 1)
                    {
                        t = make_str_atom(string(v));
                        free(v);
                    }
                    else
                        t = make_str_atom(v);
                }
                break;
            }
            case RK_T_INT:
            {   longint v;
                try = accept_int(&v);
                if (try)
                    t = make_int_atom(v);
                break;
            }
            case RK_T_DOUBLE:
            {   double v;
                try = accept_double(&v);
                if (try)
                    t = make_double_atom(v);
                break;
            }
            case RK_T_IDENT:
            {   char *v;
                try = accept_ident(&v);
                if (try)
                    t = make_ident(v);
                break;
            }
            case RK_T_QIDENT:
            {   char *v;
                try = accept_qident(&v);
                if (try)
                    t = make_ident(v);
                break;
            }
            case RK_NT:
                try = parse_nt(rule->info.non_terminal, &t);
                break;
            case RK_LIT:
            {   char *ss = rule->info.str_value;
                if (accept_symbol(ss))
                {   if (sequential)
                    {   tree_p seq = make_list();

                        if (parse_seq(rule, chain_sym,
                                      seq, prev_parts, tree_name, rtree))
                        {   DEBUG_EXIT("parse_rule = ");
                            DEBUG_PT(*rtree); DEBUG_NL;
                            tree_release(&t);
                            tree_release(&seq);
                            return TRUE;
                        }

                        tree_release(&seq);
                    }
                    else if (parse_rule(rule->next, prev_parts, tree_name,
                                        rtree))
                    {   DEBUG_EXIT("parse_rule = ");
                        DEBUG_PT(*rtree); DEBUG_NL;
                        tree_release(&t);
                        return TRUE;
                    }
                }
                break;
            }
            case RK_OR_RULE:
                try = parse_or(rule->info.or_rule, &t);
                break;
            default:
                try = FALSE;
        } 
        if (t != NULL)
        {
            t->line = s_line;
            t->column = s_column;
        }
        if (try)
        {   /* We succeded in parsing the first element */
            if (sequential)
            {   tree_p seq = make_list();
                add_element(seq, t);

                if (parse_seq(rule, chain_sym,
                              seq, prev_parts, tree_name, rtree))
                {   DEBUG_EXIT("parse_rule = ");
                    DEBUG_PT(*rtree); DEBUG_NL;
                    tree_release(&t);
                    tree_release(&seq);
                    return TRUE;
                }

                tree_release(&seq);
            }
            else
            {
                val.last = NULL;
                tree_assign(&val.last, t);
                val.prev = prev_parts;
                prev_parts = &val;

                if (parse_rule(rule->next, prev_parts, tree_name, rtree))
                {   DEBUG_EXIT("parse_rule = ");
                    DEBUG_PT(*rtree); DEBUG_NL;
                    tree_release(&val.last);
                    tree_release(&t);
                    return TRUE;
                }
                tree_release(&val.last);
            }
        }
        tree_release(&t);
    }

    if (optional)
    {    
        restore_pos(&sp);

        /* First element was optional: */
        val.last = NULL;
        val.prev = prev_parts;
        prev_parts = &val;

        if (parse_rule(rule->next, prev_parts, tree_name, rtree))
        {
            DEBUG_EXIT("parse_rule = ");
            DEBUG_PT(*rtree); DEBUG_NL;
            return TRUE;
        }
    }

    restore_pos(&sp);

    *last_fail_pos = file_pos;
    DEBUG_EXIT_P1("parse_rule - failed at %ld", file_pos); DEBUG_NL;
    return FALSE;
}

bool parse_seq(rule_p rule, char *chain_sym,
               tree_p seq, val_p prev_parts, char *tree_name,
               tree_p *rtree)
{   scan_pos_t sp;
    bool try = FALSE;
    val_t val;
    
    DEBUG_ENTER("parse_seq: ");
    DEBUG_PR(rule); DEBUG_NL;

    save_pos(&sp);
    current_rule = rule;

    /* Try to accept first symbol */
    if (chain_sym == NULL || accept_symbol(chain_sym))
    {   tree_p t = NULL;
        word s_line = cur_line,
             s_column = cur_column;

        switch( rule->kind )
        {   case RK_T_EOF:
                try = accept_eof();
                if (try)
                   t = make_str_atom(string("EOF"));
                break;
            case RK_T_STRING:
            {   char *v;
                try = accept_string(&v);
                if (try)
                {   if (grammar_level > 1)
                    {
                        t = make_str_atom(string(v));
                        free(v);
                    }
                    else
                        t = make_str_atom(v);
                }
                break;
            }
            case RK_T_INT:
            {   longint v;
                try = accept_int(&v);
                if (try)
                    t = make_int_atom(v);
                break;
            }
            case RK_T_DOUBLE:
            {   double v;
                try = accept_double(&v);
                if (try)
                    t = make_double_atom(v);
                break;
            }
            case RK_T_IDENT:
            {   char *v;
                try = accept_ident(&v);
                if (try)
                    t = make_ident(v);
                break;
            }
            case RK_T_QIDENT:
            {   char *v;
                try = accept_qident(&v);
                if (try)
                    t = make_ident(v);
                break;
            }
            case RK_NT:
                try = parse_nt(rule->info.non_terminal, &t);
                break;
            case RK_LIT:
            {   char *ss = rule->info.str_value;
                try = accept_symbol(ss);
                break;
            }
            case RK_OR_RULE:
                try = parse_or(rule->info.or_rule, &t);
                break;
            default:
                try = FALSE;
        } 
           if (t != NULL)
           {
               t->line = s_line;
               t->column = s_column;
           }
   
        if (try)
        {   /* We succeded in parsing the first element */
            add_element(seq, t);

            if (parse_seq(rule, chain_sym,
                          seq, prev_parts, tree_name, rtree))
            {
                DEBUG_EXIT("parse_seq = ");
                DEBUG_PT(*rtree); DEBUG_NL;
                tree_release(&t);
                return TRUE;
            }
            drop_last_element(seq);
        }
        tree_release(&t);
    }

    restore_pos(&sp);

    val.last = NULL;
    tree_assign(&val.last, seq);
    val.prev = prev_parts;
    prev_parts = &val;
    if (parse_rule(rule->next, prev_parts, tree_name, rtree))
    {
        DEBUG_EXIT("parse_seq = ");
        DEBUG_PT(*rtree); DEBUG_NL;
        tree_release(&val.last);
        return TRUE;
    }

    restore_pos(&sp);

    DEBUG_EXIT_P1("parse_seq - failed at %ld", file_pos); DEBUG_NL;
    tree_release(&val.last);
    return FALSE;
}

void print_or(FILE *f, or_rule_p or)
{
    bool first = TRUE;

    for (; or; or = or->next)
    {   
        if (!first)
            fprintf(f, "|");
        first = FALSE;
        print_rule(f, or->rule);
        if (or->tree_name != NULL)
            fprintf(f, "[%s]", or->tree_name);
    }
}

void print_rule(FILE *f, rule_p rule)
{   
    bool optional,
         sequential;
    char *chain_sym;

    if (rule == NULL)
        return;

    optional = rule->optional,
    sequential = rule->sequential;
    chain_sym = rule->chain_symbol;

    switch(rule->kind)
    {   case RK_T_EOF:
            fprintf(f, "<eof> ");
            break;
        case RK_T_STRING:
            fprintf(f, "<string> ");
            break;
            break;
        case RK_T_INT:
            fprintf(f, "<int> ");
            break;
        case RK_T_DOUBLE:
            fprintf(f, "<double> ");
            break;
        case RK_T_IDENT:
            fprintf(f, "<ident> ");
            break;
        case RK_T_QIDENT:
            fprintf(f, "<qident> ");
            break;
        case RK_NT:
            fprintf(f, "%s ", rule->info.non_terminal->name);
            break;
        case RK_LIT:
            fprintf(f, "\"%s\" ", rule->info.str_value);
            break;
        case RK_OR_RULE:
            fprintf(f, "(");
            print_or(f, rule->info.or_rule);
            fprintf(f, ")");
            break;
    }

    if (sequential)
    {   if (chain_sym == NULL)
            fprintf(f, "SEQ ");
        else if (strcmp( chain_sym, ","))
            fprintf(f, "LIST ");
        else
            fprintf(f, "CHAIN %s ", chain_sym);
    }
    if (optional)
    {   fprintf(f, "OPT ");
    }
    print_rule(f, rule->next);
}


#define MAX_EXP_SYM 200
typedef struct {
  char *sym;
  char *in_nt;
  rule_p rule;
  char *is_keyword;
} expect_t;
expect_t expect[MAX_EXP_SYM];
char *exp_in_nt[MAX_EXP_SYM];

static void expected_string(char *s, char *is_keyword)
{
    if (file_pos < f_file_pos)
        return;
    if (file_pos > f_file_pos)
    {   nr_exp_syms = 0;
        f_file_pos = file_pos;
        f_line = cur_line;
        f_column = cur_column;
    }

    if (nr_exp_syms >= MAX_EXP_SYM)
        return;

    expect[nr_exp_syms].sym = s;
    expect[nr_exp_syms].in_nt = current_nt;
    expect[nr_exp_syms].rule = current_rule;
    expect[nr_exp_syms].is_keyword = is_keyword;
    nr_exp_syms++;
}

void print_last_pos()
{   int i;

    printf("%d.%d Expected:\n", f_line, f_column);
    for (i = 0; i < nr_exp_syms; i++)
    {   bool unique = TRUE;
        int j;
        for (j = 0; unique && j < i; j++)
            if (expect[i].rule == expect[j].rule)
                unique = FALSE;
        if (unique)
        {
            printf("    ");
            if (expect[i].rule)
                print_rule(stdout, expect[i].rule);
            else
                printf("%s ", expect[i].sym);
            printf(":");
            if (expect[i].in_nt)
                printf(" in %s", expect[i].in_nt);
            if (expect[i].is_keyword != NULL)
                printf(" ('%s' is a keyword)", expect[i].is_keyword);
            printf("\n");
        }
    }
}


//#include "PostScriptGrammar.c" /* Contains init_IParse_grammar */

void init_PostScriptGrammar( tree_p *root )
{   /* Generated by IParse version 1.1a of October 9, 2001. */
    tree_p tt[100];
    int v = 0;

#define ID(s) tt[v]=make_ident(string(s));
#define LITERAL(s) tt[v]=make_str_atom(string(s)); *keyword_state |= 1;
#define INT(i) tt[v]=make_int_atom(i);
#define DOUBLE(i) tt[v]=make_double_atom(i);
#define CHAR(i) tt[v]=make_char_atom(i);
#define TREE(n) tt[v]=make_tree(string(n)); v++;
#define LIST tt[v]=make_list(); v++;
#define NONE tt[v]=NULL;
#define SEP add_element(tt[v-1],tt[v]); tree_release(&tt[v]);
#define CLOSE add_element(tt[v-1],tt[v]); tree_release(&tt[v]); v--;
#define EMPTY_CLOSE v--;

    LIST TREE("nt_def") ID("root") SEP
      LIST TREE("rule") LIST TREE("seq") ID("elem") CLOSE SEP
         ID("eof") CLOSE SEP
        NONE CLOSE CLOSE CLOSE SEP
     TREE("nt_def") ID("elem") SEP
      LIST TREE("rule") LIST ID("ident") CLOSE SEP
        ID("id") CLOSE SEP
       TREE("rule") LIST ID("qident") CLOSE SEP
        ID("qid") CLOSE SEP
       TREE("rule") LIST ID("double") CLOSE SEP
        ID("double") CLOSE SEP
       TREE("rule") LIST ID("int") CLOSE SEP
        ID("int") CLOSE SEP
       TREE("rule") LIST ID("string") CLOSE SEP
        ID("string") CLOSE SEP
       TREE("rule") LIST LITERAL("{") SEP
         TREE("seq") ID("elem") CLOSE SEP
         LITERAL("}") CLOSE SEP
        ID("code") CLOSE CLOSE CLOSE CLOSE 
    *root = tt[0];
}




typedef struct
{
    char type;
    double d;
    int i;
    char* s;
    tree_p code;
} value_t;

value_t stack[100];
int stack_depth = 0;

list_p code_stack[100];
int code_stack_depth = 0;

void print_value(value_t *val)
{
    if (val->type == 'i')
        printf("ident '%s'", val->s);
    else if (val->type == 'c')
    {
        printf("code: ");
        print_tree(stdout, val->code, 1);
    }
    else if (val->type == 'I')
    {
        printf("int: %d", val->i);
    }
    else if (val->type == 'd')
    {
        printf("double: %lf", val->d);
    }
    else if (val->type == 's')
    {
        printf("string: '%s'", val->s);
    }
    else if (val->type == 'F')
    {
        printf("Font: '%s'", val->s);
    }
    else
        printf("??%c??", val->type);
}

void print_value_compact(value_t *val)
{
    if (val->type == 'i')
        printf(" %s", val->s);
    else if (val->type == 'c')
    {
        printf(" {}");
    }
    else if (val->type == 'I')
    {
        printf(" %d", val->i);
    }
    else if (val->type == 'd')
    {
        printf(" %.1lf", val->d);
    }
    else if (val->type == 's')
    {
        printf(" '%s'", val->s);
    }
    else if (val->type == 'F')
    {
        printf(" Font:'%s'", val->s);
    }
    else
        printf(" ?%c?", val->type);
}

struct
{
    char* name;
    value_t value;
} dict[100];
int nr_dict = 0;

char* str_qid;
char* str_code;
char* str_id;
char* str_def;
char* str_exec;
char* str_pop;
char* str_dup;
char* str_copy;
char* str_index;
char* str_exch;
char* str_roll;
char* str_for;
char* str_neg;
char* str_add;
char* str_sub;
char* str_mul;
char* str_div;
char* str_sin;
char* str_cos;
char* str_floor;
char* str_newpath;
char* str_closepath;
char* str_stroke;
char* str_clip;
char* str_gsave;
char* str_grestore;
char* str_showpage;
char* str_moveto;
char* str_lineto;
char* str_arc;
char* str_translate;
char* str_scale;
char* str_rotate;
char* str_setgray;
char* str_findfont;
char* str_scalefont;
char* str_setfont;
char* str_setrgbcolor;
char* str_show;

char* str_dumpstack;

bool trace = FALSE;
bool trace_stack = FALSE;

bool eval_code_stack()
{
    int start_code_stack_depth = code_stack_depth;
    int nr_gsave = 0;
    int nr_grestore = 0;
    
    for (;;)
    {
        if (trace_stack)
        {
            int i;
            for (i = 0; i < stack_depth; i++)
                print_value_compact(&stack[i]);
            printf(" |");
        }
        if (code_stack[code_stack_depth-1] == 0)
        {
            if (trace)
                printf(" exit\n");
            code_stack_depth--;
            if (code_stack_depth < start_code_stack_depth)
            {
                if (nr_gsave != nr_grestore)
                {
                    printf("Unbalanced gsave %d grestore %d\n", nr_gsave, nr_grestore);
                    return FALSE;
                }
                return TRUE;
            }
        }
        else
        {
            tree_p part = code_stack[code_stack_depth-1]->first;
            code_stack[code_stack_depth-1] = code_stack[code_stack_depth-1]->next;
            
            if (trace)
                printf("Exec code at %d.%d: %s (%d)", part->line, part->column, part->type, stack_depth);
            if (part->type == str_qid)
            {
                if (trace)
                    printf("   push ident '%s'\n", part->c.parts->first->c.str_value);
                stack[stack_depth].type = 'i';
                stack[stack_depth].s = part->c.parts->first->c.str_value;
                stack_depth++;
            }
            else if (part->type == str_code)
            {
                //print_tree(stdout, part->c.parts->first, 1);
                if (trace)
                    printf("   push code\n");
                stack[stack_depth].type = 'c';
                stack[stack_depth].code = part->c.parts->first;
                stack_depth++;
            }
            else if (part->type == str_int)
            {
                if (trace)
                    printf("   push int %d\n", part->c.parts->first->c.int_value);
                stack[stack_depth].type = 'I';
                stack[stack_depth].i = part->c.parts->first->c.int_value;
                stack_depth++;
            }
            else if (part->type == str_double)
            {
                if (trace)
                    printf("   push double %lf\n", part->c.parts->first->c.double_value);
                stack[stack_depth].type = 'd';
                stack[stack_depth].d = part->c.parts->first->c.double_value;
                stack_depth++;
            }
            else if (part->type == str_string)
            {
                if (trace)
                    printf("   push string '%s'\n", part->c.parts->first->c.str_value);
                stack[stack_depth].type = 's';
                stack[stack_depth].s = part->c.parts->first->c.str_value;
                stack_depth++;
            }
            else if (part->type == str_id)
            {
                char* id = part->c.parts->first->c.str_value;
                //print_tree(stdout, part, 1);
                if (id == str_def)
                {
                    int i;
                    if (stack_depth < 2)
                    {
                        printf("def: stack underflow\n");
                        return FALSE;
                    }
                    if (stack[stack_depth-2].type != 'i')
                    {
                        printf("def: second argument not an identifier\n");
                        return FALSE;
                    }
                    char* iddef = stack[stack_depth-2].s;
                    if (trace)
                    {
                        printf("   def %s = ", iddef);
                        print_value(&stack[stack_depth-1]);
                        printf("\n");
                    }
                    for (i = 0; i < nr_dict; i++)
                    {
                        if (dict[i].name == iddef)
                            break;
                    }
                    if (i == nr_dict)
                    {
                        dict[i].name = iddef;
                        nr_dict++;
                    }
                    dict[i].value = stack[stack_depth-1];
                    stack_depth -= 2;
                }
                else if (id == str_exec)
                {
                    if (stack_depth < 1)
                    {
                        printf("exec: stack underflow\n");
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'c')
                    {
                        printf("exec: first argument not code\n");
                        return FALSE;
                    }
                    
                    if (trace)
                        printf("    exec code\n", id);
                    code_stack[code_stack_depth] = stack[stack_depth-1].code->c.parts;
                    code_stack_depth++;
                    stack_depth--;
                }
                else if (id == str_dumpstack)
                {    int i;
                
                    printf("   dumpstack (at %d.%d: %s (%d)) : \n", part->line, part->column, part->type, stack_depth);
                    for (i = stack_depth-1; i >= 0; i--)
                    {
                        printf("- ");
                        print_value(&stack[i]);
                        printf("\n");
                    }
                    printf("\n");
                }
                else if (id == str_pop)
                {
                    int ind = 0;
                    
                    if (stack_depth < 1)
                    {
                        printf("pop: stack underflow\n");
                    }
                    if (trace)
                        printf("   pop\n");
                    stack_depth--;
                }
                else if (id == str_dup)
                {
                    int ind = 0;
                    
                    if (stack_depth < 1)
                    {
                        printf("pop: stack underflow\n");
                    }
                    if (trace)
                        printf("   dup\n");
                    stack[stack_depth] = stack[stack_depth-1];
                    stack_depth++;
                }
                else if (id == str_copy)
                {
                    int n, i;
                    value_t val;
                    if (stack_depth < 1)
                    {
                        printf("copy: stack underflow\n");
                    }
                    if (stack[stack_depth-1].type != 'I')
                    {
                        printf("%s: first argument not an integer\n", id);
                        return FALSE;
                    }
                    n = stack[stack_depth-1].i;
                    if (stack_depth < 1 + n)
                    {
                        printf("copy: stack underflow for %d\n", n);
                        return FALSE;
                    }
                    if (trace)
                        printf("    copy\n");
                    stack_depth--;
                    for (i = 0; i < n; i++)
                    {
                        stack[stack_depth] = stack[stack_depth-n];
                        stack_depth++;
                    }
                }
                else if (id == str_index)
                {
                    int ind = 0;
                    
                    if (stack_depth < 1)
                    {
                        printf("index: stack underflow\n");
                    }
                    if (stack[stack_depth-1].type != 'I')
                    {
                        printf("index: first argument not an int\n");
                        return FALSE;
                    }
                    ind = stack[stack_depth-1].i;
                    if (ind < 0 || ind > stack_depth-2)
                    {
                        printf("index: ill index: %d\n", ind);
                        return FALSE;
                    }
                    else
                    {
                        if (trace)
                        {
                            printf("   index %d: ", ind);
                            print_value(&stack[stack_depth-1-ind-1]);
                            printf("\n");
                        }
                        stack[stack_depth-1] = stack[stack_depth-1-ind-1];
                    }
                }
                else if (id == str_exch)
                {
                    value_t val;
                    if (stack_depth < 2)
                    {
                        printf("exch: stack underflow\n");
                    }
                    if (trace)
                        printf("    exch\n");
                    val = stack[stack_depth-1];
                    stack[stack_depth-1] = stack[stack_depth-2];
                    stack[stack_depth-2] = val;
                }
                else if (id == str_roll)
                {
                    int n, j;
                    value_t val;
                    if (stack_depth < 2)
                    {
                        printf("roll: stack underflow\n");
                    }
                    if (stack[stack_depth-1].type != 'I')
                    {
                        printf("%s: first argument not an integer\n", id);
                        return FALSE;
                    }
                    j = stack[stack_depth-1].i;
                    if (stack[stack_depth-2].type != 'I')
                    {
                        printf("%s: second argument not an integer\n", id);
                        return FALSE;
                    }
                    n = stack[stack_depth-2].i;
                    if (stack_depth < 2 + n)
                    {
                        printf("roll: stack underflow for %d\n", n);
                        return FALSE;
                    }
                    if (trace)
                        printf("    roll\n");
                    stack_depth -= 2;
                    if (n > 1)
                    {
                        for (; j > 0; j--)
                        {
                            value_t val = stack[stack_depth-1];
                            int i;
                            
                            for (i = 1; i < n; i++)
                                stack[stack_depth-i] = stack[stack_depth-i-1];
                            stack[stack_depth-n] = val;
                        }
                    }
                }
                else if (id == str_for)
                {
                    list_p code;
                    double start;
                    double step;
                    double until_inc;
                    if (stack_depth < 4)
                    {
                        printf("for: stack underflow\n");
                    }
                    if (stack[stack_depth-1].type != 'c')
                    {
                        printf("%s: first argument not code\n", id);
                        return FALSE;
                    }
                    code = stack[stack_depth-1].code->c.parts;
                    if (stack[stack_depth-2].type != 'd' && stack[stack_depth-2].type != 'I')
                    {
                        printf("%s: second argument not a double\n", id);
                        return FALSE;
                    }
                    until_inc = (stack[stack_depth-2].type == 'd' ? stack[stack_depth-2].d : stack[stack_depth-2].i) + 0.00001;
                    if (stack[stack_depth-3].type != 'd' && stack[stack_depth-3].type != 'I')
                    {
                        printf("%s: third argument not a double\n", id);
                        return FALSE;
                    }
                    step = stack[stack_depth-3].type == 'd' ? stack[stack_depth-3].d : stack[stack_depth-3].i;
                    if (stack[stack_depth-4].type != 'd' && stack[stack_depth-4].type != 'I')
                    {
                        printf("%s: fourth argument not a double\n", id);
                        return FALSE;
                    }
                    start = stack[stack_depth-4].type == 'd' ? stack[stack_depth-4].d : stack[stack_depth-4].i;
                    if (step < 0.0001)
                    {
                        printf("for: step size %lf too small\n", step);
                        return FALSE;
                    }
                    if (trace)
                        printf("    for %lf %lf %lf\n", start, step, until_inc);
                    stack_depth -= 4;
                    for (; start < until_inc; start += step)
                    {
                        if (trace)
                            printf("     do for %lf\n", start);
                        code_stack[code_stack_depth] = code;
                        code_stack_depth++;
                        stack_depth++;
                        stack[stack_depth-1].type = 'd';
                        stack[stack_depth-1].d = start;
                        
                        if (!eval_code_stack())
                            return FALSE;
                    }
                }
                else if (id == str_neg)
                {
                    double d;
                    if (stack_depth < 1)
                    {
                        printf("%s: stack underflow\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'd' && stack[stack_depth-1].type != 'I')
                    {
                        printf("%s: first argument not a double\n", id);
                        return FALSE;
                    }
                    if (trace)
                        printf("   neg");
                    if (stack[stack_depth-1].type == 'd')
                        stack[stack_depth-1].d = -stack[stack_depth-1].d;
                    else
                        stack[stack_depth-1].i = -stack[stack_depth-1].i;
                }
                else if (id == str_add || id == str_sub || id == str_mul || id == str_div)
                {
                    double d1;
                    double d2;
                    double result;
                    
                    if (stack_depth < 2)
                    {
                        printf("%s: stack underflow\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'd' && stack[stack_depth-1].type != 'I')
                    {
                        printf("%s: first argument not a double\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-2].type != 'd' && stack[stack_depth-2].type != 'I')
                    {
                        printf("%s: second argument not a double\n", id);
                        return FALSE;
                    }
                    d1 = stack[stack_depth-1].type == 'd' ? stack[stack_depth-1].d : stack[stack_depth-1].i;
                    d2 = stack[stack_depth-2].type == 'd' ? stack[stack_depth-2].d : stack[stack_depth-2].i;
                    stack_depth -= 1;
                    if (id == str_add)
                        result = d2 + d1;
                    else if (id == str_sub)
                        result = d2 - d1;
                    else if (id == str_mul)
                        result = d2 * d1;
                    else if (id == str_div)
                        result = d2 / d1;
                    if (trace)
                        printf("    %lf %s %lf = %lf\n", d2, id, d1, result);
                    stack[stack_depth-1].type = 'd';
                    stack[stack_depth-1].d = result;
                }
                else if (id == str_sin || id == str_cos || id == str_floor)
                {
                    double d;
                    if (stack_depth < 1)
                    {
                        printf("%s: stack underflow\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'd' && stack[stack_depth-1].type != 'I')
                    {
                        printf("%s: first argument not an double\n", id);
                        return FALSE;
                    }
                    d = stack[stack_depth-1].type == 'd' ? stack[stack_depth-1].d : stack[stack_depth-1].i;
                    if (id == str_sin)
                    {
                        if (trace)
                            printf("   sin(%lf) = %lf\n", d, sin(d * M_PI / 180.0));
                        stack[stack_depth-1].type = 'd';
                        stack[stack_depth-1].d = sin(d * M_PI / 180.0);
                    }
                    else if (id == str_cos)
                    {
                        if (trace)
                            printf("   cos(%lf) = %lf\n", d, cos(d * M_PI / 180.0));
                        stack[stack_depth-1].type = 'd';
                        stack[stack_depth-1].d = cos(d * M_PI / 180.0);
                    }
                    else if (id == str_floor)
                    {
                        if (trace)
                            printf("   floor(%lf) = %lf\n", d, floor(d));
                        stack[stack_depth-1].type = 'd';
                        stack[stack_depth-1].d = floor(d);
                    }
                }
                else if (id == str_newpath)
                {
                    if (trace)
                        printf("    newpath\n");
                }
                else if (id == str_closepath)
                {
                    if (trace)
                        printf("    closepath\n");
                }
                else if (id == str_stroke)
                {
                    if (trace)
                        printf("    stroke\n");
                }
                else if (id == str_clip)
                {
                    if (trace)
                        printf("    clip\n");
                }
                else if (id == str_gsave)
                {
                    nr_gsave++;
                    if (trace)
                        printf("    gsave\n");
                }
                else if (id == str_grestore)
                {
                    nr_grestore++;
                    if (trace)
                        printf("    grestore\n");
                }
                else if (id == str_showpage)
                {
                    /*if (trace)*/
                        printf("    showpage\n");
                }
                else if (id == str_findfont)
                {
                    if (stack_depth < 1)
                    {
                        printf("findfont: stack underflow def\n");
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'i')
                    {
                        printf("findfont: first argument not an identifier\n");
                        return FALSE;
                    }
                    stack[stack_depth-1].type = 'F';
                }
                else if (id == str_scalefont)
                {
                    if (stack_depth < 2)
                    {
                        printf("scalefont: stack underflow\n");
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'd' && stack[stack_depth-1].type != 'I')
                    {
                        printf("scalefont: first argument not an double\n");
                        return FALSE;
                    }
                    if (stack[stack_depth-2].type != 'F')
                    {
                        printf("scalefont: second argument not a font\n");
                        return FALSE;
                    }
                    stack_depth--;
                }
                else if (id == str_setfont)
                {
                    if (stack_depth < 1)
                    {
                        printf("setfont: stack underflow\n");
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'F')
                    {
                        printf("setfont: first argument not a font\n");
                        return FALSE;
                    }
                    stack_depth--;
                }
                else if (id == str_setrgbcolor)
                {
                    if (stack_depth < 3)
                    {
                        printf("setrgbcolor: stack underflow\n");
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'd' && stack[stack_depth-1].type != 'I')
                    {
                        printf("%s: first argument not a double\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-2].type != 'd' && stack[stack_depth-2].type != 'I')
                    {
                        printf("%s: second argument not a double\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-3].type != 'd' && stack[stack_depth-3].type != 'I')
                    {
                        printf("%s: third argument not a double\n", id);
                        return FALSE;
                    }
                    stack_depth -= 3;
                }
                else if (id == str_show)
                {
                    if (stack_depth < 1)
                    {
                        printf("show: stack underflow def\n");
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 's')
                    {
                        printf("show: first argument not a string\n");
                        return FALSE;
                    }
                    stack_depth--;
                }
                else if (id == str_moveto || id == str_lineto || id == str_translate || id == str_scale)
                {
                    double d1, d2;
                    if (stack_depth < 2)
                    {
                        printf("%s: stack underflow def\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'd' && stack[stack_depth-1].type != 'I')
                    {
                        printf("%s: first argument not a double\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-2].type != 'd' && stack[stack_depth-2].type != 'I')
                    {
                        printf("%s: second argument not a double\n", id);
                        return FALSE;
                    }
                    d1 = stack[stack_depth-1].type == 'd' ? stack[stack_depth-1].d : stack[stack_depth-1].i;
                    d2 = stack[stack_depth-2].type == 'd' ? stack[stack_depth-2].d : stack[stack_depth-2].i;
                    if (trace)
                        printf("    %s %lf %lf\n", id, d2, d1);
                    stack_depth -= 2;    
                }
                else if (id == str_arc)
                {
                    double d1, d2, d3, d4, d5;
                    if (stack_depth < 5)
                    {
                        printf("%s: stack underflow def\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'd' && stack[stack_depth-1].type != 'I')
                    {
                        printf("%s: first argument not a double\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-2].type != 'd' && stack[stack_depth-2].type != 'I')
                    {
                        printf("%s: second argument not a double\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-3].type != 'd' && stack[stack_depth-3].type != 'I')
                    {
                        printf("%s: third argument not a double\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-4].type != 'd' && stack[stack_depth-4].type != 'I')
                    {
                        printf("%s: fourth argument not a double\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-5].type != 'd' && stack[stack_depth-5].type != 'I')
                    {
                        printf("%s: fifth argument not a double\n", id);
                        return FALSE;
                    }
                    d1 = stack[stack_depth-1].type == 'd' ? stack[stack_depth-1].d : stack[stack_depth-1].i;
                    d2 = stack[stack_depth-2].type == 'd' ? stack[stack_depth-2].d : stack[stack_depth-2].i;
                    d3 = stack[stack_depth-3].type == 'd' ? stack[stack_depth-3].d : stack[stack_depth-3].i;
                    d4 = stack[stack_depth-4].type == 'd' ? stack[stack_depth-4].d : stack[stack_depth-4].i;
                    d5 = stack[stack_depth-5].type == 'd' ? stack[stack_depth-5].d : stack[stack_depth-5].i;
                    if (trace)
                        printf("    arc %lf %lf %lf %lf %lf\n", id, d5, d4, d3, d2, d1);
                    stack_depth -= 5;    
                
                }
                else if (id == str_rotate || id == str_setgray)
                {
                    double d;
                    if (stack_depth < 1)
                    {
                        printf("%s: stack underflow def\n", id);
                        return FALSE;
                    }
                    if (stack[stack_depth-1].type != 'd' && stack[stack_depth-1].type != 'I')
                    {
                        printf("%s: first argument not a double\n", id);
                        return FALSE;
                    }
                    d = stack[stack_depth-1].type == 'd' ? stack[stack_depth-1].d : stack[stack_depth-1].i;
                    if (trace)
                        printf("    %s %lf\n", id, d);
                    stack_depth -= 1;
                }    
                else
                {
                    int i;
                    for (i = 0; i < nr_dict; i++)
                        if (dict[i].name == id)
                            break;
                    if (i < nr_dict)
                    {
                        if (dict[i].value.type == 'c')
                        {
                            if (trace)
                                printf("    call %s\n", id);
                            code_stack[code_stack_depth] = dict[i].value.code->c.parts;
                            code_stack_depth++;
                        }
                        else
                        {
                            if (trace)
                                printf("   push value of %s\n", id);
                            stack[stack_depth] = dict[i].value;
                            stack_depth++;
                        }
                    }
                    else
                    {
                        printf("Unknown command '%s'\n", id);
                        return FALSE;
                    }
                }
            }
            else
            {
                printf("Unknown code: ");
                print_tree(stdout, part, 1);
                printf("\n");
                return FALSE;
            }
        }
    }
    
    return FALSE;    
}    


bool eval(tree_p code)
{
    str_qid = string("qid");
    str_code = string("code");
    str_id = string("id");
    str_int = string("int");
    str_double = string("double");
    str_string = string("string");
    str_def = string("def");
    str_exec = string("exec");
    str_pop = string("pop");
    str_dup = string("dup");
    str_copy = string("copy");
    str_index = string("index");
    str_exch = string("exch");
    str_roll = string("roll");
    str_for = string("for");
    str_neg = string("neg");
    str_add = string("add");
    str_sub = string("sub");
    str_mul = string("mul");
    str_div = string("div");
    str_sin = string("sin");
    str_cos = string("cos");
    str_floor = string("floor");
    str_newpath = string("newpath");
    str_closepath = string("closepath");
    str_stroke = string("stroke");
    str_clip = string("clip");
    str_gsave = string("gsave");
    str_grestore = string("grestore");
    str_showpage = string("showpage");
    str_moveto = string("moveto");
    str_lineto = string("lineto");
    str_arc = string("arc");
    str_translate = string("translate");
    str_scale = string("scale");
    str_rotate = string("rotate");
    str_setgray = string("setgray");
    str_findfont = string("findfont");
    str_scalefont = string("scalefont");
    str_setfont = string("setfont");
    str_setrgbcolor = string("setrgbcolor");
    str_show = string("show");

    str_dumpstack = string("dumpstack");

    list_p cur_parts;
    
    if (code == 0)
    {
        printf("Empty code\n");
        return;
    }

    if (code->type != tt_list)
    {
        printf("code is not a list\n");
        return;
    }
    
    code_stack[0] = code->c.parts;
    code_stack_depth = 1;

    eval_code_stack();
    
    printf("\n\nStack:\n");
    while (stack_depth > 0)
    {
        stack_depth--;
        printf("- ");
        print_value(&stack[stack_depth]);
        printf("\n");
    }
    printf("\nCode stack\n");
    while (code_stack_depth > 0)
    {
        code_stack_depth--;
        if (code_stack[code_stack_depth] == 0)
            printf("- empty\n");
        else
        {
            printf("- ");
            print_tree(stdout, code_stack[code_stack_depth]->first, 1);
            printf("\n");
            //printf("- %d.%d", code_stack[code_stack_depth]->first->line, code_stack[code_stack_depth]->first->column);
        }
    }
    printf("\nDict\n");
    {
        int i;
        for (i = 0; i < nr_dict; i++)
        {
            printf("- %s: ", dict[i].name);
            print_value(&dict[i].value);
            printf("\n");
        }
    }
}    



int main(int argc, char *argv[])
{   tree_p tree_PSG = NULL;
    tree_p tree_PS = NULL;
    FILE *fin;

    if (argc == 1)
    {   printf("Usage: %s <inputfile>\n", argv[0]);
        return 0;
    }

    init_PostScriptGrammar(&tree_PSG);

    fin = fopen(argv[1], "rt");

    if (fin == NULL)
    {   printf("Cannot open: %s\n", argv[1]);
        return 0;
    }
    
    init_scan(fin);

    make_all_nt(tree_PSG);
    tree_release(&tree_PSG);
   
    init_solutions();

    if (!parse_nt(find_nt(str_root), &tree_PS))
    {   print_last_pos();
        return 0;
    }
    
    eval(tree_PS);

    return 0;
}