head	1.11;
access;
symbols;
locks
	gtoal:1.11; strict;
comment	@ * @;


1.11
date	2021.11.02.18.25.42;	author gtoal;	state Exp;
branches;
next	1.10;

1.10
date	2021.11.02.18.18.39;	author gtoal;	state Exp;
branches;
next	1.9;

1.9
date	2021.11.02.18.08.52;	author gtoal;	state Exp;
branches;
next	1.8;

1.8
date	2021.11.02.16.07.46;	author gtoal;	state Exp;
branches;
next	1.7;

1.7
date	2021.11.02.03.57.15;	author gtoal;	state Exp;
branches;
next	1.6;

1.6
date	2021.11.01.21.41.50;	author gtoal;	state Exp;
branches;
next	1.5;

1.5
date	2021.11.01.21.30.12;	author gtoal;	state Exp;
branches;
next	1.4;

1.4
date	2021.11.01.20.22.37;	author gtoal;	state Exp;
branches;
next	1.3;

1.3
date	2021.11.01.01.31.34;	author gtoal;	state Exp;
branches;
next	1.2;

1.2
date	2021.11.01.01.28.34;	author gtoal;	state Exp;
branches;
next	1.1;

1.1
date	2021.11.01.01.05.58;	author gtoal;	state Exp;
branches;
next	;


desc
@parser for cut-down version of C generated by 6809dasm --sbt
@


1.11
log
@fixed heap lossage
@
text
@/*

# syntax for a very small subset of C as generated by the static binary translator
# after running through both 'dumpf' and 'peephole'...

# Note that expressions must be fully bracketed - no operator precedences allowed.
# If we hit constructs that are too awkward to parse, go back to the code generator
# and modify it so that they are never generated in the first place...
# For instance, "a + b + c" would need to be rewritten as "(a + b) + c"

*/

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <ctype.h>
#include <regex.h>

const char *Parse_Version = "parse.c: $Revision: 1.10 $";

#ifndef FALSE
#define FALSE (0!=0)
#define TRUE (0==0)
#endif

// Save the best line+column position parsed so far, before backtracking and failure if syntax error.
#define NOTA_BENE() do { \
  if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; } \
  if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col; \
} while (0)

#define BACKTRACK() do { cur_line = line; cur_col = col; } while (0)

#define CURPOS prog_line[cur_line]+cur_col

char *emergency;
static int debug = 0;

#define MAX_LINES 100000
#define MAX_LINE  1024

// entire program is read into this array.  We could do it a line at a time but
// this leaves options open for later.
char *prog_line[MAX_LINES]; // max lines in a generated program
int end_of_file = 0; // exclusive upper bound - line after last used line

// for parsing:
int cur_line = 0;
int cur_col = 0;

// for syntax failure message:
int best_line = 0;
int best_col = 0;

void preload_entire_source(FILE *in) { // read entire program before starting.
  char s[1024]; // max length of a single line...
  int c;
  int cp; // char position
  for (;;) { // loop over lines
    if (end_of_file == MAX_LINES) {
      fprintf(stderr, "parse: too many input lines for program to store.  Ask the programmer to increase MAX_LINES\n");
      exit(EXIT_FAILURE);
    }
    cp = 0;
    for (;;) { // loop over chars in a line
      c = fgetc(in);
      if (c == EOF) {
        if (cp == 0) return;
        s[cp] = '\0';
        prog_line[end_of_file++] = strdup(s); // to do: check malloc ok
        return;
      }
      if (c == '\r') continue;
      if (c == '\n') {
        s[cp] = '\0';
        prog_line[end_of_file++] = strdup(s); // to do: check malloc ok
        break; // next line
      }
      s[cp++] = c;
      if (cp == MAX_LINE) {
        fprintf(stderr, "parse: A single input line (%d) was too long.  Ask the programmer to increase MAX_LINE\n", end_of_file);
        exit(EXIT_FAILURE);
      }
    }
  }
}

enum phrase {
  NONE,
  SS,
    SS__COMMENT,
    SS__BR_LIST,
    SS__CASELAB,
    SS__LAB,
    SS__ASSIG,
    SS__STRINGPROCCALL,
    SS__PROCCALL,
    SS__IF,
    SS__GOTO,
    SS__JUMP,
    SS__NULL, 
  SS_LIST,
  IDENT,
  LABEL,
  VAR,
  VALUE,
    VAL__COND_EXPR,
    VAL__BR_EXPR,
  OPT_INDEX,
  FNNAME,
  PROCNAME,
  PARAM_LIST,
  REST_OF_PARAM_LIST,
  EXPR,
  FNCALL,
  TYPED_VAR,
    TYPED_VAR__CAST,
    TYPED_VAR__DEFAULT,
  OPT_SECOND_OPERAND,
    OPT_SECOND_OPERAND__PRESENT,
    OPT_SECOND_OPERAND__ABSENT,
  OPT_MONOP,
  CASTNAME,
  BINOP,
  INTEGER,
  SELECTOR,
  HEX_CONSTANT,
  POSITIVE_INTEGER,
  STRING_LITERAL
};

// Tuples are the nodes of the AST (Abstract Syntax Tree).
typedef struct tuple {
  int phraseno;
  int subphrase; // might not need this. tuple format is under development.
  int line;
  int col;
  char *matched;
  struct tuple *phrase[10]; // max args to a proc, for safety.
} tuple;

tuple *new_tuple(int type) {
  // currently we never free anything. RAM is cheap.  If we really needed to save
  // space, a mark/release scheme would be more efficient than calloc/free,
  // though just handling a line at a time would be much better...
  tuple *t;
  t = calloc(1, sizeof(tuple)); // we rely on remaining fields being initialised to 0's.
  t->phraseno = type;
  return t;
}

// indentation for parser tracing.
static int indent = 0;
char *sp(void) {
  static char string[1024];
  char *p = string;
  int i, ind=indent;
  // this hack is because parsing an entire program would lead to huge indents.
  if (ind > 6000) {
    int hashes = (ind-40)/2000;
    for (i = 0; i < hashes; i++) *p++ = '#';
    ind -= hashes*2000;
  }
  if (ind > 600) {
    int ats = (ind-40)/200;
    for (i = 0; i < ats; i++) *p++ = '@@';
    ind -= ats*200;
  }
  if (ind > 60) {
    int plusses = (ind-40)/20;
    for (i = 0; i < plusses; i++) *p++ = '+';
    ind -= plusses*20;
  }
  for (i = 0; i < ind; i++) *p++ = ' ';
  *p = '\0';

  return string;
}

void in(const char *s) { // called on entry to a parsing procedure if debugging
  int i;
  char *p;

  // skip spaces and newlines before printing text that follows cur pos.
  // We actually update the current position - it's not just for the diagnostic message.
  // - this may be a bad design decision... should try a version where cur_* is restored.
  p = CURPOS;
  for (;;) {
    if (cur_line >= end_of_file) break;
    while (*p == ' ') { p += 1; cur_col += 1; }
    // skip newlines as well as spaces
    if (*p == '\0') {
      cur_line += 1; cur_col = 0;
      NOTA_BENE();
      p = CURPOS;
    } else break;
  }

  if (debug <= 0) return;
  //for (i = 0; i < indent; i++) fprintf(stderr, " ");
  fprintf(stderr, "%s>> %s at: \"%s\"\n", sp(), s, (cur_line >= end_of_file ? "<EOF>" : p));
  indent += 2;
}
#define IN int line = cur_line, col = cur_col; in(__FUNCTION__)

int out(int success, const char *s) { // called on exit from a parsing procedure if debugging
  //int i;
  int line = cur_line, col = cur_col;
  char *p;
  
  p = CURPOS;
  indent -= 2;
  //for (i = 0; i < indent; i++) fprintf(stderr, " ");
  if (success) {
    for (;;) {
      if (cur_line >= end_of_file) break;
      while (*p == ' ') { p += 1; cur_col += 1; } // always skip white space on this line before an atom (OK if we leave it skipped)
      // skip newlines as well as spaces
      if (*p == '\0') {
        cur_line += 1; cur_col = 0;
        NOTA_BENE();
        p = CURPOS;
      } else break;
    }
    if (debug >= 1) fprintf(stderr, "%s<< %s MATCHED leaving: \"%s\"\n", sp(), s, (cur_line == end_of_file ? "<EOF>" : p));
  } else {
    if (debug >= 1) fprintf(stderr, "%s<< %s\n", sp(), s);
  }
  BACKTRACK();
  return success;
}
#define OUT(cond) out(cond, __FUNCTION__)

int parse_ss_list(tuple *ss_list);
int parse_selector(tuple *sel);
int parse_rest_of_param_list(tuple *param_list);
int parse_expr(tuple *expr);
int parse_positive_integer(tuple *posint);
int parse_hex_constant(tuple *hex);
int parse_procname(tuple *fnname);
int parse_fnname(tuple *procname);
int parse_param_list(tuple *param_list);
int parse_cond(tuple *cond);

// match a literal string against source at current position.  increment
// the current position if a match.  Leave untouched otherwise.
int lex_lit(char *lit, char **matched) {
  char *p = CURPOS;
  IN;

  if (matched) *matched = NULL;
  if (debug >= 1) fprintf(stderr, "%sLex: Trying \"%s\"\n", sp(), lit);

  NOTA_BENE();
  if (*lit == '\0') return OUT(TRUE); // empty string always matches

  for (;;) {
    if (cur_line >= end_of_file) return OUT(FALSE); // non-empty string can't match end of file
    p = CURPOS;
    while (*p == ' ') { // always skip white space on this line before an atom (OK if we leave it skipped)
      p += 1;
      cur_col += 1;
    }
    if (strcmp(lit, "\n") == 0) { // special case for end-of-line (should always be only char in string)
      if (*p == '\0') {
        cur_line += 1; cur_col = 0;
        NOTA_BENE();
        if (matched) *matched = lit;
        return OUT(TRUE);
      }
      return OUT(FALSE);
    } else {
      // skip newlines as well as spaces
      if (*p == '\0') {
        cur_line += 1; cur_col = 0;
        NOTA_BENE();
        p = CURPOS;
        if (debug >= 1) fprintf(stderr, "%s+Lex: Trying \"%s\"\n", sp(), lit);
      } else break;
    }
  }
  
  p = CURPOS;
  if (strncmp(lit, p, strlen(lit)) == 0) {
    cur_col += strlen(lit);
    NOTA_BENE();
    if (matched) *matched = lit;
    return OUT(TRUE);
  }
  return OUT(FALSE);
}

// match regex against source at current position.  increment the current
// position if a match.  Leave untouched otherwise.
int lex_regex(char *regexs, char **matched) {
#define MAX_MATCHES 32 // or is this always 1 in this code?

  // when a regex matches something in the source, this extracts the matched text as a string
  auto char *extract(char *s, int start /* inclusive */, int end /* exclusive */) {
    char *t = malloc(end-start+1);
    int i;
    if (t == NULL) {
      free(emergency);
      fprintf(stderr, "parse: running out of memory. Programmer may need to restructure the code.\n");
      fflush(stderr); fflush(stdout);
      exit(EXIT_FAILURE);
    }
    for (i = 0; i < end-start; i++) t[i] = s[i+start];
    t[end-start] = '\0';
    return t;
  }

  regmatch_t matches[MAX_MATCHES];
  regex_t regex;
  int reti;
  char msgbuf[100];
  char *p = CURPOS;

  IN;

  NOTA_BENE();
  if (debug >= 1) fprintf(stderr, "%sTrying \"%s\"\n", sp(), regexs);

  if (matched == NULL) {
    fprintf(stderr, "parse: programmer error - 'matched' parameter to lex_regex was passed a null pointer\n");
    exit(EXIT_FAILURE);
  }
  
  if (*regexs == '\0') return OUT(TRUE); // empty string always matches
  
  for (;;) {
    p = CURPOS;
    if (cur_line >= end_of_file) return OUT(FALSE); // non-empty string can't match end of file
    while (*p == ' ') {
      p += 1;
      cur_col += 1;
    } // always skip white space on this line before an atom (OK if we leave it skipped)
    if (strcmp(regexs, "^$") == 0) { // special case for end-of-line (should always be only char in string)
      if (*p == '\0') {
        cur_line += 1; cur_col = 0;
        NOTA_BENE();
        return OUT(TRUE);
      }
      return OUT(FALSE);
    } else {
      // skip newlines as well as spaces
      if (*p == '\0') {
        cur_line += 1; cur_col = 0;
        NOTA_BENE();
        p = CURPOS;
        if (debug >= 1) fprintf(stderr, "%s+Trying \"%s\"\n", sp(), regexs);
      } else break;
    }
  }

  /* Compile regular expression */
  if (regcomp(&regex, regexs, REG_EXTENDED) != 0) {
    free(emergency);
    fprintf(stderr, "parse: programmer error - could not compile regex \"%s\" - we may have run out of malloc memory\n", regexs);
    fflush(stderr); fflush(stdout);
    exit(EXIT_FAILURE);
  }

  /* Execute regular expression */
  reti = regexec(&regex, p, MAX_MATCHES, matches, 0);

  if ((!reti) && (matches[0].rm_so == 0)) { // 0 is in case user forgets the "^" anchor ...
    // Step over matched string.

    *matched = extract(p, matches[0].rm_so, matches[0].rm_eo);
    cur_col += strlen(*matched);
    //cur_col +=  matches[0].rm_eo-matches[0].rm_so-1;
    NOTA_BENE();
    p = CURPOS;

    if (debug >= 1) fprintf(stderr, "%sRegex \"%s\" matched \"%s\" leaving \"%s\"\n", sp(), regexs, *matched, p);
    /* Free memory allocated to the pattern buffer by regcomp() */
    regfree(&regex);
    return OUT(TRUE);
  } else if (reti == REG_NOMATCH) {
    // No match
    /* Free memory allocated to the pattern buffer by regcomp() */
    regfree(&regex); // NB http://redhat.com/archives/libvir-list/2013-September/msg00276.html only applies to failed regcomp, not failed regexec
    return OUT(FALSE);
  }

  free(emergency);
  regerror(reti, &regex, msgbuf, sizeof(msgbuf));
  fprintf(stderr, "parse: Regex match internal error: %s\n", msgbuf);
  fflush(stderr); fflush(stdout);
  exit(EXIT_FAILURE);
  return OUT(FALSE);
}

// Parse source file using these phrases from the grammar.  Advance the current position
// if there is a match - don't move it if there is not.

//\\ stringlit := "\"(\\\\.|[^\"])*\"";
int parse_stringlit(tuple *stringlit) {
  return lex_regex("\"(\\\\.|[^\"])*\"", &stringlit->matched); // This regex is why we need regcomp to use REG_EXTENDED.
  // Simpler regex below does not support \-escaped characters in a string.
  // return lex_regex("^\".*\"", &stringlit->matched);
}

//\\ castname := "[A-Z][A-Z]*[0-9][0-9]*";
int parse_castname(tuple *castname) {
  // SBT casts include some semantic content: [US]INT<bitsize>
  return lex_regex("^[A-Z][A-Z]*[0-9][0-9]*", &castname->matched);
}

//\\ ident := "[A-Za-z_][A-Za-z_0-9]*";
int parse_ident(tuple *ident) {
  ident->phraseno = IDENT; // override label, etc
  return lex_regex("^[A-Za-z_][A-Za-z_0-9]*", &ident->matched);
}

//\\ label := <ident>;
int parse_label(tuple *labelname) {
  return parse_ident(labelname);
}

//\\ <opt-index> :=
//\\   '[' <expr> ']',
//\\   ;
int parse_opt_index(tuple *opt_index) {
  IN;
  if (lex_lit("[", NULL) && parse_expr(opt_index) && lex_lit("]", NULL)) {
    opt_index->phraseno = OPT_INDEX;
    return OUT(TRUE);
  } else BACKTRACK();
  opt_index->phraseno = NONE;
  return OUT(TRUE);
}

int parse_fn_call(tuple *fncall) {
  // should create an opt-param-list phrase...
  //\\   <fnname> '(' ')',
  //\\   <fnname> '(' <param-list> ')',
  tuple *fnname = new_tuple(FNNAME), *param_list = new_tuple(PARAM_LIST);
  IN;
  fncall->phraseno = FNCALL;
  param_list->phrase[0] = NULL;
  if (parse_fnname(fnname) && lex_lit("(", NULL) && ((lex_lit(")", NULL)) || (parse_param_list(param_list) && lex_lit(")", NULL)))) {
    // TO DO: plug in procname and param_list fields here...
    if (param_list->phrase[0] == NULL) {
      fncall->phrase[1] = NULL;
    } else {
      fncall->phrase[1] = param_list;
    }
    fncall->phrase[0] = fnname;
    return OUT(TRUE);
  }
  BACKTRACK();
  return OUT(FALSE);
}

// var can be a LVALUE (as opposed to 'val' which is an RVALUE, but can include a var)

//\\ var := 
//\\   <ident> <opt-index>;
int parse_var(tuple *var) {
  tuple *ident = new_tuple(IDENT), *opt_index = new_tuple(OPT_INDEX);
  IN;
  if (parse_ident(ident) && parse_opt_index(opt_index)) {
    var->phraseno = VAR;
    var->phrase[0] = ident;
    var->phrase[1] = opt_index; // NONE if this is a simple variable, OPT_INDEX if an array element
    return OUT(TRUE);           // Simple variables are things like registers, CC etc - the only
  }                             // indexed element at the moment is memory[] ...
  BACKTRACK();
  return OUT(FALSE);
}

//     Could factor the ( ... ? ... : ... ) vs ( ... ) more efficiently...

// val is an RVALUE

//\\ val := 
//\\   '(' <expr> '?' <expr> : <expr> ')',
//\\   '(' <expr> ')',
//\\   <fncall>,
//\\   <var>,
//\\   <hex-constant>,
//\\   <positive-integer>;
int parse_val(tuple *val) {
  tuple *fncall = new_tuple(FNCALL), *expr = new_tuple(EXPR),*expr1 = new_tuple(EXPR),*expr2 = new_tuple(EXPR);
  IN;

  if (lex_lit("(", NULL) && parse_expr(expr) && lex_lit("?", NULL) && parse_expr(expr1) && lex_lit(":", NULL) && parse_expr(expr2) && lex_lit(")", NULL)) {
    val->subphrase = VAL__COND_EXPR;
    val->phrase[0] = expr;
    val->phrase[1] = expr1;
    val->phrase[2] = expr2;
    return OUT(TRUE);
  } else BACKTRACK();

  if (lex_lit("(", NULL) && parse_expr(expr) && lex_lit(")", NULL)) {
    val->subphrase = VAL__BR_EXPR;
    val->phrase[0] = expr;
    return OUT(TRUE);
  } else BACKTRACK();

  if (parse_fn_call(val)
   || parse_var(val)
   || parse_hex_constant(val)
   || parse_positive_integer(val)) {
    return OUT(TRUE);
  }

  return OUT(FALSE);
}

//\\ opt-monop :=
//\\   '-', '~', '!'
//\\   ;
int parse_opt_monop(tuple *opt_monop) {
  IN;
  if (lex_lit("-", &opt_monop->matched)
   || lex_lit("~", &opt_monop->matched)
   || lex_lit("!", &opt_monop->matched)) {
    return OUT(TRUE);
  }
  opt_monop->matched = "";
  return OUT(TRUE);
}

// could modify grammar to handle multiple casts here.
// Currently redundant cast removal is a nasty hack in peephole() in the SBT.

//\\ typed-val :=
//\\   '(' <castname> ')' <opt-monop> <val>,
//\\   <opt-monop> <val>;
int parse_typed_var(tuple *typed_var) {
  tuple *castname = new_tuple(CASTNAME), *opt_monop = new_tuple(OPT_MONOP), *val = new_tuple(VALUE);
  // could shorten this...
  IN;
  if (lex_lit("(", NULL) && parse_castname(castname) && lex_lit(")", NULL) && parse_opt_monop(opt_monop) && parse_val(val)) {
    typed_var->subphrase = TYPED_VAR__CAST;
    typed_var->phrase[0] = castname;
    typed_var->phrase[1] = opt_monop;
    typed_var->phrase[2] = val;
    return OUT(TRUE);
  } else BACKTRACK();

  if (parse_opt_monop(opt_monop) && parse_val(val)) {
    typed_var->subphrase = TYPED_VAR__DEFAULT;
    typed_var->phrase[0] = NULL;
    typed_var->phrase[1] = opt_monop;
    typed_var->phrase[2] = val;
    return OUT(TRUE);
  } else BACKTRACK();

  return OUT(FALSE);
}

//\\ binop :=
//\\   '>>', '<<', '+', '*', '/', '-', '&&', '||', '&', '|', '^', '<=', '<', '>=', '>', '!=', '==';

int parse_binop(tuple *binop) {
  IN;
  if (lex_lit(">>", &binop->matched)
   || lex_lit("<<", &binop->matched)
   || lex_lit("+", &binop->matched)
   || lex_lit("*", &binop->matched)
   || lex_lit("/", &binop->matched)
   || lex_lit("-", &binop->matched)
   || lex_lit("&&", &binop->matched)
   || lex_lit("||", &binop->matched)
   || lex_lit("&", &binop->matched)
   || lex_lit("|", &binop->matched)
   || lex_lit("^", &binop->matched)
   || lex_lit("<=", &binop->matched)
   || lex_lit("<", &binop->matched)
   || lex_lit(">=", &binop->matched)
   || lex_lit(">", &binop->matched)
   || lex_lit("!=", &binop->matched)
   || lex_lit("==", &binop->matched)) {
    return OUT(TRUE);
  }
  return OUT(FALSE);
}

//\\ opt-second_operand :=
//\\   <binop> <typed-val>,
//\\   ;
int parse_opt_second_operand(tuple *opt_second_operand) {
  tuple *binop = new_tuple(BINOP), *typed_var = new_tuple(TYPED_VAR);
  IN;
  if (parse_binop(binop) && parse_typed_var(typed_var)) {
    opt_second_operand->subphrase = OPT_SECOND_OPERAND__PRESENT;
    opt_second_operand->phrase[0] = binop;
    opt_second_operand->phrase[1] = typed_var;
    return OUT(TRUE);
  } else BACKTRACK();
  opt_second_operand->subphrase = OPT_SECOND_OPERAND__ABSENT;
  opt_second_operand->phrase[0] = NULL;
  opt_second_operand->phrase[1] = NULL;
  return OUT(TRUE);
}

//\\ expr :=
//\\   <typed-val> <opt-second_operand>;
int parse_expr(tuple *expr) {
  tuple *typed_var = new_tuple(TYPED_VAR), *opt_second_operand = new_tuple(OPT_SECOND_OPERAND);
  IN;
  if (parse_typed_var(typed_var) && parse_opt_second_operand(opt_second_operand)) {
    expr->phrase[0] = typed_var;
    expr->phrase[1] = opt_second_operand;
    return OUT(TRUE);
  } else BACKTRACK();
  return OUT(FALSE);
}

//\\ fnname := <ident>;
int parse_fnname(tuple *fnname) {
  return parse_ident(fnname);
}

//\\ procname := <ident>;
int parse_procname(tuple *procname) {
  return parse_ident(procname);
}

//\\ param-list := <expr> <rest-of-param-list>;
int parse_param_list(tuple *param_list) {
  tuple *expr = new_tuple(EXPR), *rest_of_param_list = new_tuple(REST_OF_PARAM_LIST);
  IN;
  if (parse_expr(expr) && parse_rest_of_param_list(rest_of_param_list)) {
    param_list->phrase[0] = expr;
    param_list->phrase[1] = rest_of_param_list;
    return OUT(TRUE);
  } else BACKTRACK();
  return OUT(FALSE);
}

//\\ rest-of-param-list :=
//\\   ',' <expr> <rest-of-param-list>,
//\\   ;
int parse_rest_of_param_list(tuple *param_list) {
  tuple *expr = new_tuple(EXPR), *rest_of_param_list = new_tuple(REST_OF_PARAM_LIST);
  IN;
  if (lex_lit(",", NULL) && parse_expr(expr) && parse_rest_of_param_list(rest_of_param_list)) {
    param_list->phrase[0] = expr;
    param_list->phrase[1] = rest_of_param_list;
    return OUT(TRUE);
  } else BACKTRACK();
  param_list->phrase[0] = NULL;
  param_list->phrase[1] = NULL;
  return OUT(TRUE);
}

//\\ ss := 
int parse_ss(tuple *ss) {

  auto int parse_comment(tuple *comment) {
    // Grammar should really have a \n after the comment, but due to the way \n is
    // handled, it works without one.
//\\   "//.*", '/**/';
    IN;
    comment->subphrase = SS__COMMENT;
    comment->matched = "/**/";
    if (lex_regex("^//.*", &comment->matched) || lex_lit("/**/", NULL)) {
      return OUT(TRUE);
    } else BACKTRACK();
    return OUT(FALSE);
  }
  
  auto int parse_bracketed_ss_list(tuple *bss) {
//\\   '{' <ss-list> '}',
    tuple *ssl = new_tuple(SS__BR_LIST); // INVALID! should create a top-level BR_LIST
    IN;
    bss->subphrase = SS__BR_LIST;
    if (lex_lit("{", NULL) && parse_ss_list(ssl) && lex_lit("}", NULL)) {
      bss->phrase[0] = ssl;
      return OUT(TRUE);
    } else BACKTRACK();
    return OUT(FALSE);
  }
  
  auto int parse_case_label(tuple *caselab) {
//\\   "case" <selector> ':',
    tuple *sel = new_tuple(SELECTOR);
    IN;
    caselab->subphrase = SS__CASELAB;
    if (lex_lit("case", NULL) && parse_selector(sel) && lex_lit(":", NULL)) {
      caselab->phrase[0] = sel;
      return OUT(TRUE);
    } else BACKTRACK();
    return OUT(FALSE);
  }

  auto int parse_label_statement(tuple *lab_statement) {
//\\   <label> ':',
    tuple *lab = new_tuple(LABEL);
    IN;
    lab_statement->subphrase = SS__LAB;
    if (parse_label(lab) && lex_lit(":", NULL)) {
      lab_statement->phrase[0] = lab;
      return OUT(TRUE);
    } else BACKTRACK();
    return OUT(FALSE);
  }
  
  auto int parse_assignment(tuple *assig) {
    // now handling &= in SBT code generator instead, so removing from here...
//\\   <var> '=' <expr> ';',
    tuple *var = new_tuple(VAR), *expr = new_tuple(EXPR);
    IN;
    assig->subphrase = SS__ASSIG;
    if (parse_var(var) && lex_lit("=", NULL) && parse_expr(expr) && lex_lit(";", NULL)) {
      assig->phrase[0] = var;
      assig->phrase[1] = expr;
      return OUT(TRUE);
    } else BACKTRACK();
    return OUT(FALSE);
  }

  auto int parse_procedure_call(tuple *proccall) {
//\\   <procname> '(' ')' ';',
//\\   <procname> '(' <param-list> ')' ';',
    tuple *procname = new_tuple(PROCNAME), *param_list = new_tuple(PARAM_LIST);
    IN;
    param_list->phrase[0] = NULL;
    proccall->subphrase = SS__PROCCALL;
    if (parse_procname(procname) && lex_lit("(", NULL) && ((lex_lit(")", NULL)) || (parse_param_list(param_list) && lex_lit(")", NULL))) && lex_lit(";", NULL)) {
      proccall->phrase[0] = procname;
      if (param_list->phrase[0] != NULL) {
        proccall->phrase[1] = param_list;
      } else {
        proccall->phrase[1] = NULL;
      }
      return OUT(TRUE);
    } else BACKTRACK();
    return OUT(FALSE);
  }

  // this is really just a special case for mon(" ... "); - strings not used anywhere else in SBT output.
  auto int parse_string_procedure_call(tuple *proccall) {
//\\   <procname> '(' <stringlit> ')' ';',
    tuple *procname = new_tuple(PROCNAME), *stringlit = new_tuple(STRING_LITERAL);
    IN;
    proccall->subphrase = SS__STRINGPROCCALL;
    if (parse_procname(procname) && lex_lit("(", NULL) && parse_stringlit(stringlit) && lex_lit(")", NULL) && lex_lit(";", NULL)) {
      // TO DO: plug in procname and param_list fields here...
      proccall->phrase[0] = procname;
      proccall->phrase[1] = stringlit;
      return OUT(TRUE);
    } else BACKTRACK();
    return OUT(FALSE);
  }
  
  auto int parse_if_statement(tuple *ifstat) {
    // changing SS to <bracketed-ss-list> as an experiment
//\\   "if" '(' <expr> ')' <SS>,
    tuple *expr = new_tuple(EXPR), *ss = new_tuple(SS);
    IN;
    ifstat->subphrase = SS__IF;
    //if (lex_lit("if", NULL) && lex_lit("(", NULL) && parse_cond(cond) && lex_lit(")", NULL) && parse_ss(ss)) {
    if (lex_lit("if", NULL) && lex_lit("(", NULL) && parse_expr(expr) && lex_lit(")", NULL) && parse_bracketed_ss_list(ss)) {
      // TO DO: plug in cond and ss fields here...
      ifstat->phrase[0] = expr;
      ifstat->phrase[1] = ss;
      return OUT(TRUE);
    } else BACKTRACK();
    return OUT(FALSE);
  }
  
//\\   "goto" <label> ';',
  auto int parse_goto_statement(tuple *g) {
    tuple *lab = new_tuple(LABEL);
    IN;
    g->subphrase = SS__GOTO;
    if (lex_lit("goto", NULL) && parse_label(lab) && lex_lit(";", NULL)) {
      g->phrase[0] = lab;
      return OUT(TRUE);
    } else BACKTRACK();
    return OUT(FALSE);
  }

//\\   "JUMP" ';',
  auto int parse_jump_statement(tuple *g) {
    IN;
    g->subphrase = SS__JUMP;
    if (lex_lit("JUMP", NULL) && lex_lit(";", NULL)) {
      return OUT(TRUE);
    } else BACKTRACK();
    return OUT(FALSE);
  }
  
//\\   ';';
  auto int parse_null_statement(tuple *ns) {
    ns->subphrase = SS__NULL;
    return lex_lit(";", NULL);
  }
  
  IN;
  
  if (parse_comment(ss)
   || parse_bracketed_ss_list(ss)
   || parse_case_label(ss)
   || parse_label_statement(ss)
   || parse_if_statement(ss)
   || parse_goto_statement(ss)
   || parse_procedure_call(ss)
   || parse_string_procedure_call(ss)
   || parse_jump_statement(ss)
   || parse_assignment(ss)
   || parse_null_statement(ss)) {
    return OUT(TRUE);
  }

  return OUT(FALSE);
}


//\\ ss-list :=
//\\   <ss> <ss-list>,
//\\   ;

int parse_ss_list(tuple *ss_list) {
  tuple *ss = new_tuple(SS), *more_ss = new_tuple(SS_LIST);
  IN;

  ss_list->phrase[0] = NULL;
  ss_list->phrase[1] = NULL;

  // a guard... these are the only ways an SS list ends other than in a syntax error...
  if (lex_lit("}", NULL) || (cur_line >= end_of_file)) {
    BACKTRACK();
    return OUT(TRUE); // null option
  }
  
  if (parse_ss(ss) && parse_ss_list(more_ss)) { // the 'more ss' may be empty
    ss_list->phrase[0] = ss;
    ss_list->phrase[1] = more_ss;
    return OUT(TRUE);
  } else BACKTRACK();

  // a syntax error. 'best_pos' will allow us to show the exact point of failure.
  return OUT(FALSE);
}

//\\ hex-constant := "0x[0-9A-Fa-f][0-9A-Fa-f]*[Uu]?";
int parse_hex_constant(tuple *hex) {
  hex->phraseno = HEX_CONSTANT;
  return lex_regex("^0x[0-9A-Fa-f][0-9A-Fa-f]*[Uu]?", &hex->matched); // regcomp needs REG_EXTENDED format option
  // ideally we need to store this as an integer as well, plus cast type information
}

//\\ positive-integer := "[0-9][0-9]*";
int parse_positive_integer(tuple *posint) {
  posint->phraseno = POSITIVE_INTEGER;
  return lex_regex("^[0-9][0-9]*", &posint->matched); // didn't add U or L as we never use it in SBT-generated code
  // negative numbers are built as an expression using monop '-'
}

//\\ integer :=
int parse_integer(tuple *num) {
  tuple *hex = new_tuple(HEX_CONSTANT), *posint = new_tuple(POSITIVE_INTEGER);
  IN;
  
//\\   <hex-constant>,
  if (parse_hex_constant(hex)) {
    num->subphrase = HEX_CONSTANT;
    num->phrase[0] = hex;
    return OUT(TRUE);
  }

//\\   <positive-integer>;
  if (parse_positive_integer(posint)) {
    num->subphrase = POSITIVE_INTEGER;
    num->phrase[0] = posint;
    return OUT(TRUE);
  }

  return OUT(FALSE);
}

//\\ selector := <integer>;
int parse_selector(tuple *sel) {
  return parse_integer(sel);
}

void p(tuple *t) {
  if (t == NULL) return;
  
  switch (t->phraseno) {
  case NONE: break;
  case SS__BR_LIST:
    p(t->phrase[0]);
    break;
  case SS:
    switch (t->subphrase) {
    case SS__COMMENT:
      if (strcmp(t->matched, "/**/") == 0) {
        fprintf(stdout, "  /**/");
      } else {
        fprintf(stdout, "  %s\n", t->matched);
      }
      break;
    case SS__BR_LIST:
      fprintf(stdout, "{\n");
      p(t->phrase[0]);
      fprintf(stdout, "  }\n");
      break;
    case SS__CASELAB:
      fprintf(stdout, "  case ");
      p(t->phrase[0]);
      fprintf(stdout, ":\n");
      break;
    case SS__LAB:
      p(t->phrase[0]);
      fprintf(stdout, ":\n");
      break;
    case SS__ASSIG:
      fprintf(stdout, "  ");
      p(t->phrase[0]); // var
      fprintf(stdout, " = ");
      p(t->phrase[1]); // expr
      fprintf(stdout, ";\n");
      break;
    case SS__STRINGPROCCALL:
      fprintf(stdout, "  ");
      p(t->phrase[0]);
      fprintf(stdout, "(");
      p(t->phrase[1]);
      fprintf(stdout, ");\n");
      break;
    case SS__PROCCALL:
      fprintf(stdout, "  ");
      p(t->phrase[0]);
      fprintf(stdout, "(");
      p(t->phrase[1]);
      fprintf(stdout, ");\n");
      break;
    case SS__IF:
      fprintf(stdout, "  if (");
      p(t->phrase[0]);
      fprintf(stdout, ") ");
      p(t->phrase[1]);
      break;
    case SS__GOTO:
      fprintf(stdout, "  goto ");
      p(t->phrase[0]);
      fprintf(stdout, ";\n");
      break;
    case SS__JUMP:
      fprintf(stdout, "  JUMP;\n");
      break;
    case SS__NULL:
      fprintf(stdout, "  ;\n");
      break;
    default:;
    }
    break;
  case SS_LIST:
    if (t->phrase[0]) {
      p(t->phrase[0]);
      p(t->phrase[1]);
    }
    break;
  case IDENT:
    fprintf(stdout, "%s", t->matched);
    break;
  case LABEL:
    p(t->phrase[0]);
    break;
  case VAR:
    p(t->phrase[0]); // ident
    p(t->phrase[1]); // opt-index
    break;
  case VALUE:
    switch (t->subphrase) {
    case VAL__COND_EXPR:
      fprintf(stdout, "(");
      p(t->phrase[0]);
      fprintf(stdout, " ? ");
      p(t->phrase[1]);
      fprintf(stdout, " : ");
      p(t->phrase[2]);
      fprintf(stdout, ")");
      break;
    case VAL__BR_EXPR:
      // bracketed expression.  Remove any redundant layers of bracketing.
      { tuple *child = t->phrase[0];
        if (child->phraseno == EXPR) {
          tuple *opt_second_operand = child->phrase[1];
          if (opt_second_operand->subphrase == OPT_SECOND_OPERAND__ABSENT) {
            p(t->phrase[0]);
            break;
          }
        }
        fprintf(stdout, "(");
        p(t->phrase[0]);
        fprintf(stdout, ")");
      }
      break;
    default: ;
    }
    break;
  case OPT_INDEX:
    fprintf(stdout, "[");
    t->phraseno = EXPR;
    p(t); // shennanigans!
    fprintf(stdout, "]");
    break;
  case FNNAME: // never happens, intercepted by 'ident'
    fprintf(stdout, "<FNNAME>");
    break;
  case PROCNAME: // never happens, intercepted by 'ident'
    fprintf(stdout, "<PROCNAME>");
    break;
  case REST_OF_PARAM_LIST:
    if (t->phrase[0]) fprintf(stdout, ", ");
  case PARAM_LIST:
    p(t->phrase[0]); // EXPR
    if (t->phrase[1]) p(t->phrase[1]); // REST_OF_PARAM_LIST
    break;
  case EXPR:
    // This is probably where we will fold constants, eg "(U + 0x0002) + 1" becomes "(U + 0x0003)"
    p(t->phrase[0]); // val
    p(t->phrase[1]); // opt-second_operand
    break;
  case FNCALL:
    p(t->phrase[0]); // fnname
    fprintf(stdout, "(");
    p(t->phrase[1]); // opt-param-list
    fprintf(stdout, ")");
    break;
  case TYPED_VAR:
    switch (t->subphrase) {
    case TYPED_VAR__CAST:
      fprintf(stdout, "(");
      p(t->phrase[0]);
      fprintf(stdout, ")");
      p(t->phrase[1]); // monop
      p(t->phrase[2]); // var
      break;
    case TYPED_VAR__DEFAULT:
      // phrase[0] is NULL
      p(t->phrase[1]); // monop
      p(t->phrase[2]); // var
      break;
    default:;
    }
    break;
  case OPT_SECOND_OPERAND:
    switch (t->subphrase) {
    case OPT_SECOND_OPERAND__PRESENT:
      p(t->phrase[0]); // binop
      p(t->phrase[1]); // rest of expr
      break;
    case OPT_SECOND_OPERAND__ABSENT:
      break;
    default:;
    }
    break;
  case OPT_MONOP:
    fprintf(stdout, "%s", t->matched);
    //p(t->phrase[0]); // monop. may be empty string.
    break;
  case CASTNAME:
    fprintf(stdout, "%s", t->matched);
    break;
  case BINOP:
    fprintf(stdout, "%s", t->matched);
    //p(t->phrase[0]); // binop string
    break;
  case SELECTOR:
    p(t->phrase[0]);
    break;
  case HEX_CONSTANT:
    fprintf(stdout, "%s", t->matched);
    break;
  case POSITIVE_INTEGER:
    fprintf(stdout, "%s", t->matched);
    break;
  case STRING_LITERAL:
    fprintf(stdout, "%s", t->matched);
    break;
  default:
    fprintf(stderr, "Unhandled switch parameter %d\n", t->phraseno);
  }
}

int main(int argc, char **argv) {
  tuple *program = new_tuple(SS_LIST);
  
  // If we run out of mallockable memory, error reporting can fail.
  // So free this on severe error to ensure enough memory to print
  // the error string and flush the I/O buffers.
  emergency = malloc(10*1024);
  
  if ((argc == 2) && (strcmp(argv[1], "-h") == 0)) {
    fprintf(stderr, "syntax: parse [-d] < file.c\n");
    exit(0);
  }
  
  if ((argc == 2) && (strcmp(argv[1], "-d") == 0)) debug = 1;
  
  preload_entire_source(stdin);
  
  if (parse_ss_list(program) && (cur_line+1 == end_of_file)) {
    fprintf(stderr, "%d lines of %d compiled.\n", cur_line+1, end_of_file);
    // output optimised program:
    p(program);
    exit(EXIT_SUCCESS);
  } else {
    int i;
    fprintf(stderr, "* Syntax error at line %d, col %d:\n\n", best_line+1, best_col+1); // people tend to number from 1 up
    fprintf(stderr, "%s\n", prog_line[best_line]);
    for (i = 0; i < best_col; i++) fprintf(stderr, " ");
    fprintf(stderr, "^\n");
    exit(EXIT_FAILURE);
  }

  return(1);
}
@


1.10
log
@more simplification of entry/exit sequence
@
text
@d19 1
a19 1
const char *Parse_Version = "parse.c: $Revision: 1.9 $";
d383 1
a383 1
//  regfree(&regex); // maybe? -  http://redhat.com/archives/libvir-list/2013-September/msg00276.html 
@


1.9
log
@added version string
@
text
@d19 1
a19 1
const char *Parse_Version = "parse.c: $Revision: $";
d204 1
a204 1
#define IN in(__FUNCTION__)
a425 1
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
a438 1
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
a461 1
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
a485 1
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
a486 1
  // to do: assign subtypes
a533 1
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
a586 1
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
a603 1
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
a625 1
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
a639 1
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
a658 1
    int line = cur_line, col = cur_col;
a670 1
    int line = cur_line, col = cur_col;
a682 1
    int line = cur_line, col = cur_col;
a694 1
    int line = cur_line, col = cur_col;
a707 1
    int line = cur_line, col = cur_col;
a721 1
    int line = cur_line, col = cur_col;
a740 1
    int line = cur_line, col = cur_col;
a755 1
    int line = cur_line, col = cur_col;
a770 1
    int line = cur_line, col = cur_col;
a781 1
    int line = cur_line, col = cur_col;
a821 1
  int line = cur_line, col = cur_col;
@


1.8
log
@added redundant bracket removal
created some macros to simplify source
@
text
@d19 2
@


1.7
log
@various cleanups
@
text
@d24 10
d123 1
d185 1
a185 1
  p = prog_line[cur_line]+cur_col;
d192 2
a193 4
      if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
      if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

      p = prog_line[cur_line]+cur_col;
d209 1
a209 1
  p = prog_line[cur_line]+cur_col;
d219 2
a220 4
        if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
        if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

        p = prog_line[cur_line]+cur_col;
d227 1
a227 1
  cur_line = line; cur_col = col;
d246 1
a246 1
  char *p = prog_line[cur_line]+cur_col;
a250 3
  
  if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
  if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;
d252 1
d257 1
a257 1
    p = prog_line[cur_line]+cur_col;
d265 1
a265 3
        if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
        if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

d274 2
a275 4
        if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
        if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

        p = prog_line[cur_line]+cur_col;
d281 1
a281 1
  p = prog_line[cur_line]+cur_col;
d284 1
a284 3
    if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
    if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

d315 1
a315 1
  char *p = prog_line[cur_line]+cur_col;
a317 2
  if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
  if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;
d319 1
d330 1
a330 1
    p = prog_line[cur_line]+cur_col;
d339 1
a339 2
        if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
        if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;
d347 2
a348 4
        if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
        if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

        p = prog_line[cur_line]+cur_col;
d371 2
a372 4

    if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
    if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;
    p = prog_line[cur_line]+cur_col;
d376 1
a376 1
//  regfree(&regex);
d429 1
a429 1
  } else { cur_line = line; cur_col = col; }
d452 2
a453 1
  } else { cur_line = line; cur_col = col; }
d471 1
a471 1
  cur_line = line; cur_col = col;
d498 1
a498 1
  } else { cur_line = line; cur_col = col; }
d504 1
a504 1
  } else { cur_line = line; cur_col = col; }
d547 1
a547 1
  } else { cur_line = line; cur_col = col; }
d555 1
a555 1
  } else { cur_line = line; cur_col = col; }
d599 1
a599 1
  } else { cur_line = line; cur_col = col; }
d616 1
a616 1
  } else { cur_line = line; cur_col = col; }
d639 1
a639 1
  } else { cur_line = line; cur_col = col; }
d654 1
a654 1
  } else { cur_line = line; cur_col = col; }
d673 1
a673 1
    } else { cur_line = line; cur_col = col; }
d686 1
a686 1
    } else { cur_line = line; cur_col = col; }
d699 1
a699 1
    } else { cur_line = line; cur_col = col; }
d712 1
a712 1
    } else { cur_line = line; cur_col = col; }
d727 1
a727 1
    } else { cur_line = line; cur_col = col; }
d747 1
a747 1
    } else { cur_line = line; cur_col = col; }
d763 1
a763 1
    } else { cur_line = line; cur_col = col; }
d780 1
a780 1
    } else { cur_line = line; cur_col = col; }
d793 1
a793 1
    } else { cur_line = line; cur_col = col; }
d804 1
a804 1
    } else { cur_line = line; cur_col = col; }
d848 1
a848 1
    cur_line = line; cur_col = col;
d856 1
a856 1
  } else { cur_line = line; cur_col = col; }
d1003 13
a1015 3
      fprintf(stdout, "(");
      p(t->phrase[0]);
      fprintf(stdout, ")");
d1039 1
@


1.6
log
@corrected binop phrase
@
text
@d43 1
a43 1
void read_file(FILE *in) { // read entire program before starting.
d107 3
a109 3
  OPT_BINOP,
    OPT_BINOP__PRESENT,
    OPT_BINOP__ABSENT,
d238 1
a238 1
int lex_lit(char *lit) {
d241 2
a242 1
  
d263 1
d286 1
a321 1
  if (debug >= 1) fprintf(stderr, "%sRegex 1: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
d333 1
a333 1
    if (cur_line >= end_of_file) {return OUT(FALSE);} // non-empty string can't match end of file
a336 1
      if (debug >= 1) fprintf(stderr, "%sRegex 2: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
a342 2

        if (debug >= 1) fprintf(stderr, "%sRegex 3: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
a344 1
      if (debug >= 1) fprintf(stderr, "%sRegex 4: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
a354 1
        if (debug >= 1) fprintf(stderr, "%sRegex 5: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
a369 1
  if (debug >= 1) fprintf(stderr, "%sRegex 6: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
a372 2
    if (debug >= 1) fprintf(stderr, "%sRegex: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);

d433 1
a433 1
  if (lex_lit("[") && parse_expr(opt_index) && lex_lit("]")) {
d436 1
a436 1
  }
a437 1
  cur_line = line; cur_col = col;
d446 1
a446 1
  tuple *fnname, *param_list;
a448 2
  fnname = new_tuple(FNNAME);
  param_list = new_tuple(PARAM_LIST);
d450 1
a450 1
  if (parse_fnname(fnname) && lex_lit("(") && ((lex_lit(")")) || (parse_param_list(param_list) && lex_lit(")")))) {
d459 1
a459 2
  }
  cur_line = line; cur_col = col;
d498 1
a498 1
  if (lex_lit("(") && parse_expr(expr) && lex_lit("?") && parse_expr(expr1) && lex_lit(":") && parse_expr(expr2) && lex_lit(")")) {
d504 1
a504 2
  }
  cur_line = line; cur_col = col;
d506 1
a506 1
  if (lex_lit("(") && parse_expr(expr) && lex_lit(")")) {
a508 2
    val->phrase[1] = NULL;
    val->phrase[2] = NULL;
d510 1
a510 14
  }
  cur_line = line; cur_col = col;

  if (parse_fn_call(val)) {
    return OUT(TRUE);
  }

  if (parse_var(val)) {
    return OUT(TRUE);
  }

  if (parse_hex_constant(val)) {
    return OUT(TRUE);
  }
d512 4
a515 1
  if (parse_positive_integer(val)) {
d527 3
a529 8
  if (lex_lit("-")) {
    opt_monop->matched = "-";
    return OUT(TRUE);
  } else if (lex_lit("~")) {
    opt_monop->matched = "~";
    return OUT(TRUE);
  } else if (lex_lit("!")) {
    opt_monop->matched = "!";
d532 1
a532 2

  opt_monop->matched = ""; // or NULL???
d536 2
a537 1
// could handle multiple casts here.  Current a nasty hack in peephole() in the SBT.
d547 1
a547 1
  if (lex_lit("(") && parse_castname(castname) && lex_lit(")") && parse_opt_monop(opt_monop) && parse_val(val)) {
d553 2
a554 2
  }
  cur_line = line; cur_col = col;
d561 2
a562 2
  }
  cur_line = line; cur_col = col;
a565 2
// more ops added below... update the grammar...

d571 17
a587 50
  if (lex_lit(">>")) {
    binop->matched = ">>";
    return OUT(TRUE);
  } else if (lex_lit("<<")) {
    binop->matched = "<<";
    return OUT(TRUE);
  } else if (lex_lit("+")) {
    binop->matched = "+";
    return OUT(TRUE);
  } else if (lex_lit("*")) {
    binop->matched = "*";
    return OUT(TRUE);
  } else if (lex_lit("/")) {
    binop->matched = "/";
    return OUT(TRUE);
  } else if (lex_lit("-")) {
    binop->matched = "-";
    return OUT(TRUE);
  } else if (lex_lit("&&")) {
    binop->matched = "&&";
    return OUT(TRUE);
  } else if (lex_lit("||")) {
    binop->matched = "||";
    return OUT(TRUE);
  } else if (lex_lit("&")) {
    binop->matched = "&";
    return OUT(TRUE);
  } else if (lex_lit("|")) {
    binop->matched = "|";
    return OUT(TRUE);
  } else if (lex_lit("^")) {
    binop->matched = "^";
    return OUT(TRUE);
  } else if (lex_lit("<=")) {
    binop->matched = "<=";
    return OUT(TRUE);
  } else if (lex_lit("<")) {
    binop->matched = "<";
    return OUT(TRUE);
  } else if (lex_lit(">=")) {
    binop->matched = ">=";
    return OUT(TRUE);
  } else if (lex_lit(">")) {
    binop->matched = ">";
    return OUT(TRUE);
  } else if (lex_lit("!=")) {
    binop->matched = "!=";
    return OUT(TRUE);
  } else if (lex_lit("==")) {
    binop->matched = "==";
a589 1

d593 1
a593 1
//\\ opt-binop :=
d596 1
a596 1
int parse_opt_binop(tuple *opt_binop) {
d601 8
a608 9
    opt_binop->subphrase = OPT_BINOP__PRESENT;
    opt_binop->phrase[0] = binop;
    opt_binop->phrase[1] = typed_var;
    return OUT(TRUE);
  }
  opt_binop->subphrase = OPT_BINOP__ABSENT;
  opt_binop->phrase[0] = NULL;
  opt_binop->phrase[1] = NULL;
  cur_line = line; cur_col = col;
d613 1
a613 1
//\\   <typed-val> <opt-binop>;
d616 1
a616 1
  tuple *typed_var = new_tuple(TYPED_VAR), *opt_binop = new_tuple(OPT_BINOP);
d618 1
a618 1
  if (parse_typed_var(typed_var) && parse_opt_binop(opt_binop)) {
d620 1
a620 1
    expr->phrase[1] = opt_binop;
d622 1
a622 2
  }
  cur_line = line; cur_col = col;
d645 1
a645 2
  }
  cur_line = line; cur_col = col;
d656 1
a656 1
  if (lex_lit(",") && parse_expr(expr) && parse_rest_of_param_list(rest_of_param_list)) {
d660 1
a660 1
  }
a662 1
  cur_line = line; cur_col = col;
d673 1
a673 1
    int line, col;
a675 1
    line = cur_line; col = cur_col;
d677 1
a677 1
    if (lex_regex("^//.*", &comment->matched) || lex_lit("/**/")) {
d679 1
a679 2
    }
    cur_line = line; cur_col = col;
d685 2
a686 2
    tuple *ssl;
    int line, col;
d689 1
a689 3
    line = cur_line; col = cur_col;
    ssl = new_tuple(SS__BR_LIST);
    if (lex_lit("{") && parse_ss_list(ssl) && lex_lit("}")) {
d692 1
a692 2
    }
    cur_line = line; cur_col = col;
d698 2
a699 2
    tuple *sel;
    int line, col;
d702 1
a702 3
    line = cur_line; col = cur_col;
    sel = new_tuple(SELECTOR);
    if (lex_lit("case") && parse_selector(sel) && lex_lit(":")) {
d705 1
a705 2
    }
    cur_line = line; cur_col = col;
d711 2
a712 2
    tuple *lab;
    int line, col;
d715 1
a715 3
    line = cur_line; col = cur_col;
    lab = new_tuple(LABEL);
    if (parse_label(lab) && lex_lit(":")) {
d718 1
a718 2
    }
    cur_line = line; cur_col = col;
d726 1
a726 1
    int line, col;
d729 1
a729 2
    line = cur_line; col = cur_col;
    if (parse_var(var) && lex_lit("=") && parse_expr(expr) && lex_lit(";")) {
d733 1
a733 2
    }
    cur_line = line; cur_col = col;
d740 2
a741 2
    tuple *procname, *param_list;
    int line, col;
d743 1
d745 1
a745 4
    line = cur_line; col = cur_col;
    procname = new_tuple(PROCNAME);
    param_list = new_tuple(PARAM_LIST); param_list->phrase[0] = NULL;
    if (parse_procname(procname) && lex_lit("(") && ((lex_lit(")")) || (parse_param_list(param_list) && lex_lit(")"))) && lex_lit(";")) {
d753 1
a753 2
    }
    cur_line = line; cur_col = col;
d760 2
a761 2
    tuple *procname, *stringlit;
    int line, col;
d764 1
a764 4
    line = cur_line; col = cur_col;
    procname = new_tuple(PROCNAME);
    stringlit = new_tuple(STRING_LITERAL);
    if (parse_procname(procname) && lex_lit("(") && parse_stringlit(stringlit) && lex_lit(")") && lex_lit(";")) {
d769 1
a769 2
    }
    cur_line = line; cur_col = col;
d776 2
a777 2
    tuple *expr, *ss;
    int line, col;
d780 2
a781 5
    expr = new_tuple(EXPR);
    ss = new_tuple(SS);
    line = cur_line; col = cur_col;
    //if (lex_lit("if") && lex_lit("(") && parse_cond(cond) && lex_lit(")") && parse_ss(ss)) {
    if (lex_lit("if") && lex_lit("(") && parse_expr(expr) && lex_lit(")") && parse_bracketed_ss_list(ss)) {
d786 1
a786 2
    }
    cur_line = line; cur_col = col;
d792 2
a793 2
    tuple *lab;
    int line, col;
d796 1
a796 3
    lab = new_tuple(LABEL);
    line = cur_line; col = cur_col;
    if (lex_lit("goto") && parse_label(lab) && lex_lit(";")) {
d799 1
a799 2
    }
    cur_line = line; cur_col = col;
d805 1
a805 1
    int line, col;
d808 1
a808 2
    line = cur_line; col = cur_col;
    if (lex_lit("JUMP") && lex_lit(";")) {
d810 1
a810 2
    }
    cur_line = line; cur_col = col;
d817 1
a817 1
    return lex_lit(";");
d846 1
a846 1
  int line, col;
a847 2
  
  line = cur_line; col = cur_col;
d853 1
a853 1
  if (lex_lit("}") || (cur_line >= end_of_file)) {
d862 1
a862 1
  }
a864 1
  cur_line = line; cur_col = col;
d884 1
a884 1
  tuple *hex, *posint;
a886 3
  hex = new_tuple(HEX_CONSTANT);
  posint = new_tuple(POSITIVE_INTEGER);

d913 2
a914 3
  case   NONE: break;
  case     SS__BR_LIST:
    //fprintf(stdout, "{\n");
a915 1
    //fprintf(stdout, "}\n");
d917 1
a917 1
  case   SS:
d919 1
a919 1
    case     SS__COMMENT:
d926 1
a926 1
    case     SS__BR_LIST:
d929 1
a929 1
      fprintf(stdout, "}\n");
d931 1
a931 1
    case     SS__CASELAB:
d936 1
a936 1
    case     SS__LAB:
d940 1
a940 1
    case     SS__ASSIG:
d947 1
a947 1
    case     SS__STRINGPROCCALL:
d954 1
a954 1
    case     SS__PROCCALL:
d961 1
a961 1
    case     SS__IF:
d967 1
a967 1
    case     SS__GOTO:
d972 1
a972 1
    case     SS__JUMP:
d975 1
a975 1
    case     SS__NULL:
d981 1
a981 1
  case   SS_LIST:
d987 1
a987 1
  case   IDENT:
d990 1
a990 1
  case   LABEL:
d993 1
a993 1
  case   VAR:
d997 1
a997 1
  case   VALUE:
d1016 1
a1016 1
  case   OPT_INDEX:
d1022 1
a1022 1
  case   FNNAME: // never happens, intercepted by 'ident'
d1025 1
a1025 1
  case   PROCNAME: // never happens, intercepted by 'ident'
d1028 1
a1028 1
  case   REST_OF_PARAM_LIST:
d1030 1
a1030 1
  case   PARAM_LIST:
d1034 1
a1034 1
  case   EXPR:
d1036 1
a1036 1
    p(t->phrase[1]); // opt-binop
d1038 1
a1038 1
  case   FNCALL:
d1044 1
a1044 1
  case   TYPED_VAR:
d1046 1
a1046 1
    case     TYPED_VAR__CAST:
d1053 1
a1053 1
    case     TYPED_VAR__DEFAULT:
d1061 1
a1061 1
  case   OPT_BINOP:
d1063 1
a1063 1
    case     OPT_BINOP__PRESENT:
d1067 1
a1067 1
    case     OPT_BINOP__ABSENT:
d1072 1
a1072 1
  case   OPT_MONOP:
d1076 1
a1076 1
  case   CASTNAME:
d1079 1
a1079 1
  case   BINOP:
d1083 1
a1083 1
  case   SELECTOR:
d1086 1
a1086 1
  case   HEX_CONSTANT:
d1089 1
a1089 1
  case   POSITIVE_INTEGER:
d1092 1
a1092 1
  case   STRING_LITERAL:
a1099 4
void regenerate_program(tuple *prog) {
  p(prog);
}

d1101 5
a1105 1
  tuple *program;
d1115 1
a1115 3
  read_file(stdin);
  
  program = new_tuple(SS_LIST);
d1117 4
a1120 4
  if (parse_ss_list(program) && (cur_line == end_of_file)) {
    // output optimised program
    fprintf(stderr, "%d lines of %d compiled.\n", cur_line, end_of_file);
    regenerate_program(program);
@


1.5
log
@improving error messages
@
text
@d597 2
a598 1
//\\   '+', '-', '>>', '<<', '&', '|', '^';
@


1.4
log
@working
@
text
@d24 1
d299 1
d301 1
d304 1
a304 3
    for (i = 0; i < end-start; i++) {
      t[i] = s[i+start];
    }
d364 3
a366 1
    fprintf(stderr, "parse: programmer error - could not compile regex \"%s\"\n", regexs);
d381 1
d397 2
a398 1
  
d401 1
d761 1
d890 1
d1016 5
d1177 2
a1178 1
    p(t->phrase[0]); // monop. may be empty string.
d1197 1
a1197 1
    fprintf(stdout, "\"%s\"", t->matched);
d1210 2
a1211 1

@


1.3
log
@minor comment
@
text
@a0 2
// to do:  JUMP;

d29 2
d32 2
a33 1
int end_of_file = 0; // exclusive upper bound
d37 2
a38 1
// for failure message:
d42 1
a42 1
void read_file(FILE *in) {
d48 2
a49 2
      // too many lines
      exit(__LINE__);
d68 2
a69 2
        // line too long
        exit(__LINE__);
d76 1
d78 11
a88 11
    SS_COMMENT,
    SS_BR_LIST,
    SS_CASELAB,
    SS_LAB,
    SS_ASSIG,
    SS_STRINGPROCCALL,
    SS_PROCCALL,
    SS_IF,
    SS_GOTO,
    SS_JUMP,
    SS_NULL, 
d94 2
d104 2
a105 2
    TYPED_VAR_CAST,
    TYPED_VAR_NORMAL,
d107 2
a108 2
    OPT_BINOP_PRESENT,
    OPT_BINOP_ABSENT,
d118 1
d121 1
a121 1
  int subphrase;
d129 3
d133 1
a133 1
  t = calloc(1, sizeof(tuple));
d138 1
d141 22
a162 4
  static char string[256];
  int i;
  for (i = 0; i < indent; i++) string[i] = ' ';
  string[indent] = '\0';
d166 1
a166 1
void in(const char *s) {
d170 3
a172 1

d176 1
a176 1
    while (*p == ' ') { p += 1; cur_col += 1; } // always skip white space on this line before an atom (OK if we leave it skipped)
d188 2
a189 2
  for (i = 0; i < indent; i++) fprintf(stderr, " ");
  fprintf(stderr, ">> %s at: \"%s\"\n", s, (cur_line >= end_of_file ? "<EOF>" : p));
d194 1
a194 1
int out(int success, const char *s) {
d215 1
a215 1
    if (debug >= 1) fprintf(stderr, "%s<< %s MATCHED leaving: @@@@@@\"%s\"@@@@@@\n", sp(), s, (cur_line == end_of_file ? "<EOF>" : p));
d235 2
d288 18
a305 9
char *extract(char *s, int start /* inclusive */, int end /* exclusive */) {
  char *t = malloc(end-start+1);
  int i;
  if (t == NULL) {
    // failure to malloc
    exit(__LINE__);
  }
  for (i = 0; i < end-start; i++) {
    t[i] = s[i+start];
a306 3
  t[end-start] = '\0';
  return t;
}
a307 2
int lex_regex(char *regexs, char **matched) {
#define MAX_MATCHES 32 // or is this always 1 in this code?
d322 2
a323 1
    exit(__LINE__);
d326 1
a326 20
  if (*regexs == '\0') {return OUT(TRUE);} // empty string always matches

  /*
              >> parse_goto_statement at: "goto L00C3;"
                >> lex_lit at: "goto L00C3;"
                  Lex: Trying "goto"
                << lex_lit MATCHED leaving: @@@@@@"L00C3;"@@@@@@
                >> lex_regex at: "L00C3;"
                  Regex 1: pending data is: "L00C3;"
                  Trying "^[A-Za-z_][A-Za-z_0-9]*"
                  Regex 2: pending data is: "00C3;"
                  Regex 6: pending data is: "00C3;"
                  Regex: pending data is: "00C3;"
                  Regex "^[A-Za-z_][A-Za-z_0-9]*" matched "L00C3" leaving ***""***
                << lex_regex MATCHED leaving: @@@@@@"}"@@@@@@
                >> lex_lit at: "}"
                  Lex: Trying ";"
                << lex_lit
              << parse_goto_statement
   */
d362 3
a364 3
  if (regcomp(&regex, regexs, 0) != 0) {
    fprintf(stderr, "Could not compile regex \"%s\"\n", regexs);
    exit(__LINE__);
a373 7
    /*
                >> lex_regex at: "L00C3;"
                  Trying "^[A-Za-z_][A-Za-z_0-9]*"
                  Regex "^[A-Za-z_][A-Za-z_0-9]*" matched "L00C3" leaving ""
                << lex_regex MATCHED leaving: "}"
     */

d383 1
a383 1
    if (debug >= 1) fprintf(stderr, "%sRegex \"%s\" matched \"%s\" leaving ***\"%s\"***\n", sp(), regexs, *matched, p);
d388 1
a388 1
    // puts("No match");
d395 2
a396 2
  fprintf(stderr, "%sRegex match internal error: %s\n", sp(), msgbuf);
  exit(__LINE__);
d400 4
a403 1
//\\ stringlit := \"([^\\\"]|\\.)*\";
d405 3
a407 2
  //  return lex_regex("^\"([^\\\"]|\\.)*\"", &stringlit->matched);
  return lex_regex("^\".*\"", &stringlit->matched);
d412 1
d418 1
d434 1
d437 1
d443 1
d446 1
a447 1
  int line, col;
d449 1
a449 1
  line = cur_line; col = cur_col;
d452 1
d455 6
d467 2
d476 1
d478 3
a480 3
    var->phrase[1] = opt_index;
    return OUT(TRUE);
  }
d485 4
d503 1
d505 2
d512 1
d514 2
d520 1
a520 2
  if (parse_fn_call(fncall)) {
    val->phrase[0] = fncall;
d523 1
a523 1
  cur_line = line; cur_col = col; // not needed if fncall cleaned up properly
d527 1
d531 1
d559 2
d570 1
a570 1
    typed_var->subphrase = TYPED_VAR_CAST;
d578 1
a578 1
    typed_var->subphrase = TYPED_VAR_NORMAL;
d588 2
d658 1
a658 1
    opt_binop->subphrase = OPT_BINOP_PRESENT;
d663 1
a663 1
  opt_binop->subphrase = OPT_BINOP_ABSENT;
a694 2
// TO DO: string parameters...

d729 5
a733 4
  //int line, col; // save current parse position for backtracking...
  
  int parse_comment(tuple *comment) {
//\\   '//' ".*",
d736 1
d738 2
a739 1
    if (lex_regex("^//.*", &comment->matched) /*&& lex_lit("\n")*/) {
d746 1
a746 1
  int parse_bracketed_ss_list(tuple *bss) {
d751 1
d753 1
a753 1
    ssl = new_tuple(SS_BR_LIST);
d761 1
a761 1
  int parse_case_label(tuple *caselab) {
d766 1
d769 2
a770 1
    if (lex_lit("case") && parse_selector(sel) && lex_lit(":") /*&& lex_lit("\n")*/) {
d776 2
a777 2
  
  int parse_label_statement(tuple *lab_statement) {
d782 1
d785 2
a786 1
    if (parse_label(lab) && lex_lit(":") /*&& lex_lit("\n")*/) {
d793 2
a794 2
  int parse_assignment(tuple *assig) {
    // need to handle &= in code generator instead
d796 1
a796 1
    tuple *var, *expr;
d799 1
d801 3
a803 3
    var = new_tuple(VAR);
    expr = new_tuple(EXPR);
    if (parse_var(var) && (lex_lit("=") || lex_lit("&=")) && parse_expr(expr) && lex_lit(";") /*&& lex_lit("\n")*/) {
d809 2
a810 2
  
  int parse_procedure_call(tuple *proccall) {
d816 1
d819 8
a826 3
    param_list = new_tuple(PARAM_LIST);
    if (parse_procname(procname) && lex_lit("(") && ((lex_lit(")")) || (parse_param_list(param_list) && lex_lit(")"))) && lex_lit(";") /*&& lex_lit("\n")*/) {
      // TO DO: plug in procname and param_list fields here...
d832 3
a834 2
  
  int parse_string_procedure_call(tuple *proccall) {
d839 1
d843 1
a843 1
    if (parse_procname(procname) && lex_lit("(") && parse_stringlit(stringlit) && lex_lit(")") && lex_lit(";") /*&& lex_lit("\n")*/) {
d845 2
d853 1
a853 1
  int parse_if_statement(tuple *ifstat) {
d859 1
d866 2
d875 1
a875 1
  int parse_goto_statement(tuple *g) {
d879 1
d882 1
a882 1
    if (lex_lit("goto") && parse_label(lab) && lex_lit(";") /*&& lex_lit("\n")*/) {
d888 1
a888 1
  
d890 1
a890 1
  int parse_jump_statement(tuple *g) {
d893 1
d895 1
a895 1
    if (lex_lit("JUMP") && lex_lit(";") /*&& lex_lit("\n")*/) {
d903 2
a904 1
  int parse_null_statement(tuple *ns) {
d910 11
a920 32
  if (parse_comment(ss)) {
    ss->subphrase = SS_COMMENT;
    return OUT(TRUE);
  } else if (parse_bracketed_ss_list(ss)) {
    ss->subphrase = SS_BR_LIST;
    return OUT(TRUE);
  } else if (parse_case_label(ss)) {
    ss->subphrase = SS_CASELAB;
    return OUT(TRUE);
  } else if (parse_label_statement(ss)) {
    ss->subphrase = SS_LAB;
    return OUT(TRUE);
  } else if (parse_if_statement(ss)) {
    ss->subphrase = SS_IF;
    return OUT(TRUE);
  } else if (parse_goto_statement(ss)) {
    ss->subphrase = SS_GOTO;
    return OUT(TRUE);
  } else if (parse_procedure_call(ss)) {
    ss->subphrase = SS_PROCCALL;
    return OUT(TRUE);
  } else if (parse_string_procedure_call(ss)) {
    ss->subphrase = SS_STRINGPROCCALL;
    return OUT(TRUE);
  } else if (parse_jump_statement(ss)) {
    ss->subphrase = SS_JUMP;
    return OUT(TRUE);
  } else if (parse_assignment(ss)) {
    ss->subphrase = SS_ASSIG;
    return OUT(TRUE);
  } else if (parse_null_statement(ss)) {
    ss->subphrase = SS_NULL;
d933 1
a933 1
  tuple *ss, *more_ss;
a938 3
  ss = new_tuple(SS);
  more_ss = new_tuple(SS_LIST);

d942 2
a943 1
  if (lex_lit("}") || (cur_line >= end_of_file)) { // !lex_regex("^.") ???
d948 1
a948 1
  if (parse_ss(ss) && parse_ss_list(more_ss)) {
d954 2
a955 2
  // a syntax error.
  cur_line = line; cur_col = col; // backtrack
d959 1
a959 1
//\\ hex-constant := "0x[0-9A-Fa-f][0-9A-Fa-f]*";
d961 3
a963 1
  return lex_regex("^0x[0-9A-Fa-f][0-9A-Fa-f]*", &hex->matched) && (lex_lit("U") || TRUE);
d968 3
a970 1
  return lex_regex("^[0-9][0-9]*", &posint->matched);
d973 2
a974 4

// really 'integer value'. should add another layer for 'selector'...
//\\ selector :=
int parse_selector(tuple *sel) {
d983 2
a984 2
    sel->subphrase = HEX_CONSTANT;
    sel->phrase[0] = hex;
d990 2
a991 2
    sel->subphrase = POSITIVE_INTEGER;
    sel->phrase[0] = posint;
d998 196
d1197 5
d1211 2
a1212 1
    exit(0);
d1215 1
a1215 1
    fprintf(stderr, "Error at line %d, col %d.\n\n", best_line, best_col);
d1218 2
a1219 2
    fprintf(stderr, "^ * Syntax\n");
    exit(1);
@


1.2
log
@removed phrase for comparisons, made it part of expr instead, as C does.
@
text
@d11 1
a11 1

@


1.1
log
@Initial revision
@
text
@a106 3
  COND,
  OPT_COMPARE,
  COMPOP,
d464 1
a464 4
  tuple *fncall = new_tuple(FNCALL),
    *expr = new_tuple(EXPR),*expr1 = new_tuple(EXPR),*expr2 = new_tuple(EXPR),
    *cond = new_tuple(COND);

d468 1
a468 1
  if (lex_lit("(") && parse_cond(cond) && lex_lit("?") && parse_expr(expr1) && lex_lit(":") && parse_expr(expr2) && lex_lit(")")) {
a544 50
//\\ compop :=
//\\   '<=', '>=', '<', '>', '!=', '==';
int parse_compop(tuple *compop) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...

  IN;
  line = cur_line; col = cur_col;

  if (lex_lit("<=")) {
    compop->matched = "<=";
    return OUT(TRUE);
  } else if (lex_lit("<")) {
    compop->matched = "<";
    return OUT(TRUE);
  } else if (lex_lit(">=")) {
    compop->matched = ">=";
    return OUT(TRUE);
  } else if (lex_lit(">")) {
    compop->matched = ">";
    return OUT(TRUE);
  } else if (lex_lit("!=")) {
    compop->matched = "!=";
    return OUT(TRUE);
  } else if (lex_lit("==")) {
    compop->matched = "==";
    return OUT(TRUE);
  }

  cur_line = line; cur_col = col;
  return OUT(FALSE);
}

//\\ <opt-compare> :=
//\\   <compop> <expr>,
//\\   ;
int parse_opt_compare(tuple *opt_compare) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *compop = new_tuple(COMPOP), *expr = new_tuple(EXPR);
  IN;
  if (parse_compop(compop) && parse_expr(expr)) {
    opt_compare->phrase[0] = compop;
    opt_compare->phrase[1] = expr;
    return OUT(TRUE);
  }
  opt_compare->phrase[0] = NULL;
  opt_compare->phrase[1] = NULL;
  cur_line = line; cur_col = col;
  return OUT(TRUE);
}

d582 18
a683 15
//\\ cond :=
//\\   <expr> <opt-compare>;
int parse_cond(tuple *cond) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *expr = new_tuple(EXPR), *opt_compare = new_tuple(OPT_COMPARE);
  IN;
  expr = new_tuple(EXPR);
  opt_compare = new_tuple(OPT_COMPARE);
  if (parse_expr(expr) && parse_opt_compare(opt_compare)) {
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;
  return OUT(FALSE);
}

d793 2
a794 2
//\\   "if" '(' <cond> ')' <SS>,
    tuple *cond, *ss;
d797 1
a797 1
    cond = new_tuple(COND);
d801 1
a801 1
    if (lex_lit("if") && lex_lit("(") && parse_cond(cond) && lex_lit(")") && parse_bracketed_ss_list(ss)) {
d916 1
a916 1
  return lex_regex("^0x[0-9A-Fa-f][0-9A-Fa-f]*", &hex->matched);
@
