/*
 * astlib.c
 *
 * SOFTWARE RIGHTS
 *
 * We reserve no LEGAL rights to SORCERER -- SORCERER is in the public
 * domain.  An individual or company may do whatever they wish with
 * source code distributed with SORCERER or the code generated by
 * SORCERER, including the incorporation of SORCERER, or its output, into
 * commerical software.
 *
 * We encourage users to develop software with SORCERER.  However, we do
 * ask that credit is given to us for developing SORCERER.  By "credit",
 * we mean that if you incorporate our source code into one of your
 * programs (commercial product, research project, or otherwise) that you
 * acknowledge this fact somewhere in the documentation, research report,
 * etc...  If you like SORCERER and have developed a nice tool with the
 * output, please mention that you developed it using SORCERER.  In
 * addition, we ask that this header remain intact in our source code.
 * As long as these guidelines are kept, we expect to continue enhancing
 * this system and expect to make other tools available as they are
 * completed.
 *
 * SORCERER 1.00B
 * Terence Parr
 * AHPCRC, University of Minnesota
 * 1992-1994
 */

#include <stdio.h>
#include "pcctscfg.h"
#include <ctype.h>

#define SORCERER_TRANSFORM

#include "CASTBase.h"
#include "astlib.h"

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

               /* String Scanning/Parsing Stuff */

#define StringScanMaxText  50

typedef struct stringlexer {
#ifdef __USE_PROTOS
      signed int c;
#else
      int c;
#endif
      char *input;
      char *p;
      char text[StringScanMaxText];
    } StringLexer;

#define LPAREN      1
#define RPAREN      2
#define PERCENT      3
#define INT        4
#define COLON      5
#define POUND      6
#define PERIOD      7
#define StringScanEOF  -1
#define VALID_SCAN_TOKEN(t)    (t>=LPAREN && t<=PERIOD)

static char *scan_token_tbl[] = {
  "invalid",  /*  0 */
  "LPAREN",  /*  1 */
  "RPAREN",  /*  2 */
  "PERCENT",  /*  3 */
  "INT",    /*  4 */
  "COLON",  /*  5 */
  "POUND",  /*  6 */
  "PERIOD",  /*  7 */
};

char *
#ifdef __USE_PROTOS
scan_token_str(int t)
#else
scan_token_str(t)
int t;
#endif
{
  if ( VALID_SCAN_TOKEN(t) ) return scan_token_tbl[t];
  else if ( t==StringScanEOF ) return "<end-of-string>";
  else return "<invalid-token>";
}

typedef struct stringparser {
      int token;
      StringLexer *lexer;
      int num_labels;
    } StringParser;

          /* This type ONLY USED by ast_scan() */

typedef struct _scanast {
            struct _scanast *right, *down;
            int token;
      int label_num;
        } ScanAST;

#ifdef __USE_PROTOS
static void stringlexer_init(StringLexer *scanner, char *input);
static void stringparser_init(StringParser *, StringLexer *);
static ScanAST *stringparser_parse_scanast(char *templ, int *n);
static ScanAST *stringparser_parse_tree(StringParser *parser);
static ScanAST *stringparser_parse_element(StringParser *parser);
static void stringscan_advance(StringLexer *scanner);
static int stringscan_gettok(StringLexer *scanner);
#else
static void stringlexer_init();
static void stringparser_init();
static ScanAST *stringparser_parse_scanast();
static ScanAST *stringparser_parse_tree();
static ScanAST *stringparser_parse_element();
static void stringscan_advance();
static int stringscan_gettok();
#endif

/* build a tree (root child1 child2 ... NULL)
 * If root is NULL, simply make the children siblings and return ptr
 * to 1st sibling (child1).  If root is not single node, return NULL.
 *
 * Siblings that are actually sibling lists themselves are handled
 * correctly.  For example #( NULL, #( NULL, A, B, C), D) results
 * in the tree ( NULL A B C D ).
 *
 * Requires at least two parameters with the last one being NULL.  If
 * both are NULL, return NULL.
 *
 * The ast_down and ast_right down/right pointers are used to make the tree.
 */
SORAST *
#ifdef PCCTS_USE_STDARG
ast_make(SORAST *rt, ...)
#else
ast_make(va_alist)
va_dcl
#endif
{
  va_list ap;
  register SORAST *child, *sibling=NULL, *tail = NULL, *w;
  SORAST *root;

#ifdef PCCTS_USE_STDARG
  va_start(ap, rt);
  root = rt;
#else
  va_start(ap);
  root = va_arg(ap, SORAST *);
#endif

  if ( root != NULL )
    if ( root->ast_down != NULL ) return NULL;
  child = va_arg(ap, SORAST *);
  while ( child != NULL )
  {
    /* find end of child */
    for (w=child; w->ast_right!=NULL; w=w->ast_right) {;}
    if ( sibling == NULL ) {sibling = child; tail = w;}
    else {tail->ast_right = child; tail = w;}
    child = va_arg(ap, SORAST *);
  }
  if ( root==NULL ) root = sibling;
  else root->ast_down = sibling;
  va_end(ap);
  return root;
}

/* The following push and pop routines are only used by ast_find_all() */

static void
#ifdef __USE_PROTOS
_push(SORAST **st, int *sp, SORAST *e)
#else
_push(st, sp, e)
SORAST **st;
int *sp;
SORAST *e;
#endif
{
  (*sp)--;
  require((*sp)>=0, "stack overflow");
  st[(*sp)] = e;
}

static SORAST *
#ifdef __USE_PROTOS
_pop(SORAST **st, int *sp)
#else
_pop(st, sp)
SORAST **st;
int *sp;
#endif
{
  SORAST *e = st[*sp];
  (*sp)++;
  require((*sp)<=MaxTreeStackDepth, "stack underflow");
  return e;
}

/* Is 'u' a subtree of 't' beginning at the root? */
int
#ifdef __USE_PROTOS
ast_match_partial(SORAST *t, SORAST *u)
#else
ast_match_partial(t, u)
SORAST *t, *u;
#endif
{
  SORAST *sib;

  if ( u==NULL ) return 1;
  if ( t==NULL ) if ( u!=NULL ) return 0; else return 1;

  for (sib=t; sib!=NULL&&u!=NULL; sib=sib->ast_right, u=u->ast_right)
  {
    if ( sib->token != u->token ) return 0;
    if ( sib->ast_down!=NULL )
      if ( !ast_match_partial(sib->ast_down, u->ast_down) ) return 0;
  }
  return 1;
}

/* Find all occurrences of u in t.
 * 'cursor' must be initialized to 't'.  It eventually
 * returns NULL when no more occurrences of 'u' are found.
 */
SORAST *
#ifdef __USE_PROTOS
ast_find_all(SORAST *t, SORAST *u, SORAST **cursor)
#else
ast_find_all(t, u, cursor)
SORAST *t, *u, **cursor;
#endif
{
  SORAST *sib;
  static SORAST *template_stack[MaxTreeStackDepth];
  static int tsp = MaxTreeStackDepth;

  if ( *cursor == NULL ) return NULL;
  if ( *cursor!=t ) sib = *cursor;
  else {
    /* else, first time--start at top of template 't' */
    tsp = MaxTreeStackDepth;
    sib = t;
    /* bottom of stack is always a NULL--"cookie" indicates "done" */
    _push(template_stack, &tsp, NULL);
  }

keep_looking:
  if ( sib==NULL )  /* hit end of sibling list */
  {
    sib = _pop(template_stack, &tsp);
    if ( sib == NULL ) { *cursor = NULL; return NULL; }
  }

  if ( sib->token != u->token )
  {
    /* look for another match */
    if ( sib->ast_down!=NULL )
    {
      if ( sib->ast_right!=NULL ) _push(template_stack, &tsp, sib->ast_right);
      sib=sib->ast_down;
      goto keep_looking;
    }
    /* nothing below to try, try next sibling */
    sib=sib->ast_right;
    goto keep_looking;
  }

  /* found a matching root node, try to match what's below */
  if ( ast_match_partial(sib, u) )
  {
    /* record sibling cursor so we can pick up next from there */
    if ( sib->ast_down!=NULL )
    {
      if ( sib->ast_right!=NULL ) _push(template_stack, &tsp, sib->ast_right);
      *cursor = sib->ast_down;
    }
    else if ( sib->ast_right!=NULL ) *cursor = sib->ast_right;
    else *cursor = _pop(template_stack, &tsp);
    return sib;
  }

  /* no match, keep searching */
  if ( sib->ast_down!=NULL )
  {
    if ( sib->ast_right!=NULL ) _push(template_stack, &tsp, sib->ast_right);
    sib=sib->ast_down;
  }
  else sib = sib->ast_right;  /* else, try to right if zip below */
  goto keep_looking;
}

/* are two trees exactly alike? */
int
#ifdef __USE_PROTOS
ast_match(SORAST *t, SORAST *u)
#else
ast_match(t, u)
SORAST *t, *u;
#endif
{
  SORAST *sib;

  if ( t==NULL ) if ( u!=NULL ) return 0; else return 1;
  if ( u==NULL ) return 0;

  for (sib=t; sib!=NULL&&u!=NULL; sib=sib->ast_right, u=u->ast_right)
  {
    if ( sib->token != u->token ) return 0;
    if ( sib->ast_down!=NULL )
      if ( !ast_match(sib->ast_down, u->ast_down) ) return 0;
  }
  return 1;
}

static int
#ifdef __USE_PROTOS
ast_scanmatch(ScanAST *t, SORAST *u, SORAST **labels[], int *n)
#else
ast_scanmatch(t, u, labels, n)
ScanAST *t;
SORAST *u;
SORAST **labels[];
int *n;
#endif
{
  ScanAST *sib;

  if ( t==NULL ) if ( u!=NULL ) return 0; else return 1;
  if ( u==NULL ) return 0;

  for (sib=t; sib!=NULL&&u!=NULL; sib=sib->right, u=u->ast_right)
  {
    /* make sure tokens match; token of '0' means wildcard match */
    if ( sib->token != u->token && sib->token!=0 ) return 0;
    /* we have a matched token here; set label pointers if exists */
    if ( sib->label_num>0 )
    {
      require(labels!=NULL, "label found in template, but no array of labels");
      (*n)++;
      *(labels[sib->label_num-1]) = u;
    }
    /* match what's below if something there and current node is not wildcard */
    if ( sib->down!=NULL && sib->token!=0 )
      if ( !ast_scanmatch(sib->down, u->ast_down, labels, n) ) return 0;
  }
  return 1;
}

void
#ifdef __USE_PROTOS
ast_insert_after(SORAST *a, SORAST *b)
#else
ast_insert_after(a, b)
SORAST *a,*b;
#endif
{
  SORAST *end;
  require(a!=NULL, "ast_insert_after: NULL input tree");
  if ( b==NULL ) return;
  /* find end of b's child list */
  for (end=b; end->ast_right!=NULL; end=end->ast_right) {;}
  end->ast_right = a->ast_right;
  a->ast_right = b;
}

void
#ifdef __USE_PROTOS
ast_append(SORAST *a, SORAST *b)
#else
ast_append(a, b)
SORAST *a,*b;
#endif
{
  SORAST *end;
  require(a!=NULL&&b!=NULL, "ast_append: NULL input tree");
  /* find end of child list */
  for (end=a; end->ast_right!=NULL; end=end->ast_right) {;}
  end->ast_right = b;
}

SORAST *
#ifdef __USE_PROTOS
ast_tail(SORAST *a)
#else
ast_tail(a)
SORAST *a;
#endif
{
  SORAST *end;
  require(a!=NULL, "ast_tail: NULL input tree");
  /* find end of child list */
  for (end=a; end->ast_right!=NULL; end=end->ast_right) {;}
  return end;
}

SORAST *
#ifdef __USE_PROTOS
ast_bottom(SORAST *a)
#else
ast_bottom(a)
SORAST *a;
#endif
{
  SORAST *end;
  require(a!=NULL, "ast_bottom: NULL input tree");
  /* find end of child list */
  for (end=a; end->ast_down!=NULL; end=end->ast_down) {;}
  return end;
}

SORAST *
#ifdef __USE_PROTOS
ast_cut_between(SORAST *a, SORAST *b)
#else
ast_cut_between(a, b)
SORAST *a,*b;
#endif
{
  SORAST *end, *ret;
  require(a!=NULL&&b!=NULL, "ast_cut_between: NULL input tree");
  /* find node pointing to b */
  for (end=a; end->ast_right!=NULL&&end->ast_right!=b; end=end->ast_right)
    {;}
  require(end->ast_right!=NULL, "ast_cut_between: a,b not connected");
  end->ast_right = NULL;  /* don't want it point to 'b' anymore */
  ret = a->ast_right;
  a->ast_right = b;
  return ret;
}

SList *
#ifdef __USE_PROTOS
ast_to_slist(SORAST *t)
#else
ast_to_slist(t)
SORAST *t;
#endif
{
  SList *list=NULL;
  SORAST *p;

  for (p=t; p!=NULL; p=p->ast_right)
  {
    slist_add(&list, p);
  }
  return list;
}

SORAST *
#ifdef __USE_PROTOS
slist_to_ast(SList *list)
#else
slist_to_ast(list)
SList *list;
#endif
{
  SORAST *t=NULL, *last=NULL;
  SList *p;

  for (p = list->next; p!=NULL; p=p->next)
  {
    SORAST *u = (SORAST *)p->elem;
    if ( last==NULL ) last = t = u;
    else { last->ast_right = u; last = u; }
  }
  return t;
}

void
#ifdef __USE_PROTOS
ast_free(SORAST *t)
#else
ast_free(t)
SORAST *t;
#endif
{
    if ( t == NULL ) return;
    ast_free( t->ast_down );
    ast_free( t->ast_right );
    free( t );
}

int
#ifdef __USE_PROTOS
ast_nsiblings(SORAST *t)
#else
ast_nsiblings(t)
SORAST *t;
#endif
{
  int n=0;

  while ( t!=NULL )
  {
    n++;
    t = t->ast_right;
  }
  return n;
}

SORAST *
#ifdef __USE_PROTOS
ast_sibling_index(SORAST *t, int i)
#else
ast_sibling_index(t,i)
SORAST *t;
int i;
#endif
{
  int j=1;
  require(i>0, "ast_sibling_index: i<=0");

  while ( t!=NULL )
  {
    if ( j==i ) return t;
    j++;
    t = t->ast_right;
  }
  return NULL;
}

static void
#ifdef __USE_PROTOS
scanast_free(ScanAST *t)
#else
scanast_free(t)
ScanAST *t;
#endif
{
    if ( t == NULL ) return;
    scanast_free( t->down );
    scanast_free( t->right );
    free( t );
}

/*
 * ast_scan
 *
 * This function is like scanf(): it attempts to match a template
 * against an input tree.  A variable number of tree pointers
 * may be set according to the '%i' labels in the template string.
 * For example:
 *
 *   ast_scan("#( 6 #(5 %1:4 %2:3) #(1 %3:3 %4:3) )",
 *            t, &w, &x, &y, &z);
 *
 * Naturally, you'd want this converted from
 *
 *   ast_scan("#( RangeOp #(Minus %1:IConst %2:Var) #(Plus %3:Var %4Var) )",
 *        t, &w, &x, &y, &z);
 *
 * by SORCERER.
 *
 * This function call must be done withing a SORCERER file because SORCERER
 * must convert the token references to the associated token number.
 *
 * This functions parses the template and creates trees which are then
 * matched against the input tree.  The labels are set as they are
 * encountered; hence, partial matches may leave some pointers set
 * and some NULL.  This routines initializes all argument pointers to NULL
 * at the beginning.
 *
 * This function returns the number of labels matched.
 */
int
#ifdef PCCTS_USE_STDARG
ast_scan(char *templ, SORAST *tree, ...)
#else
ast_scan(va_alist)
va_dcl
#endif
{
  va_list ap;
  ScanAST *t;
  int n, i, found=0;
  SORAST ***label_ptrs=NULL;

#ifdef PCCTS_USE_STDARG
  va_start(ap, tree);
#else
  char *templ;
  SORAST *tree;

  va_start(ap);
  templ = va_arg(ap, char *);
  tree = va_arg(ap, SORAST *);
#endif

  /* make a ScanAST tree out of the template */
  t = stringparser_parse_scanast(templ, &n);

  /* make an array out of the labels */
  if ( n>0 )
  {
    label_ptrs = (SORAST ***) calloc(n, sizeof(SORAST **));
    require(label_ptrs!=NULL, "ast_scan: out of memory");
    for (i=1; i<=n; i++)
    {
      label_ptrs[i-1] = va_arg(ap, SORAST **);
      *(label_ptrs[i-1]) = NULL;
    }
  }

  /* match the input tree against the template */
  ast_scanmatch(t, tree, label_ptrs, &found);

  scanast_free(t);
  free(label_ptrs);

  return found;
}

static ScanAST *
#ifdef __USE_PROTOS
new_scanast(int tok)
#else
new_scanast(tok)
int tok;
#endif
{
    ScanAST *p = (ScanAST *) calloc(1, sizeof(ScanAST));
    if ( p == NULL ) {fprintf(stderr, "out of mem\n"); exit(-1);}
  p->token = tok;
  return p;
}

static ScanAST *
#ifdef __USE_PROTOS
stringparser_parse_scanast(char *templ, int *num_labels)
#else
stringparser_parse_scanast(templ, num_labels)
char *templ;
int *num_labels;
#endif
{
  StringLexer lex;
  StringParser parser;
  ScanAST *t;

  stringlexer_init(&lex, templ);
  stringparser_init(&parser, &lex);
  t = stringparser_parse_tree(&parser);
  *num_labels = parser.num_labels;
  return t;
}

static void
#ifdef __USE_PROTOS
stringparser_match(StringParser *parser, int token)
#else
stringparser_match(parser, token)
StringParser *parser;
int token;
#endif
{
  if ( parser->token != token ) sorcerer_panic("bad tree in ast_scan()");
}

/*
 * Match a tree of the form:
 *    (root child1 child2 ... childn)
 * or,
 *    node
 *
 * where the elements are integers or labeled integers.
 */
static ScanAST *
#ifdef __USE_PROTOS
stringparser_parse_tree(StringParser *parser)
#else
stringparser_parse_tree(parser)
StringParser *parser;
#endif
{
  ScanAST *t=NULL, *root, *child, *last = NULL;

  if ( parser->token != POUND )
  {
    return stringparser_parse_element(parser);
  }
  stringparser_match(parser,POUND);
  parser->token = stringscan_gettok(parser->lexer);
  stringparser_match(parser,LPAREN);
  parser->token = stringscan_gettok(parser->lexer);
  root = stringparser_parse_element(parser);
  while ( parser->token != RPAREN )
  {
    child = stringparser_parse_element(parser);
    if ( t==NULL ) { t = child; last = t; }
    else { last->right = child; last = child; }
  }
  stringparser_match(parser,RPAREN);
  parser->token = stringscan_gettok(parser->lexer);
  root->down = t;
  return root;
}

static ScanAST *
#ifdef __USE_PROTOS
stringparser_parse_element(StringParser *parser)
#else
stringparser_parse_element(parser)
StringParser *parser;
#endif
{
  static char ebuf[100];
  int label = 0;

  if ( parser->token == POUND )
  {
    return stringparser_parse_tree(parser);
  }
  if ( parser->token == PERCENT )
  {
    parser->token = stringscan_gettok(parser->lexer);
    stringparser_match(parser,INT);
    label = atoi(parser->lexer->text);
    parser->num_labels++;
    if ( label==0 ) sorcerer_panic("%%0 is an invalid label");
    parser->token = stringscan_gettok(parser->lexer);
    stringparser_match(parser,COLON);
    parser->token = stringscan_gettok(parser->lexer);
    /* can label tokens and wildcards */
    if ( parser->token != INT && parser->token != PERIOD )
      sorcerer_panic("can only label tokens");
  }
  if ( parser->token == INT )
  {
    ScanAST *p = new_scanast(atoi(parser->lexer->text));
    parser->token = stringscan_gettok(parser->lexer);
    p->label_num = label;
    return p;
  }
  if ( parser->token == PERIOD )
  {
    ScanAST *p = new_scanast(0);  /* token of 0 is wildcard */
    parser->token = stringscan_gettok(parser->lexer);
    p->label_num = label;
    return p;
  }
  sprintf(ebuf, "mismatch token in ast_scan(): %s", scan_token_str(parser->token));
  sorcerer_panic(ebuf);
    return NULL; /* MR20 make -Wall happy */
}

static void
#ifdef __USE_PROTOS
stringparser_init(StringParser *parser, StringLexer *input)
#else
stringparser_init(parser, input)
StringParser *parser;
StringLexer *input;
#endif
{
  parser->lexer = input;
  parser->token = stringscan_gettok(parser->lexer);
  parser->num_labels = 0;
}

static void
#ifdef __USE_PROTOS
stringlexer_init(StringLexer *scanner, char *input)
#else
stringlexer_init(scanner, input)
StringLexer *scanner;
char *input;
#endif
{
  scanner->text[0]='\0';
  scanner->input = input;
  scanner->p = input;
  stringscan_advance(scanner);
}

static void
#ifdef __USE_PROTOS
stringscan_advance(StringLexer *scanner)
#else
stringscan_advance(scanner)
StringLexer *scanner;
#endif
{
  if ( *(scanner->p) == '\0' ) scanner->c = StringScanEOF;
  scanner->c = *(scanner->p)++;
}

static int
#ifdef __USE_PROTOS
stringscan_gettok(StringLexer *scanner)
#else
stringscan_gettok(scanner)
StringLexer *scanner;
#endif
{
  char *index = &scanner->text[0];
  static char ebuf[100];

  while ( isspace(scanner->c) ) { stringscan_advance(scanner); }
  if ( isdigit(scanner->c) )
  {
    int tok = INT;
    while ( isdigit(scanner->c) ) {
      *index++ = scanner->c;
      stringscan_advance(scanner);
    }
    *index = '\0';
    return tok;
  }
  switch ( scanner->c )
  {
    case '#' : stringscan_advance(scanner); return POUND;
    case '(' : stringscan_advance(scanner); return LPAREN;
    case ')' : stringscan_advance(scanner); return RPAREN;
    case '%' : stringscan_advance(scanner); return PERCENT;
    case ':' : stringscan_advance(scanner); return COLON;
    case '.' : stringscan_advance(scanner); return PERIOD;
    case '\0' : return StringScanEOF;
    case StringScanEOF : return StringScanEOF;
    default  :
      sprintf(ebuf, "invalid char in ast_scan: '%c'", scanner->c);
      sorcerer_panic(ebuf);
            return 0; /* MR20 Make -Wall happy */
  }
}
